diff options
| author | Jarkko Hietaniemi <jhi@iki.fi> | 1999-10-27 14:06:44 +0000 |
|---|---|---|
| committer | Jarkko Hietaniemi <jhi@iki.fi> | 1999-10-27 14:06:44 +0000 |
| commit | 1ae6be1c7649fa55b3105031a58ffe146fa4f2fd (patch) | |
| tree | 2bdf0dec28a91f5b0e5b8445ed6c203c64e7268a | |
| parent | 10a675193b1a7d3751e2d04a91c294c6be9dfaf7 (diff) | |
| parent | 2b260de0f3727bc62519897f69d6f752c97d8502 (diff) | |
| download | perl-1ae6be1c7649fa55b3105031a58ffe146fa4f2fd.tar.gz | |
Integrate with Sarathy; manual resolve on regcomp.c conflicts
(Ilya's changes won).
p4raw-id: //depot/cfgperl@4468
71 files changed, 1777 insertions, 1314 deletions
@@ -79,6 +79,291 @@ Version 5.005_62 Development release working toward 5.006 ---------------- ____________________________________________________________________________ +[ 4435] By: gsar on 1999/10/24 11:39:42 + Log: VMS tweak (suggested by Craig A. Berry <craig.berry@metamor.com>) + Branch: perl + ! ext/B/defsubs_h.PL +____________________________________________________________________________ +[ 4434] By: gsar on 1999/10/24 11:36:08 + Log: relax range checking if they ask for it (from John L. Allen + <allen@grumman.com>) + Branch: perl + ! lib/Time/Local.pm +____________________________________________________________________________ +[ 4433] By: gsar on 1999/10/24 11:25:51 + Log: README nits pointed out by Chris Nandor <pudge@pobox.com> + Branch: perl + ! README lib/File/Path.pm +____________________________________________________________________________ +[ 4432] By: gsar on 1999/10/24 11:11:02 + Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu> + Date: Sun, 24 Oct 1999 03:24:28 -0400 (EDT) + Message-Id: <199910240724.DAA12230@monk.mps.ohio-state.edu> + Subject: Re: [PATCH 5.005_62] OS/2 improvements + Branch: perl + + os2/OS2/REXX/DLL/Changes os2/OS2/REXX/DLL/DLL.pm + + os2/OS2/REXX/DLL/DLL.xs os2/OS2/REXX/DLL/MANIFEST + + os2/OS2/REXX/DLL/Makefile.PL os2/OS2/REXX/t/rx_emxrv.t + ! MANIFEST hints/os2.sh mg.c miniperlmain.c os2/Changes + ! os2/OS2/REXX/Changes os2/OS2/REXX/Makefile.PL + ! os2/OS2/REXX/REXX.pm os2/OS2/REXX/REXX.xs + ! os2/OS2/REXX/t/rx_dllld.t os2/OS2/REXX/t/rx_objcall.t + ! os2/OS2/REXX/t/rx_tievar.t os2/OS2/REXX/t/rx_tieydb.t + ! os2/OS2/REXX/t/rx_vrexx.t os2/dl_os2.c os2/os2.c os2/os2ish.h + ! perl.c perl.h t/io/fs.t t/op/magic.t +____________________________________________________________________________ +[ 4431] By: gsar on 1999/10/24 10:50:14 + Log: install all README.foo with pod content as podfoo.pod + Branch: perl + ! Makefile.SH installman +____________________________________________________________________________ +[ 4430] By: gsar on 1999/10/24 09:28:24 + Log: @INC needs ../lib + Branch: perl + ! t/op/int.t +____________________________________________________________________________ +[ 4429] By: jhi on 1999/10/23 21:47:49 + Log: More printf-fixes (see also #4426). + Branch: cfgperl + ! deb.c dump.c ext/Data/Dumper/Dumper.xs + ! ext/Devel/DProf/DProf.xs malloc.c mg.c op.c perl.c pp.c + ! pp_ctl.c regcomp.c regexec.c run.c scope.c sv.c util.c +____________________________________________________________________________ +[ 4428] By: gsar on 1999/10/23 20:28:56 + Log: fix accidental C modulo semantics on integer-valued operations + (e.g. caused C<length("abc") % -10> to return 3 rather than -7) + Branch: perl + ! op.c t/op/int.t +____________________________________________________________________________ +[ 4427] By: jhi on 1999/10/23 16:10:10 + Log: Integrate with Sarathy. + Branch: cfgperl + !> sv.c win32/win32.c +____________________________________________________________________________ +[ 4426] By: jhi on 1999/10/23 16:04:02 + Log: Fix the printfing nits pointed out by using gcc -Wall and + Configure -Duse64bits -Dccflags=-DDEBUGGING in Solaris, + plus few other warnings in Dumper.xs. + Branch: cfgperl + ! ext/Data/Dumper/Dumper.xs ext/Devel/DProf/DProf.xs + ! ext/Devel/Peek/Peek.xs regcomp.c regexec.c sv.c util.c +____________________________________________________________________________ +[ 4425] By: jhi on 1999/10/23 15:16:41 + Log: Configure regen to pick up the new installation directories + from Policy_sh.SH. The explanations of "public add-ons" and + "vendor-supplied" could do with more work. + Branch: cfgperl + ! Configure config_h.SH +____________________________________________________________________________ +[ 4424] By: nick on 1999/10/23 00:46:22 + Log: Resolve mainline before possible hacking operertunity this weekend + Branch: utfperl + +> pod/perlfilter.pod + !> (integrate 32 files) +____________________________________________________________________________ +[ 4423] By: jhi on 1999/10/22 22:53:17 + Log: Update Policy_sh.SH to handle the newer installation directives. + From: Andy Dougherty <doughera@lafayette.edu> + To: Perl Porters <perl5-porters@perl.org> + Subject: [PATCH 5.005_62] Policy_sh.SH update + Date: Fri, 22 Oct 1999 16:47:34 -0400 (EDT) + Message-ID: <Pine.SOL.4.10.9910221645470.15232-100000@maxwell.phys.lafayette.edu> + Branch: cfgperl + ! Policy_sh.SH +____________________________________________________________________________ +[ 4422] By: jhi on 1999/10/22 22:44:44 + Log: so back to 'so', from Stephanie Beals <bealzy@us.ibm.com> + Branch: cfgperl + ! hints/aix.sh +____________________________________________________________________________ +[ 4421] By: gsar on 1999/10/22 21:16:44 + Log: sv_vcatpvfn() bug: fell through to assuming intsize of 'q' for + C<"%ld", long_val> + Branch: perl + ! sv.c +____________________________________________________________________________ +[ 4420] By: gsar on 1999/10/22 16:36:46 + Log: win32_utime() on directories should use localtime() rather + than gmtime() (from Jan Dubois) + Branch: perl + ! win32/win32.c +____________________________________________________________________________ +[ 4419] By: jhi on 1999/10/21 10:31:41 + Log: Integrate with Sarathy. + Branch: cfgperl + !> Makefile.SH lib/CPAN/FirstTime.pm op.c opcode.h opcode.pl + !> t/lib/glob-basic.t t/op/sort.t +____________________________________________________________________________ +[ 4418] By: gsar on 1999/10/20 23:49:47 + Log: add test for change#4417 + Branch: perl + ! t/op/sort.t +____________________________________________________________________________ +[ 4417] By: gsar on 1999/10/20 23:45:03 + Log: avoid coredump on C<sort { my $c; return $a cmp $b } ...> + Branch: perl + ! op.c +____________________________________________________________________________ +[ 4416] By: gsar on 1999/10/20 01:00:50 + Log: fix prototype mismatch (from Hans Mulder <hansm@xs4all.nl>) + Branch: perl + ! lib/CPAN/FirstTime.pm +____________________________________________________________________________ +[ 4415] By: gsar on 1999/10/20 00:52:34 + Log: disable optimizing troublesome ops in change#3612 + (from Ilya Zakharevich) + Branch: perl + ! Makefile.SH opcode.h opcode.pl +____________________________________________________________________________ +[ 4414] By: gsar on 1999/10/20 00:37:46 + Log: skip unreadable directory test when running as root + Branch: perl + ! t/lib/glob-basic.t +____________________________________________________________________________ +[ 4413] By: jhi on 1999/10/19 09:26:52 + Log: Avoid GNU ar if HP cc is being used. + Branch: cfgperl + ! hints/hpux.sh +____________________________________________________________________________ +[ 4412] By: jhi on 1999/10/19 07:24:29 + Log: Integrate with Sarathy. + Branch: cfgperl + !> perlvars.h +____________________________________________________________________________ +[ 4411] By: jhi on 1999/10/19 07:22:34 + Log: Long double support: sqrtl et al are not available everywhere, + e.g. not in Solaris, even when long doubles are. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH perl.h +____________________________________________________________________________ +[ 4410] By: jhi on 1999/10/19 07:21:42 + Log: Add sqrtl probe, add echo dependencies. + Branch: metaconfig + ! U/threads/d_pthreadj.U + Branch: metaconfig/U/perl + + d_sqrtl.U + ! i_inttypes.U io64.U +____________________________________________________________________________ +[ 4409] By: gsar on 1999/10/19 02:18:54 + Log: perl_mutex n/a if !USE_THREADS + Branch: perl + ! perlvars.h +____________________________________________________________________________ +[ 4408] By: jhi on 1999/10/18 20:13:02 + Log: Forgotten s/warning/warnings/. + Branch: cfgperl + ! Makefile.SH +____________________________________________________________________________ +[ 4407] By: jhi on 1999/10/18 20:02:12 + Log: Integrate with Sarathy. + Branch: cfgperl + +> pod/perlfilter.pod + !> (integrate 30 files) +____________________________________________________________________________ +[ 4406] By: gsar on 1999/10/18 16:32:10 + Log: added intro to source filters from Paul Marquess + Branch: perl + + pod/perlfilter.pod + ! MANIFEST pod/perldelta.pod +____________________________________________________________________________ +[ 4405] By: gsar on 1999/10/18 05:53:06 + Log: missing manpages + Branch: perl + ! installman +____________________________________________________________________________ +[ 4404] By: gsar on 1999/10/18 05:09:22 + Log: pod updates from Tom Christiansen + Branch: perl + ! lib/Pod/Man.pm pod/perldelta.pod pod/perlmodlib.pod +____________________________________________________________________________ +[ 4403] By: gsar on 1999/10/17 23:43:59 + Log: PL_malloc_mutex needs to be global, not per-interpreter + (malloc.c has static data) + Branch: perl + ! embedvar.h intrpvar.h objXSUB.h perl.c perlvars.h +____________________________________________________________________________ +[ 4402] By: gsar on 1999/10/17 22:30:30 + Log: support PERL_IMPLICIT_SYS with MULTIPLICITY/USE_THREADS on + windows + Branch: perl + ! XSUB.h ext/POSIX/POSIX.xs intrpvar.h makedef.pl malloc.c + ! perl.c perl.h perlio.c win32/perllib.c win32/win32.c + ! win32/win32.h +____________________________________________________________________________ +[ 4401] By: gsar on 1999/10/17 20:33:42 + Log: serious bug introduced by G_VOID changes in 5.003_96: scalar + eval"" did not pop stack correctly; C<$a = eval "(1,2)x1"> + is one symptom of the problem + Branch: perl + ! pp_ctl.c t/op/eval.t +____________________________________________________________________________ +[ 4400] By: gsar on 1999/10/17 18:36:46 + Log: remove FileHandle from list of PodParser dependencies (the + difference is 20 files vs 6 files loaded!) + Branch: perl + ! lib/Pod/Parser.pm lib/Pod/Select.pm pod/perldelta.pod + ! t/pod/testcmp.pl +____________________________________________________________________________ +[ 4399] By: nick on 1999/10/17 14:51:35 + Log: Pre-trip resolve + Branch: utfperl + !> installperl lib/Text/Tabs.pm perl.c pp_hot.c +____________________________________________________________________________ +[ 4398] By: gsar on 1999/10/17 09:19:24 + Log: make installperl ignore RCS files (from Michael G Schwern + <schwern@pobox.com>) + Branch: perl + ! installperl lib/Text/Tabs.pm +____________________________________________________________________________ +[ 4397] By: gsar on 1999/10/16 18:30:14 + Log: another bug in change#3386 (CATCH_SET wasn't reverted correctly) + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 4396] By: jhi on 1999/10/16 17:44:39 + Log: Missing comma. + Branch: cfgperl + ! lib/diagnostics.pm +____________________________________________________________________________ +[ 4395] By: gsar on 1999/10/16 17:18:36 + Log: assumption about @_ always being non-REAL doesn't hold when + debugger is running; DB::sub() can call arbitrary stuff + that modifies @_ at will + Branch: perl + ! pp_hot.c +____________________________________________________________________________ +[ 4394] By: nick on 1999/10/16 09:35:20 + Log: Resolve utfperl branch against mainline as of _62 + Branch: utfperl + +> eg/cgi/dna_small_gif.uu eg/cgi/wilogo_gif.uu + +> ext/DB_File/hints/sco.pl ext/DynaLoader/hints/aix.pl + +> ext/File/Glob/Changes ext/File/Glob/Glob.pm + +> ext/File/Glob/Glob.xs ext/File/Glob/Makefile.PL + +> ext/File/Glob/TODO ext/File/Glob/bsd_glob.c + +> ext/File/Glob/bsd_glob.h ext/NDBM_File/hints/sco.pl + +> pod/perlhack.pod t/lib/glob-basic.t t/lib/glob-global.t + +> t/lib/glob-taint.t win32/genmk95.pl + - eg/cgi/dna.small.gif.uu eg/cgi/wilogo.gif.uu + !> (integrate 144 files) +____________________________________________________________________________ +[ 4393] By: gsar on 1999/10/16 04:07:02 + Log: OS/2 support bits (from Ilya Zakharevich) + Branch: perl + ! hints/os2.sh makedef.pl os2/Makefile.SHs t/lib/glob-basic.t +____________________________________________________________________________ +[ 4392] By: jhi on 1999/10/15 10:28:09 + Log: Integrate with Sarathy. + Branch: cfgperl + !> Changes MANIFEST Makefile.SH Porting/makerel lib/Pod/Man.pm + !> lib/Pod/Parser.pm op.c pod/perldelta.pod pod/perlopentut.pod + !> win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 4391] By: gsar on 1999/10/15 10:12:42 + Log: here be 5.005_62 + Branch: perl + ! Changes MANIFEST Porting/makerel +____________________________________________________________________________ [ 4390] By: gsar on 1999/10/15 09:45:51 Log: lvalue subs patch (change#4081) breaks C<\(Foo->Bar())>; avoid tickling it in Pod::Man for now; other nits in @@ -954,11 +954,17 @@ os2/OS2/Process/Process.pm system() constants in a module os2/OS2/Process/Process.xs system() constants in a module os2/OS2/REXX/Changes DLL access module os2/OS2/REXX/MANIFEST DLL access module +os2/OS2/REXX/DLL/Changes DLL access module +os2/OS2/REXX/DLL/DLL.pm DLL access module +os2/OS2/REXX/DLL/DLL.xs DLL access module +os2/OS2/REXX/DLL/MANIFEST DLL access module +os2/OS2/REXX/DLL/Makefile.PL DLL access module os2/OS2/REXX/Makefile.PL DLL access module os2/OS2/REXX/REXX.pm DLL access module os2/OS2/REXX/REXX.xs DLL access module os2/OS2/REXX/t/rx_cmprt.t DLL access module os2/OS2/REXX/t/rx_dllld.t DLL access module +os2/OS2/REXX/t/rx_emxrv.t DLL access module os2/OS2/REXX/t/rx_objcall.t DLL access module os2/OS2/REXX/t/rx_sql.test DLL access module os2/OS2/REXX/t/rx_tiesql.test DLL access module diff --git a/Makefile.SH b/Makefile.SH index 7c542a6a3f..b60715eec2 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -481,8 +481,16 @@ lib/re.pm: ext/re/re.pm $(plextract): miniperl lib/Config.pm lib/re.pm $(LDLIBPTH) ./miniperl -Ilib $@.PL - -install: all install.perl install.man + +extra.pods: perl + -@rm -f extra.pods + -@for x in `grep -l '^=[a-z]' README.*` ; do \ + nx=`echo $$x | sed -e "s/README\.//"`; \ + $(LNS) ../$$x "pod/perl"$$nx".pod" ; \ + echo "pod/perl"$$nx".pod" >> extra.pods ; \ + done + +install: all install.perl install.man extra.pods install.perl: all installperl if [ -n "$(COMPILE)" ]; \ @@ -606,7 +614,8 @@ distclean: clobber # Do not 'make _mopup' directly. _mopup: rm -f *$(OBJ_EXT) *$(LIB_EXT) all perlmain.c - rm -f perl.exp ext.libs + -@test -f extra.pods && rm -f `cat extra.pods` + -rm -f perl.exp ext.libs extra.pods -rm -f perl.export perl.dll perl.libexp perl.map perl.def -rm -f perl.loadmap miniperl.loadmap perl.prelmap miniperl.prelmap rm -f perl suidperl miniperl $(LIBPERL) @@ -50,9 +50,9 @@ -------------------------------------------------------------------------- Perl is a language that combines some of the features of C, sed, awk -and shell. See the manual page for more hype. There are also two Nutshell -Handbooks published by O'Reilly & Assoc. See pod/perlbook.pod -for more information. +and shell. See the manual page for more hype. There are also many Perl +books available, covering a wide variety of topics, from various publishers. +See pod/perlbook.pod for more information. Please read all the directions below before you proceed any further, and then follow them carefully. @@ -62,29 +62,10 @@ in MANIFEST. Installation -1) Detailed instructions are in the file INSTALL which you should read. -In brief, the following should work on most systems: - - rm -f config.sh Policy.sh - sh Configure -de - make - make test - make install - -For most systems, it should be safe to accept all the Configure defaults. -It is recommended that you accept the defaults the first time you build -or if you have any problems building. - -The above commands will install Perl to /usr/local or /opt, depending -on the platform. If that's not okay with you, use - - rm -f config.sh Policy.sh - sh Configure - make - make test - make install - -Full configuration instructions can be found in the INSTALL file. +1) Detailed instructions are in the file "INSTALL", which you should +read if you are either installing on a system resembling Unix +or porting perl to another platform. For non-Unix platforms, see the +corresponding README. 2) Read the manual entries before running perl. @@ -94,18 +75,16 @@ If you have a problem, there's someone else out there who either has had or will have the same problem. It's usually helpful if you send the output of the "myconfig" script in the main perl directory. -If you've succeeded in compiling perl, the perlbug script in the utils/ +If you've succeeded in compiling perl, the perlbug script in the "utils" subdirectory can be used to help mail in a bug report. If possible, send in patches such that the patch program will apply them. Context diffs are the best, then normal diffs. Don't send ed scripts-- I've probably changed my copy since the version you have. -Watch for perl patches in comp.lang.perl.announce. Patches will generally -be in a form usable by the patch program. If you are just now bringing -up perl and aren't sure how many patches there are, write to me and I'll -send any you don't have. Your current patch level is shown in -patchlevel.h. +The latest versions of perl are always available on the various CPAN +(Comprehensive Perl Archive Network) sites around the world. +See <URL:http://www.perl.com/CPAN/src/>. Just a personal note: I want you to know that I create nice things like this @@ -59,22 +59,10 @@ Perl_vdeb(pTHX_ const char *pat, va_list *args) SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>", (long)PL_curcop->cop_line); #endif /* USE_THREADS */ - for (i=0; i<PL_dlevel; i++) - PerlIO_printf(Perl_debug_log, "%c%c ",PL_debname[i],PL_debdelim[i]); (void) PerlIO_vprintf(Perl_debug_log, pat, *args); #endif /* DEBUGGING */ } -void -Perl_deb_growlevel(pTHX) -{ -#ifdef DEBUGGING - PL_dlmax += 128; - Renew(PL_debname, PL_dlmax, char); - Renew(PL_debdelim, PL_dlmax, char); -#endif /* DEBUGGING */ -} - I32 Perl_debstackptrs(pTHX) { @@ -168,7 +168,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (fd == -1) fp = NULL; else { - char *fpmode; + const char *fpmode; if (result == O_RDONLY) fpmode = "r"; #ifdef O_APPEND @@ -1116,7 +1116,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo Perl_dump_indent(aTHX_ level, file, " HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv))); Perl_dump_indent(aTHX_ level, file, " CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv))); Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv)); - Perl_dump_indent(aTHX_ level, file, " LASTEXPR = %"IVdf"\n", (IV)GvLASTEXPR(sv)); + Perl_dump_indent(aTHX_ level, file, " GPFLAGS = 0x%"UVxf"\n", (UV)GvGPFLAGS(sv)); Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv)); Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv)); do_gv_dump (level, file, " FILEGV", GvFILEGV(sv)); @@ -123,7 +123,6 @@ #define cxinc Perl_cxinc #define deb Perl_deb #define vdeb Perl_vdeb -#define deb_growlevel Perl_deb_growlevel #define debprofdump Perl_debprofdump #define debop Perl_debop #define debstack Perl_debstack @@ -1487,7 +1486,6 @@ #define get_ppaddr() Perl_get_ppaddr(aTHX) #define cxinc() Perl_cxinc(aTHX) #define vdeb(a,b) Perl_vdeb(aTHX_ a,b) -#define deb_growlevel() Perl_deb_growlevel(aTHX) #define debprofdump() Perl_debprofdump(aTHX) #define debop(a) Perl_debop(aTHX_ a) #define debstack() Perl_debstack(aTHX) @@ -2924,8 +2922,6 @@ #define deb Perl_deb #define Perl_vdeb CPerlObj::Perl_vdeb #define vdeb Perl_vdeb -#define Perl_deb_growlevel CPerlObj::Perl_deb_growlevel -#define deb_growlevel Perl_deb_growlevel #define Perl_debprofdump CPerlObj::Perl_debprofdump #define debprofdump Perl_debprofdump #define Perl_debop CPerlObj::Perl_debop @@ -1078,7 +1078,6 @@ p |PPADDR_t*|get_ppaddr p |I32 |cxinc p |void |deb |const char* pat|... p |void |vdeb |const char* pat|va_list* args -p |void |deb_growlevel p |void |debprofdump p |I32 |debop |OP* o p |I32 |debstack @@ -1667,7 +1666,7 @@ p |SV* |swash_init |char* pkg|char* name|SV* listsv \ |I32 minbits|I32 none p |UV |swash_fetch |SV *sv|U8 *ptr p |void |taint_env -p |void |taint_proper |const char* f|char* s +p |void |taint_proper |const char* f|const char* s p |UV |to_utf8_lower |U8 *p p |UV |to_utf8_upper |U8 *p p |UV |to_utf8_title |U8 *p @@ -2051,8 +2050,8 @@ s |I32 |sublex_done s |I32 |sublex_push s |I32 |sublex_start s |char * |filter_gets |SV *sv|PerlIO *fp|STRLEN append -s |SV* |new_constant |char *s|STRLEN len|char *key|SV *sv \ - |SV *pv|char *type +s |SV* |new_constant |char *s|STRLEN len|const char *key|SV *sv \ + |SV *pv|const char *type s |int |ao |int toketype s |void |depcom s |char* |incl_perldb diff --git a/embedvar.h b/embedvar.h index b018119e3c..94f93b08ee 100644 --- a/embedvar.h +++ b/embedvar.h @@ -188,7 +188,6 @@ #define PL_Sock (PERL_GET_INTERP->ISock) #define PL_StdIO (PERL_GET_INTERP->IStdIO) #define PL_amagic_generation (PERL_GET_INTERP->Iamagic_generation) -#define PL_ampergv (PERL_GET_INTERP->Iampergv) #define PL_an (PERL_GET_INTERP->Ian) #define PL_archpat_auto (PERL_GET_INTERP->Iarchpat_auto) #define PL_argvgv (PERL_GET_INTERP->Iargvgv) @@ -198,7 +197,6 @@ #define PL_bitcount (PERL_GET_INTERP->Ibitcount) #define PL_bufend (PERL_GET_INTERP->Ibufend) #define PL_bufptr (PERL_GET_INTERP->Ibufptr) -#define PL_cddir (PERL_GET_INTERP->Icddir) #define PL_collation_ix (PERL_GET_INTERP->Icollation_ix) #define PL_collation_name (PERL_GET_INTERP->Icollation_name) #define PL_collation_standard (PERL_GET_INTERP->Icollation_standard) @@ -220,14 +218,10 @@ #define PL_curstname (PERL_GET_INTERP->Icurstname) #define PL_curthr (PERL_GET_INTERP->Icurthr) #define PL_dbargs (PERL_GET_INTERP->Idbargs) -#define PL_debdelim (PERL_GET_INTERP->Idebdelim) -#define PL_debname (PERL_GET_INTERP->Idebname) #define PL_debstash (PERL_GET_INTERP->Idebstash) #define PL_debug (PERL_GET_INTERP->Idebug) #define PL_defgv (PERL_GET_INTERP->Idefgv) #define PL_diehook (PERL_GET_INTERP->Idiehook) -#define PL_dlevel (PERL_GET_INTERP->Idlevel) -#define PL_dlmax (PERL_GET_INTERP->Idlmax) #define PL_doextract (PERL_GET_INTERP->Idoextract) #define PL_doswitches (PERL_GET_INTERP->Idoswitches) #define PL_dowarn (PERL_GET_INTERP->Idowarn) @@ -249,7 +243,6 @@ #define PL_expect (PERL_GET_INTERP->Iexpect) #define PL_fdpid (PERL_GET_INTERP->Ifdpid) #define PL_filemode (PERL_GET_INTERP->Ifilemode) -#define PL_filter_debug (PERL_GET_INTERP->Ifilter_debug) #define PL_forkprocess (PERL_GET_INTERP->Iforkprocess) #define PL_formfeed (PERL_GET_INTERP->Iformfeed) #define PL_generation (PERL_GET_INTERP->Igeneration) @@ -276,11 +269,8 @@ #define PL_last_swash_tmps (PERL_GET_INTERP->Ilast_swash_tmps) #define PL_last_uni (PERL_GET_INTERP->Ilast_uni) #define PL_lastfd (PERL_GET_INTERP->Ilastfd) -#define PL_lastsize (PERL_GET_INTERP->Ilastsize) -#define PL_lastspbase (PERL_GET_INTERP->Ilastspbase) #define PL_laststatval (PERL_GET_INTERP->Ilaststatval) #define PL_laststype (PERL_GET_INTERP->Ilaststype) -#define PL_leftgv (PERL_GET_INTERP->Ileftgv) #define PL_lex_brackets (PERL_GET_INTERP->Ilex_brackets) #define PL_lex_brackstack (PERL_GET_INTERP->Ilex_brackstack) #define PL_lex_casemods (PERL_GET_INTERP->Ilex_casemods) @@ -321,7 +311,6 @@ #define PL_multi_open (PERL_GET_INTERP->Imulti_open) #define PL_multi_start (PERL_GET_INTERP->Imulti_start) #define PL_multiline (PERL_GET_INTERP->Imultiline) -#define PL_mystrk (PERL_GET_INTERP->Imystrk) #define PL_nexttoke (PERL_GET_INTERP->Inexttoke) #define PL_nexttype (PERL_GET_INTERP->Inexttype) #define PL_nextval (PERL_GET_INTERP->Inextval) @@ -336,7 +325,6 @@ #define PL_numeric_standard (PERL_GET_INTERP->Inumeric_standard) #define PL_ofmt (PERL_GET_INTERP->Iofmt) #define PL_oldbufptr (PERL_GET_INTERP->Ioldbufptr) -#define PL_oldlastpm (PERL_GET_INTERP->Ioldlastpm) #define PL_oldname (PERL_GET_INTERP->Ioldname) #define PL_oldoldbufptr (PERL_GET_INTERP->Ioldoldbufptr) #define PL_op_mask (PERL_GET_INTERP->Iop_mask) @@ -362,15 +350,11 @@ #define PL_preprocess (PERL_GET_INTERP->Ipreprocess) #define PL_profiledata (PERL_GET_INTERP->Iprofiledata) #define PL_replgv (PERL_GET_INTERP->Ireplgv) -#define PL_rightgv (PERL_GET_INTERP->Irightgv) #define PL_rsfp (PERL_GET_INTERP->Irsfp) #define PL_rsfp_filters (PERL_GET_INTERP->Irsfp_filters) #define PL_runops (PERL_GET_INTERP->Irunops) #define PL_sawampersand (PERL_GET_INTERP->Isawampersand) -#define PL_sawstudy (PERL_GET_INTERP->Isawstudy) -#define PL_sawvec (PERL_GET_INTERP->Isawvec) #define PL_sh_path (PERL_GET_INTERP->Ish_path) -#define PL_siggv (PERL_GET_INTERP->Isiggv) #define PL_sighandlerp (PERL_GET_INTERP->Isighandlerp) #define PL_splitstr (PERL_GET_INTERP->Isplitstr) #define PL_srand_called (PERL_GET_INTERP->Isrand_called) @@ -378,7 +362,6 @@ #define PL_statusvalue_vms (PERL_GET_INTERP->Istatusvalue_vms) #define PL_stderrgv (PERL_GET_INTERP->Istderrgv) #define PL_stdingv (PERL_GET_INTERP->Istdingv) -#define PL_strchop (PERL_GET_INTERP->Istrchop) #define PL_strtab (PERL_GET_INTERP->Istrtab) #define PL_strtab_mutex (PERL_GET_INTERP->Istrtab_mutex) #define PL_sub_generation (PERL_GET_INTERP->Isub_generation) @@ -396,7 +379,6 @@ #define PL_svref_mutex (PERL_GET_INTERP->Isvref_mutex) #define PL_sys_intern (PERL_GET_INTERP->Isys_intern) #define PL_tainting (PERL_GET_INTERP->Itainting) -#define PL_thisexpr (PERL_GET_INTERP->Ithisexpr) #define PL_thr_key (PERL_GET_INTERP->Ithr_key) #define PL_threadnum (PERL_GET_INTERP->Ithreadnum) #define PL_threads_mutex (PERL_GET_INTERP->Ithreads_mutex) @@ -464,7 +446,6 @@ #define PL_Sock (vTHX->ISock) #define PL_StdIO (vTHX->IStdIO) #define PL_amagic_generation (vTHX->Iamagic_generation) -#define PL_ampergv (vTHX->Iampergv) #define PL_an (vTHX->Ian) #define PL_archpat_auto (vTHX->Iarchpat_auto) #define PL_argvgv (vTHX->Iargvgv) @@ -474,7 +455,6 @@ #define PL_bitcount (vTHX->Ibitcount) #define PL_bufend (vTHX->Ibufend) #define PL_bufptr (vTHX->Ibufptr) -#define PL_cddir (vTHX->Icddir) #define PL_collation_ix (vTHX->Icollation_ix) #define PL_collation_name (vTHX->Icollation_name) #define PL_collation_standard (vTHX->Icollation_standard) @@ -496,14 +476,10 @@ #define PL_curstname (vTHX->Icurstname) #define PL_curthr (vTHX->Icurthr) #define PL_dbargs (vTHX->Idbargs) -#define PL_debdelim (vTHX->Idebdelim) -#define PL_debname (vTHX->Idebname) #define PL_debstash (vTHX->Idebstash) #define PL_debug (vTHX->Idebug) #define PL_defgv (vTHX->Idefgv) #define PL_diehook (vTHX->Idiehook) -#define PL_dlevel (vTHX->Idlevel) -#define PL_dlmax (vTHX->Idlmax) #define PL_doextract (vTHX->Idoextract) #define PL_doswitches (vTHX->Idoswitches) #define PL_dowarn (vTHX->Idowarn) @@ -525,7 +501,6 @@ #define PL_expect (vTHX->Iexpect) #define PL_fdpid (vTHX->Ifdpid) #define PL_filemode (vTHX->Ifilemode) -#define PL_filter_debug (vTHX->Ifilter_debug) #define PL_forkprocess (vTHX->Iforkprocess) #define PL_formfeed (vTHX->Iformfeed) #define PL_generation (vTHX->Igeneration) @@ -552,11 +527,8 @@ #define PL_last_swash_tmps (vTHX->Ilast_swash_tmps) #define PL_last_uni (vTHX->Ilast_uni) #define PL_lastfd (vTHX->Ilastfd) -#define PL_lastsize (vTHX->Ilastsize) -#define PL_lastspbase (vTHX->Ilastspbase) #define PL_laststatval (vTHX->Ilaststatval) #define PL_laststype (vTHX->Ilaststype) -#define PL_leftgv (vTHX->Ileftgv) #define PL_lex_brackets (vTHX->Ilex_brackets) #define PL_lex_brackstack (vTHX->Ilex_brackstack) #define PL_lex_casemods (vTHX->Ilex_casemods) @@ -597,7 +569,6 @@ #define PL_multi_open (vTHX->Imulti_open) #define PL_multi_start (vTHX->Imulti_start) #define PL_multiline (vTHX->Imultiline) -#define PL_mystrk (vTHX->Imystrk) #define PL_nexttoke (vTHX->Inexttoke) #define PL_nexttype (vTHX->Inexttype) #define PL_nextval (vTHX->Inextval) @@ -612,7 +583,6 @@ #define PL_numeric_standard (vTHX->Inumeric_standard) #define PL_ofmt (vTHX->Iofmt) #define PL_oldbufptr (vTHX->Ioldbufptr) -#define PL_oldlastpm (vTHX->Ioldlastpm) #define PL_oldname (vTHX->Ioldname) #define PL_oldoldbufptr (vTHX->Ioldoldbufptr) #define PL_op_mask (vTHX->Iop_mask) @@ -638,15 +608,11 @@ #define PL_preprocess (vTHX->Ipreprocess) #define PL_profiledata (vTHX->Iprofiledata) #define PL_replgv (vTHX->Ireplgv) -#define PL_rightgv (vTHX->Irightgv) #define PL_rsfp (vTHX->Irsfp) #define PL_rsfp_filters (vTHX->Irsfp_filters) #define PL_runops (vTHX->Irunops) #define PL_sawampersand (vTHX->Isawampersand) -#define PL_sawstudy (vTHX->Isawstudy) -#define PL_sawvec (vTHX->Isawvec) #define PL_sh_path (vTHX->Ish_path) -#define PL_siggv (vTHX->Isiggv) #define PL_sighandlerp (vTHX->Isighandlerp) #define PL_splitstr (vTHX->Isplitstr) #define PL_srand_called (vTHX->Isrand_called) @@ -654,7 +620,6 @@ #define PL_statusvalue_vms (vTHX->Istatusvalue_vms) #define PL_stderrgv (vTHX->Istderrgv) #define PL_stdingv (vTHX->Istdingv) -#define PL_strchop (vTHX->Istrchop) #define PL_strtab (vTHX->Istrtab) #define PL_strtab_mutex (vTHX->Istrtab_mutex) #define PL_sub_generation (vTHX->Isub_generation) @@ -672,7 +637,6 @@ #define PL_svref_mutex (vTHX->Isvref_mutex) #define PL_sys_intern (vTHX->Isys_intern) #define PL_tainting (vTHX->Itainting) -#define PL_thisexpr (vTHX->Ithisexpr) #define PL_thr_key (vTHX->Ithr_key) #define PL_threadnum (vTHX->Ithreadnum) #define PL_threads_mutex (vTHX->Ithreads_mutex) @@ -742,7 +706,6 @@ #define PL_ISock PL_Sock #define PL_IStdIO PL_StdIO #define PL_Iamagic_generation PL_amagic_generation -#define PL_Iampergv PL_ampergv #define PL_Ian PL_an #define PL_Iarchpat_auto PL_archpat_auto #define PL_Iargvgv PL_argvgv @@ -752,7 +715,6 @@ #define PL_Ibitcount PL_bitcount #define PL_Ibufend PL_bufend #define PL_Ibufptr PL_bufptr -#define PL_Icddir PL_cddir #define PL_Icollation_ix PL_collation_ix #define PL_Icollation_name PL_collation_name #define PL_Icollation_standard PL_collation_standard @@ -774,14 +736,10 @@ #define PL_Icurstname PL_curstname #define PL_Icurthr PL_curthr #define PL_Idbargs PL_dbargs -#define PL_Idebdelim PL_debdelim -#define PL_Idebname PL_debname #define PL_Idebstash PL_debstash #define PL_Idebug PL_debug #define PL_Idefgv PL_defgv #define PL_Idiehook PL_diehook -#define PL_Idlevel PL_dlevel -#define PL_Idlmax PL_dlmax #define PL_Idoextract PL_doextract #define PL_Idoswitches PL_doswitches #define PL_Idowarn PL_dowarn @@ -803,7 +761,6 @@ #define PL_Iexpect PL_expect #define PL_Ifdpid PL_fdpid #define PL_Ifilemode PL_filemode -#define PL_Ifilter_debug PL_filter_debug #define PL_Iforkprocess PL_forkprocess #define PL_Iformfeed PL_formfeed #define PL_Igeneration PL_generation @@ -830,11 +787,8 @@ #define PL_Ilast_swash_tmps PL_last_swash_tmps #define PL_Ilast_uni PL_last_uni #define PL_Ilastfd PL_lastfd -#define PL_Ilastsize PL_lastsize -#define PL_Ilastspbase PL_lastspbase #define PL_Ilaststatval PL_laststatval #define PL_Ilaststype PL_laststype -#define PL_Ileftgv PL_leftgv #define PL_Ilex_brackets PL_lex_brackets #define PL_Ilex_brackstack PL_lex_brackstack #define PL_Ilex_casemods PL_lex_casemods @@ -875,7 +829,6 @@ #define PL_Imulti_open PL_multi_open #define PL_Imulti_start PL_multi_start #define PL_Imultiline PL_multiline -#define PL_Imystrk PL_mystrk #define PL_Inexttoke PL_nexttoke #define PL_Inexttype PL_nexttype #define PL_Inextval PL_nextval @@ -890,7 +843,6 @@ #define PL_Inumeric_standard PL_numeric_standard #define PL_Iofmt PL_ofmt #define PL_Ioldbufptr PL_oldbufptr -#define PL_Ioldlastpm PL_oldlastpm #define PL_Ioldname PL_oldname #define PL_Ioldoldbufptr PL_oldoldbufptr #define PL_Iop_mask PL_op_mask @@ -916,15 +868,11 @@ #define PL_Ipreprocess PL_preprocess #define PL_Iprofiledata PL_profiledata #define PL_Ireplgv PL_replgv -#define PL_Irightgv PL_rightgv #define PL_Irsfp PL_rsfp #define PL_Irsfp_filters PL_rsfp_filters #define PL_Irunops PL_runops #define PL_Isawampersand PL_sawampersand -#define PL_Isawstudy PL_sawstudy -#define PL_Isawvec PL_sawvec #define PL_Ish_path PL_sh_path -#define PL_Isiggv PL_siggv #define PL_Isighandlerp PL_sighandlerp #define PL_Isplitstr PL_splitstr #define PL_Isrand_called PL_srand_called @@ -932,7 +880,6 @@ #define PL_Istatusvalue_vms PL_statusvalue_vms #define PL_Istderrgv PL_stderrgv #define PL_Istdingv PL_stdingv -#define PL_Istrchop PL_strchop #define PL_Istrtab PL_strtab #define PL_Istrtab_mutex PL_strtab_mutex #define PL_Isub_generation PL_sub_generation @@ -950,7 +897,6 @@ #define PL_Isvref_mutex PL_svref_mutex #define PL_Isys_intern PL_sys_intern #define PL_Itainting PL_tainting -#define PL_Ithisexpr PL_thisexpr #define PL_Ithr_key PL_thr_key #define PL_Ithreadnum PL_threadnum #define PL_Ithreads_mutex PL_threads_mutex diff --git a/ext/B/defsubs_h.PL b/ext/B/defsubs_h.PL index dc4275beae..80ef936fce 100644 --- a/ext/B/defsubs_h.PL +++ b/ext/B/defsubs_h.PL @@ -2,7 +2,7 @@ # this file as a template for defsubs.h # Extracting defsubs.h (with variable substitutions) #!perl -my ($out) = __FILE__ =~ /(^.*)\.PL/; +my ($out) = __FILE__ =~ /(^.*)\.PL/i; $out =~ s/_h$/.h/; open(OUT,">$out") || die "Cannot open $file:$!"; print "Extracting $out...\n"; diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index dbf2621669..6fc32b1bd5 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -3369,15 +3369,13 @@ sigaction(sig, action, oldaction = 0) # This code is really grody because we're trying to make the signal # interface look beautiful, which is hard. - if (!PL_siggv) - gv_fetchpv("SIG", TRUE, SVt_PVHV); - { + GV *siggv = gv_fetchpv("SIG", TRUE, SVt_PVHV); struct sigaction act; struct sigaction oact; POSIX__SigSet sigset; SV** svp; - SV** sigsvp = hv_fetch(GvHVn(PL_siggv), + SV** sigsvp = hv_fetch(GvHVn(siggv), PL_sig_name[sig], strlen(PL_sig_name[sig]), TRUE); diff --git a/global.sym b/global.sym index ecde292073..26561d36b2 100644 --- a/global.sym +++ b/global.sym @@ -74,7 +74,6 @@ Perl_get_ppaddr Perl_cxinc Perl_deb Perl_vdeb -Perl_deb_growlevel Perl_debprofdump Perl_debop Perl_debstack @@ -37,8 +37,10 @@ CPerlObj::operator new(size_t nSize, IPerlMem *pvtbl) { if(pvtbl) return pvtbl->pMalloc(pvtbl, nSize); - +#ifndef __MINGW32__ + /* operator new is supposed to throw std::bad_alloc */ return NULL; +#endif } void @@ -653,15 +653,14 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) if (strEQ(name, "SIG")) { HV *hv; I32 i; - PL_siggv = gv; - GvMULTI_on(PL_siggv); - hv = GvHVn(PL_siggv); - hv_magic(hv, PL_siggv, 'S'); - for(i=1;PL_sig_name[i];i++) { + GvMULTI_on(gv); + hv = GvHVn(gv); + hv_magic(hv, gv, 'S'); + for(i = 1; PL_sig_name[i]; i++) { SV ** init; - init=hv_fetch(hv,PL_sig_name[i],strlen(PL_sig_name[i]),1); - if(init) - sv_setsv(*init,&PL_sv_undef); + init = hv_fetch(hv, PL_sig_name[i], strlen(PL_sig_name[i]), 1); + if (init) + sv_setsv(*init, &PL_sv_undef); PL_psig_ptr[i] = 0; PL_psig_name[i] = 0; } @@ -675,21 +674,18 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) case '&': if (len > 1) break; - PL_ampergv = gv; PL_sawampersand = TRUE; goto ro_magicalize; case '`': if (len > 1) break; - PL_leftgv = gv; PL_sawampersand = TRUE; goto ro_magicalize; case '\'': if (len > 1) break; - PL_rightgv = gv; PL_sawampersand = TRUE; goto ro_magicalize; @@ -17,7 +17,7 @@ struct gp { GV * gp_egv; /* effective gv, if *glob */ CV * gp_cv; /* subroutine value */ U32 gp_cvgen; /* generational validity of cached gv_cv */ - I32 gp_lastexpr; /* used by nothing_in_common() */ + U32 gp_flags; /* XXX unused */ line_t gp_line; /* line first declared at (for -w) */ GV * gp_filegv; /* file first declared in (for -w) */ }; @@ -67,7 +67,7 @@ HV *GvHVn(); #define GvCVGEN(gv) (GvGP(gv)->gp_cvgen) #define GvCVu(gv) (GvGP(gv)->gp_cvgen ? Nullcv : GvGP(gv)->gp_cv) -#define GvLASTEXPR(gv) (GvGP(gv)->gp_lastexpr) +#define GvGPFLAGS(gv) (GvGP(gv)->gp_flags) #define GvLINE(gv) (GvGP(gv)->gp_line) #define GvFILEGV(gv) (GvGP(gv)->gp_filegv) diff --git a/hints/os2.sh b/hints/os2.sh index 0167a0ad5f..1d9df3683f 100644 --- a/hints/os2.sh +++ b/hints/os2.sh @@ -95,6 +95,8 @@ libpth="$libpth $libemx/mt $libemx" set `emxrev -f emxlibcm` emxcrtrev=$5 +# indented to not put it into config.sh + _defemxcrtrev=-D_EMX_CRT_REV_=$emxcrtrev so='dll' @@ -124,8 +126,8 @@ fi aout_ldflags="$aout_ldflags" aout_d_fork='define' -aout_ccflags='-DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I.' -aout_cppflags='-DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I.' +aout_ccflags="-DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I. $_defemxcrtrev" +aout_cppflags="-DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I. $_defemxcrtrev" aout_use_clib='c' aout_usedl='undef' aout_archobjs="os2.o dl_os2.o" @@ -165,9 +167,9 @@ else # Recursive regmatch may eat 2.5M of stack alone. ldflags='-Zexe -Zomf -Zmt -Zcrtdll -Zstack 32000' if [ $emxcrtrev -ge 50 ]; then - ccflags='-Zomf -Zmt -DDOSISH -DOS2=2 -DEMBED -I.' + ccflags="-Zomf -Zmt -DDOSISH -DOS2=2 -DEMBED -I. $_defemxcrtrev" else - ccflags='-Zomf -Zmt -DDOSISH -DOS2=2 -DEMBED -I. -DEMX_BAD_SBRK' + ccflags="-Zomf -Zmt -DDOSISH -DOS2=2 -DEMBED -I. -DEMX_BAD_SBRK $_defemxcrtrev" fi use_clib='c_import' usedl='define' diff --git a/installman b/installman index 55dee4f325..a70fdd3ba9 100755 --- a/installman +++ b/installman @@ -127,7 +127,8 @@ sub runpod2man { # of the pod. This might be useful for pod2man someday. if ($script) { @modpods = ($script); - } else { + } + else { @modpods = (); find(\&lsmodpods, '.'); } @@ -143,16 +144,20 @@ sub runpod2man { $manpage =~ s#\.p(m|od)$##; if ($^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'uwin' || $^O =~ /cygwin/) { $manpage =~ s#/#.#g; - } else { + } + else { $manpage =~ s#/#::#g; } $tmp = "${mandir}/${manpage}.tmp"; $manpage = "${mandir}/${manpage}.${manext}"; if (&cmd("$pod2man $mod > $tmp") == 0 && !$notify && -s $tmp) { - rename($tmp, $manpage) && next; + if (rename($tmp, $manpage)) { + $packlist->{$manpage} = { type => 'file' }; + next; + } } unless ($notify) { - unlink($tmp); + unlink($tmp); } } chdir "$builddir" || die "Unable to cd back to $builddir directory!\n$!\n"; @@ -197,11 +202,11 @@ sub unlink { my $cnt = 0; foreach $name (@names) { -next unless -e $name; -chmod 0777, $name if $^O eq 'os2'; -print STDERR " unlink $name\n"; -( CORE::unlink($name) and ++$cnt - or warn "Couldn't unlink $name: $!\n" ) unless $notify; + next unless -e $name; + chmod 0777, $name if $^O eq 'os2'; + print STDERR " unlink $name\n"; + ( CORE::unlink($name) and ++$cnt + or warn "Couldn't unlink $name: $!\n" ) unless $notify; } return $cnt; } @@ -218,14 +223,12 @@ sub link { ? die "AFS" # okay inside eval {} : warn "Couldn't link $from to $to: $!\n" unless $notify; - $packlist->{$to} = { type => 'file' }; }; if ($@) { File::Copy::copy($from, $to) ? $success++ : warn "Couldn't copy $from to $to: $!\n" unless $notify; - $packlist->{$to} = { type => 'file' }; } $success; } @@ -233,16 +236,15 @@ sub link { sub rename { local($from,$to) = @_; if (-f $to and not unlink($to)) { -my($i); -for ($i = 1; $i < 50; $i++) { - last if CORE::rename($to, "$to.$i"); -} -warn("Cannot rename to `$to.$i': $!"), return 0 - if $i >= 50; # Give up! + my($i); + for ($i = 1; $i < 50; $i++) { + last if CORE::rename($to, "$to.$i"); + } + warn("Cannot rename to `$to.$i': $!"), return 0 + if $i >= 50; # Give up! } link($from,$to) || return 0; unlink($from); - $packlist->{$to} = { type => 'file' }; } sub chmod { diff --git a/installperl b/installperl index b576d8b847..ddd06fa6d7 100755 --- a/installperl +++ b/installperl @@ -162,7 +162,7 @@ if ($Is_Cygwin) { $perldll = 'perl56.' . $dlext if $Config{'ccflags'} =~ /PERL_OBJECT/i; } - if ($dlsrc != "dl_none.xs") { + if ($dlsrc ne "dl_none.xs") { -f $perldll || die "No perl DLL built\n"; # Install the DLL diff --git a/intrpvar.h b/intrpvar.h index a60620f6c3..1d34a819c1 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -17,13 +17,13 @@ PERLVAR(Iorigargc, int) PERLVAR(Iorigargv, char **) PERLVAR(Ienvgv, GV *) -PERLVAR(Isiggv, GV *) PERLVAR(Iincgv, GV *) PERLVAR(Ihintgv, GV *) PERLVAR(Iorigfilename, char *) PERLVAR(Idiehook, SV *) PERLVAR(Iwarnhook, SV *) -PERLVAR(Icddir, char *) /* switches */ + +/* switches */ PERLVAR(Iminus_c, bool) PERLVARA(Ipatchlevel,10,char) PERLVAR(Ilocalpatches, char **) @@ -38,14 +38,12 @@ PERLVAR(Idoswitches, bool) PERLVAR(Idowarn, bool) PERLVAR(Idoextract, bool) PERLVAR(Isawampersand, bool) /* must save all match strings */ -PERLVAR(Isawstudy, bool) /* do fbm_instr on all strings */ -PERLVAR(Isawvec, bool) PERLVAR(Iunsafe, bool) PERLVAR(Iinplace, char *) PERLVAR(Ie_script, SV *) PERLVAR(Iperldb, U32) -/* This value may be raised by extensions for testing purposes */ +/* This value may be set when embedding for full cleanup */ /* 0=none, 1=full, 2=full with checks */ PERLVARI(Iperl_destruct_level, int, 0) @@ -70,11 +68,6 @@ PERLVAR(Iargvgv, GV *) PERLVAR(Iargvoutgv, GV *) /* shortcuts to regexp stuff */ -/* XXX these three aren't used anywhere */ -PERLVAR(Ileftgv, GV *) -PERLVAR(Iampergv, GV *) -PERLVAR(Irightgv, GV *) - /* this one needs to be moved to thrdvar.h and accessed via * find_threadsv() when USE_THREADS */ PERLVAR(Ireplgv, GV *) @@ -109,8 +102,6 @@ PERLVAR(Isv_root, SV*) /* storage for SVs belonging to interp */ PERLVAR(Isv_arenaroot, SV*) /* list of areas for garbage collection */ /* funky return mechanisms */ -PERLVAR(Ilastspbase, I32) -PERLVAR(Ilastsize, I32) PERLVAR(Iforkprocess, int) /* so do_open |- can return proc# */ /* subprocess state */ @@ -120,12 +111,6 @@ PERLVAR(Ifdpid, AV *) /* keep fd-to-pid mappings for my_popen */ PERLVAR(Itainting, bool) /* doing taint checks */ PERLVARI(Iop_mask, char *, NULL) /* masked operations for safe evals */ -/* trace state */ -PERLVAR(Idlevel, I32) -PERLVARI(Idlmax, I32, 128) -PERLVAR(Idebname, char *) -PERLVAR(Idebdelim, char *) - /* current interpreter roots */ PERLVAR(Imain_cv, CV *) PERLVAR(Imain_root, OP *) @@ -138,14 +123,11 @@ PERLVARI(Icurcopdb, COP *, NULL) PERLVARI(Icopline, line_t, NOLINE) /* statics moved here for shared library purposes */ -PERLVAR(Istrchop, SV) /* return value from chop */ PERLVAR(Ifilemode, int) /* so nextargv() can preserve mode */ PERLVAR(Ilastfd, int) /* what to preserve mode on */ PERLVAR(Ioldname, char *) /* what to preserve mode on */ PERLVAR(IArgv, char **) /* stuff to free from do_aexec, vfork safe */ PERLVAR(ICmd, char *) /* stuff to free from do_aexec, vfork safe */ -PERLVAR(Imystrk, SV *) /* temp key string for do_each() */ -PERLVAR(Ioldlastpm, PMOP *) /* for saving regexp context in debugger */ PERLVAR(Igensym, I32) /* next symbol for getsym() to define */ PERLVAR(Ipreambled, bool) PERLVAR(Ipreambleav, AV *) @@ -291,17 +273,16 @@ PERLVAR(Ipadix, I32) /* max used index in current "register" pad */ PERLVAR(Ipadix_floor, I32) /* how low may inner block reset padix */ PERLVAR(Ipad_reset_pending, I32) /* reset pad on next attempted alloc */ -PERLVAR(Ithisexpr, I32) /* name id for nothing_in_common() */ PERLVAR(Ilast_uni, char *) /* position of last named-unary op */ PERLVAR(Ilast_lop, char *) /* position of last list operator */ PERLVAR(Ilast_lop_op, OPCODE) /* last list operator */ PERLVAR(Iin_my, I32) /* we're compiling a "my" (or "our") declaration */ PERLVAR(Iin_my_stash, HV *) /* declared class of this "my" declaration */ #ifdef FCRYPT -PERLVAR(Icryptseen, I32) /* has fast crypt() been initialized? */ +PERLVAR(Icryptseen, bool) /* has fast crypt() been initialized? */ #endif -PERLVAR(Ihints, U32) /* pragma-tic compile-time flags */ +PERLVAR(Ihints, U32) /* pragma-tic compile-time flags */ PERLVAR(Idebug, VOL U32) /* flags given to -D switch */ @@ -364,7 +345,6 @@ PERLVAR(Iglob_index, int) PERLVAR(Isrand_called, bool) PERLVARA(Iuudmap,256, char) PERLVAR(Ibitcount, char *) -PERLVAR(Ifilter_debug, int) #ifdef USE_THREADS PERLVAR(Ithr_key, perl_key) /* For per-thread struct perl_thread* */ diff --git a/lib/File/Path.pm b/lib/File/Path.pm index 729037294b..a82fd8004e 100644 --- a/lib/File/Path.pm +++ b/lib/File/Path.pm @@ -2,15 +2,14 @@ package File::Path; =head1 NAME -File::Path - create or remove a series of directories +File::Path - create or remove directory trees =head1 SYNOPSIS -C<use File::Path> + use File::Path; -C<mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711);> - -C<rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1);> + mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711); + rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1); =head1 DESCRIPTION diff --git a/lib/Time/Local.pm b/lib/Time/Local.pm index f2f1672941..7a10d98ba7 100644 --- a/lib/Time/Local.pm +++ b/lib/Time/Local.pm @@ -3,8 +3,19 @@ require 5.000; require Exporter; use Carp; -@ISA = qw(Exporter); -@EXPORT = qw(timegm timelocal); +@ISA = qw( Exporter ); +@EXPORT = qw( timegm timelocal ); +@EXPORT_OK = qw( $no_range_check ); + +sub import { + my $package = shift; + my @args; + for (@_) { + $no_range_check = 1, next if $_ eq 'no_range_check'; + push @args, $_; + } + Time::Local->export_to_level(1, $package, @args); +} # Set up constants $SEC = 1; @@ -51,7 +62,6 @@ sub timelocal { my $tzsec = ($gt[1] - $lt[1]) * $MIN + ($gt[2] - $lt[2]) * $HR; - my($lday,$gday) = ($lt[7],$gt[7]); if($lt[5] > $gt[5]) { $tzsec -= $DAY; } @@ -73,11 +83,13 @@ sub timelocal { sub cheat { $year = $_[5]; $month = $_[4]; - croak "Month '$month' out of range 0..11" if $month > 11 || $month < 0; - croak "Day '$_[3]' out of range 1..31" if $_[3] > 31 || $_[3] < 1; - croak "Hour '$_[2]' out of range 0..23" if $_[2] > 23 || $_[2] < 0; - croak "Minute '$_[1]' out of range 0..59" if $_[1] > 59 || $_[1] < 0; - croak "Second '$_[0]' out of range 0..59" if $_[0] > 59 || $_[0] < 0; + unless ($no_range_check) { + croak "Month '$month' out of range 0..11" if $month > 11 || $month < 0; + croak "Day '$_[3]' out of range 1..31" if $_[3] > 31 || $_[3] < 1; + croak "Hour '$_[2]' out of range 0..23" if $_[2] > 23 || $_[2] < 0; + croak "Minute '$_[1]' out of range 0..59" if $_[1] > 59 || $_[1] < 0; + croak "Second '$_[0]' out of range 0..59" if $_[0] > 59 || $_[0] < 0; + } $guess = $^T; @g = gmtime($guess); $lastguess = ""; @@ -137,6 +149,27 @@ the values provided. While the day of the month is expected to be in the range 1..31, the month should be in the range 0..11. This is consistent with the values returned from localtime() and gmtime(). +Also worth noting is the ability to disable the range checking that +would normally occur on the input $sec, $min, $hours, $mday, and $mon +values. You can do this by setting $Time::Local::no_range_check = 1, +or by invoking the module with C<use Time::Local 'no_range_check'>. +This enables you to abuse the terminology somewhat and gain the +flexibilty to do things like: + + use Time::Local qw( no_range_check ); + + # The 365th day of 1999 + print scalar localtime timelocal 0,0,0,365,0,99; + + # The twenty thousandth day since 1970 + print scalar localtime timelocal 0,0,0,20000,0,70; + + # And even the 10,000,000th second since 1999! + print scalar localtime timelocal 10000000,0,0,1,0,99; + +Your mileage may vary when trying this trick with minutes and hours, +and it doesn't work at all for months. + Strictly speaking, the year should also be specified in a form consistent with localtime(), i.e. the offset from 1900. In order to make the interpretation of the year easier for humans, diff --git a/lib/attributes.pm b/lib/attributes.pm index e49204fc76..09f355139f 100644 --- a/lib/attributes.pm +++ b/lib/attributes.pm @@ -1,9 +1,10 @@ package attributes; -$VERSION = 0.01; +$VERSION = 0.02; -#@EXPORT_OK = qw(get reftype); -#@EXPORT = (); +@EXPORT_OK = qw(get reftype); +@EXPORT = (); +%EXPORT_TAGS = (ALL => [@EXPORT, @EXPORT_OK]); use strict; @@ -29,8 +30,10 @@ sub carp { BEGIN { bootstrap } sub import { - @_ > 2 && ref $_[2] or - croak 'Usage: use '.__PACKAGE__.' $home_stash, $ref, @attrlist'; + @_ > 2 && ref $_[2] or do { + require Exporter; + goto &Exporter::import; + }; my (undef,$home_stash,$svref,@attrs) = @_; my $svtype = uc reftype($svref); @@ -82,12 +85,7 @@ sub get ($) { ; } -#sub export { -# require Exporter; -# goto &Exporter::import; -#} -# -#sub require_version { goto &UNIVERSAL::VERSION } +sub require_version { goto &UNIVERSAL::VERSION } 1; __END__ @@ -106,13 +104,16 @@ attributes - get/set subroutine or variable attributes use attributes (); # optional, to get subroutine declarations my @attrlist = attributes::get(\&foo); + use attributes 'get'; # import the attributes::get subroutine + my @attrlist = get \&foo; + =head1 DESCRIPTION Subroutine declarations and definitions may optionally have attribute lists associated with them. (Variable C<my> declarations also may, but see the warning below.) Perl handles these declarations by passing some information about the call site and the thing being declared along with the attribute -list to this module. In particular, first example above is equivalent to +list to this module. In particular, the first example above is equivalent to the following: use attributes __PACKAGE__, \&foo, 'method'; @@ -187,7 +188,7 @@ empty. If passed invalid arguments, it uses die() (via L<Carp::croak|Carp>) to raise a fatal exception. If it can find an appropriate package name for a class method lookup, it will include the results from a C<FETCH_I<type>_ATTRIBUTES> call in its return list, as described in -L"Package-specific Attribute Handling"> below. +L<"Package-specific Attribute Handling"> below. Otherwise, only L<built-in attributes|"Built-in Attributes"> will be returned. =item reftype @@ -196,13 +197,11 @@ This routine expects a single parameter--a reference to a subroutine or variable. It returns the built-in type of the referenced variable, ignoring any package into which it might have been blessed. This can be useful for determining the I<type> value which forms part of -the method names described in L"Package-specific Attribute Handling"> below. +the method names described in L<"Package-specific Attribute Handling"> below. =back -Note that these routines are I<not> exported. This is primarily because -the C<use> mechanism which would normally import them is already in use -by Perl itself to implement the C<sub : attributes> syntax. +Note that these routines are I<not> exported by default. =head2 Package-specific Attribute Handling @@ -289,6 +288,20 @@ Some examples of syntactically invalid attribute lists (with annotation): Y2::north # "Y2::north" not a simple identifier foo + bar # "+" neither a comma nor whitespace +=head1 EXPORTS + +=head2 Default exports + +None. + +=head2 Available exports + +The routines C<get> and C<reftype> are exportable. + +=head2 Export tags defined + +The C<:ALL> tag will get all of the above exports. + =head1 EXAMPLES Here are some samples of syntactically valid declarations, with annotation @@ -67,11 +67,11 @@ Perl_mg_magical(pTHX_ SV *sv) for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; if (vtbl) { - if ((vtbl->svt_get != NULL) && !(mg->mg_flags & MGf_GSKIP)) + if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP)) SvGMAGICAL_on(sv); if (vtbl->svt_set) SvSMAGICAL_on(sv); - if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || (vtbl->svt_clear != NULL)) + if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear) SvRMAGICAL_on(sv); } } @@ -92,7 +92,7 @@ Perl_mg_get(pTHX_ SV *sv) mgp = &SvMAGIC(sv); while ((mg = *mgp) != 0) { MGVTBL* vtbl = mg->mg_virtual; - if (!(mg->mg_flags & MGf_GSKIP) && vtbl && (vtbl->svt_get != NULL)) { + if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) { CALL_FPTR(vtbl->svt_get)(aTHX_ sv, mg); /* Ignore this magic if it's been deleted */ if ((mg == (mgp_valid ? *mgp : SvMAGIC(sv))) && @@ -130,7 +130,7 @@ Perl_mg_set(pTHX_ SV *sv) mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */ (SSPTR(mgs_ix, MGS*))->mgs_flags = 0; } - if (vtbl && (vtbl->svt_set != NULL)) + if (vtbl && vtbl->svt_set) CALL_FPTR(vtbl->svt_set)(aTHX_ sv, mg); } @@ -147,7 +147,7 @@ Perl_mg_length(pTHX_ SV *sv) for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; - if (vtbl && (vtbl->svt_len != NULL)) { + if (vtbl && vtbl->svt_len) { I32 mgs_ix; mgs_ix = SSNEW(sizeof(MGS)); @@ -171,7 +171,7 @@ Perl_mg_size(pTHX_ SV *sv) for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; - if (vtbl && (vtbl->svt_len != NULL)) { + if (vtbl && vtbl->svt_len) { I32 mgs_ix; mgs_ix = SSNEW(sizeof(MGS)); @@ -209,7 +209,7 @@ Perl_mg_clear(pTHX_ SV *sv) MGVTBL* vtbl = mg->mg_virtual; /* omit GSKIP -- never set here */ - if (vtbl && (vtbl->svt_clear != NULL)) + if (vtbl && vtbl->svt_clear) CALL_FPTR(vtbl->svt_clear)(aTHX_ sv, mg); } @@ -252,7 +252,7 @@ Perl_mg_free(pTHX_ SV *sv) for (mg = SvMAGIC(sv); mg; mg = moremagic) { MGVTBL* vtbl = mg->mg_virtual; moremagic = mg->mg_moremagic; - if (vtbl && (vtbl->svt_free != NULL)) + if (vtbl && vtbl->svt_free) CALL_FPTR(vtbl->svt_free)(aTHX_ sv, mg); if (mg->mg_ptr && mg->mg_type != 'g') if (mg->mg_len >= 0) @@ -638,7 +638,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) int saveerrno = errno; sv_setnv(sv, (NV)errno); #ifdef OS2 - if (errno == errno_isOS2) sv_setpv(sv, os2error(Perl_rc)); + if (errno == errno_isOS2 || errno == errno_isOS2_set) + sv_setpv(sv, os2error(Perl_rc)); else #endif sv_setpv(sv, errno ? Strerror(errno) : ""); @@ -1125,7 +1126,7 @@ int Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key) { dSP; - char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY"; + const char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY"; ENTER; SAVETMPS; diff --git a/miniperlmain.c b/miniperlmain.c index f7b24f45cc..fb5cf1afe8 100644 --- a/miniperlmain.c +++ b/miniperlmain.c @@ -38,7 +38,7 @@ main(int argc, char **argv, char **env) #undef PERLVARIC #endif - PERL_SYS_INIT(&argc,&argv); + PERL_SYS_INIT3(&argc,&argv,&env); if (!PL_do_undump) { my_perl = perl_alloc(); @@ -42,8 +42,6 @@ #define PL_StdIO (*Perl_IStdIO_ptr(aTHXo)) #undef PL_amagic_generation #define PL_amagic_generation (*Perl_Iamagic_generation_ptr(aTHXo)) -#undef PL_ampergv -#define PL_ampergv (*Perl_Iampergv_ptr(aTHXo)) #undef PL_an #define PL_an (*Perl_Ian_ptr(aTHXo)) #undef PL_archpat_auto @@ -62,8 +60,6 @@ #define PL_bufend (*Perl_Ibufend_ptr(aTHXo)) #undef PL_bufptr #define PL_bufptr (*Perl_Ibufptr_ptr(aTHXo)) -#undef PL_cddir -#define PL_cddir (*Perl_Icddir_ptr(aTHXo)) #undef PL_collation_ix #define PL_collation_ix (*Perl_Icollation_ix_ptr(aTHXo)) #undef PL_collation_name @@ -106,10 +102,6 @@ #define PL_curthr (*Perl_Icurthr_ptr(aTHXo)) #undef PL_dbargs #define PL_dbargs (*Perl_Idbargs_ptr(aTHXo)) -#undef PL_debdelim -#define PL_debdelim (*Perl_Idebdelim_ptr(aTHXo)) -#undef PL_debname -#define PL_debname (*Perl_Idebname_ptr(aTHXo)) #undef PL_debstash #define PL_debstash (*Perl_Idebstash_ptr(aTHXo)) #undef PL_debug @@ -118,10 +110,6 @@ #define PL_defgv (*Perl_Idefgv_ptr(aTHXo)) #undef PL_diehook #define PL_diehook (*Perl_Idiehook_ptr(aTHXo)) -#undef PL_dlevel -#define PL_dlevel (*Perl_Idlevel_ptr(aTHXo)) -#undef PL_dlmax -#define PL_dlmax (*Perl_Idlmax_ptr(aTHXo)) #undef PL_doextract #define PL_doextract (*Perl_Idoextract_ptr(aTHXo)) #undef PL_doswitches @@ -164,8 +152,6 @@ #define PL_fdpid (*Perl_Ifdpid_ptr(aTHXo)) #undef PL_filemode #define PL_filemode (*Perl_Ifilemode_ptr(aTHXo)) -#undef PL_filter_debug -#define PL_filter_debug (*Perl_Ifilter_debug_ptr(aTHXo)) #undef PL_forkprocess #define PL_forkprocess (*Perl_Iforkprocess_ptr(aTHXo)) #undef PL_formfeed @@ -218,16 +204,10 @@ #define PL_last_uni (*Perl_Ilast_uni_ptr(aTHXo)) #undef PL_lastfd #define PL_lastfd (*Perl_Ilastfd_ptr(aTHXo)) -#undef PL_lastsize -#define PL_lastsize (*Perl_Ilastsize_ptr(aTHXo)) -#undef PL_lastspbase -#define PL_lastspbase (*Perl_Ilastspbase_ptr(aTHXo)) #undef PL_laststatval #define PL_laststatval (*Perl_Ilaststatval_ptr(aTHXo)) #undef PL_laststype #define PL_laststype (*Perl_Ilaststype_ptr(aTHXo)) -#undef PL_leftgv -#define PL_leftgv (*Perl_Ileftgv_ptr(aTHXo)) #undef PL_lex_brackets #define PL_lex_brackets (*Perl_Ilex_brackets_ptr(aTHXo)) #undef PL_lex_brackstack @@ -308,8 +288,6 @@ #define PL_multi_start (*Perl_Imulti_start_ptr(aTHXo)) #undef PL_multiline #define PL_multiline (*Perl_Imultiline_ptr(aTHXo)) -#undef PL_mystrk -#define PL_mystrk (*Perl_Imystrk_ptr(aTHXo)) #undef PL_nexttoke #define PL_nexttoke (*Perl_Inexttoke_ptr(aTHXo)) #undef PL_nexttype @@ -338,8 +316,6 @@ #define PL_ofmt (*Perl_Iofmt_ptr(aTHXo)) #undef PL_oldbufptr #define PL_oldbufptr (*Perl_Ioldbufptr_ptr(aTHXo)) -#undef PL_oldlastpm -#define PL_oldlastpm (*Perl_Ioldlastpm_ptr(aTHXo)) #undef PL_oldname #define PL_oldname (*Perl_Ioldname_ptr(aTHXo)) #undef PL_oldoldbufptr @@ -390,8 +366,6 @@ #define PL_profiledata (*Perl_Iprofiledata_ptr(aTHXo)) #undef PL_replgv #define PL_replgv (*Perl_Ireplgv_ptr(aTHXo)) -#undef PL_rightgv -#define PL_rightgv (*Perl_Irightgv_ptr(aTHXo)) #undef PL_rsfp #define PL_rsfp (*Perl_Irsfp_ptr(aTHXo)) #undef PL_rsfp_filters @@ -400,14 +374,8 @@ #define PL_runops (*Perl_Irunops_ptr(aTHXo)) #undef PL_sawampersand #define PL_sawampersand (*Perl_Isawampersand_ptr(aTHXo)) -#undef PL_sawstudy -#define PL_sawstudy (*Perl_Isawstudy_ptr(aTHXo)) -#undef PL_sawvec -#define PL_sawvec (*Perl_Isawvec_ptr(aTHXo)) #undef PL_sh_path #define PL_sh_path (*Perl_Ish_path_ptr(aTHXo)) -#undef PL_siggv -#define PL_siggv (*Perl_Isiggv_ptr(aTHXo)) #undef PL_sighandlerp #define PL_sighandlerp (*Perl_Isighandlerp_ptr(aTHXo)) #undef PL_splitstr @@ -422,8 +390,6 @@ #define PL_stderrgv (*Perl_Istderrgv_ptr(aTHXo)) #undef PL_stdingv #define PL_stdingv (*Perl_Istdingv_ptr(aTHXo)) -#undef PL_strchop -#define PL_strchop (*Perl_Istrchop_ptr(aTHXo)) #undef PL_strtab #define PL_strtab (*Perl_Istrtab_ptr(aTHXo)) #undef PL_strtab_mutex @@ -458,8 +424,6 @@ #define PL_sys_intern (*Perl_Isys_intern_ptr(aTHXo)) #undef PL_tainting #define PL_tainting (*Perl_Itainting_ptr(aTHXo)) -#undef PL_thisexpr -#define PL_thisexpr (*Perl_Ithisexpr_ptr(aTHXo)) #undef PL_thr_key #define PL_thr_key (*Perl_Ithr_key_ptr(aTHXo)) #undef PL_threadnum @@ -1127,10 +1091,6 @@ #define Perl_vdeb pPerl->Perl_vdeb #undef vdeb #define vdeb Perl_vdeb -#undef Perl_deb_growlevel -#define Perl_deb_growlevel pPerl->Perl_deb_growlevel -#undef deb_growlevel -#define deb_growlevel Perl_deb_growlevel #undef Perl_debprofdump #define Perl_debprofdump pPerl->Perl_debprofdump #undef debprofdump @@ -1816,9 +1816,9 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right) char *desc = PL_op_desc[(right->op_type == OP_SUBST || right->op_type == OP_TRANS) ? right->op_type : OP_MATCH]; - char *sample = ((left->op_type == OP_RV2AV || - left->op_type == OP_PADAV) - ? "@array" : "%hash"); + const char *sample = ((left->op_type == OP_RV2AV || + left->op_type == OP_PADAV) + ? "@array" : "%hash"); Perl_warner(aTHX_ WARN_UNSAFE, "Applying %s to %s will act on scalar(%s)", desc, sample, sample); @@ -2118,8 +2118,12 @@ Perl_fold_constants(pTHX_ register OP *o) return o; if (!(PL_hints & HINT_INTEGER)) { - if (type == OP_DIVIDE || !(o->op_flags & OPf_KIDS)) + if (type == OP_MODULO + || type == OP_DIVIDE + || !(o->op_flags & OPf_KIDS)) + { return o; + } for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) { if (curop->op_type == OP_CONST) { @@ -736,357 +736,357 @@ START_EXTERN_C EXT OP * (CPERLscope(*PL_ppaddr)[])(pTHX); #else EXT OP * (CPERLscope(*PL_ppaddr)[])(pTHX) = { - Perl_pp_null, - Perl_pp_stub, - Perl_pp_scalar, - Perl_pp_pushmark, - Perl_pp_wantarray, - Perl_pp_const, - Perl_pp_gvsv, - Perl_pp_gv, - Perl_pp_gelem, - Perl_pp_padsv, - Perl_pp_padav, - Perl_pp_padhv, - Perl_pp_padany, - Perl_pp_pushre, - Perl_pp_rv2gv, - Perl_pp_rv2sv, - Perl_pp_av2arylen, - Perl_pp_rv2cv, - Perl_pp_anoncode, - Perl_pp_prototype, - Perl_pp_refgen, - Perl_pp_srefgen, - Perl_pp_ref, - Perl_pp_bless, - Perl_pp_backtick, - Perl_pp_glob, - Perl_pp_readline, - Perl_pp_rcatline, - Perl_pp_regcmaybe, - Perl_pp_regcreset, - Perl_pp_regcomp, - Perl_pp_match, - Perl_pp_qr, - Perl_pp_subst, - Perl_pp_substcont, - Perl_pp_trans, - Perl_pp_sassign, - Perl_pp_aassign, - Perl_pp_chop, - Perl_pp_schop, - Perl_pp_chomp, - Perl_pp_schomp, - Perl_pp_defined, - Perl_pp_undef, - Perl_pp_study, - Perl_pp_pos, - Perl_pp_preinc, - Perl_pp_i_preinc, - Perl_pp_predec, - Perl_pp_i_predec, - Perl_pp_postinc, - Perl_pp_i_postinc, - Perl_pp_postdec, - Perl_pp_i_postdec, - Perl_pp_pow, - Perl_pp_multiply, - Perl_pp_i_multiply, - Perl_pp_divide, - Perl_pp_i_divide, - Perl_pp_modulo, - Perl_pp_i_modulo, - Perl_pp_repeat, - Perl_pp_add, - Perl_pp_i_add, - Perl_pp_subtract, - Perl_pp_i_subtract, - Perl_pp_concat, - Perl_pp_stringify, - Perl_pp_left_shift, - Perl_pp_right_shift, - Perl_pp_lt, - Perl_pp_i_lt, - Perl_pp_gt, - Perl_pp_i_gt, - Perl_pp_le, - Perl_pp_i_le, - Perl_pp_ge, - Perl_pp_i_ge, - Perl_pp_eq, - Perl_pp_i_eq, - Perl_pp_ne, - Perl_pp_i_ne, - Perl_pp_ncmp, - Perl_pp_i_ncmp, - Perl_pp_slt, - Perl_pp_sgt, - Perl_pp_sle, - Perl_pp_sge, - Perl_pp_seq, - Perl_pp_sne, - Perl_pp_scmp, - Perl_pp_bit_and, - Perl_pp_bit_xor, - Perl_pp_bit_or, - Perl_pp_negate, - Perl_pp_i_negate, - Perl_pp_not, - Perl_pp_complement, - Perl_pp_atan2, - Perl_pp_sin, - Perl_pp_cos, - Perl_pp_rand, - Perl_pp_srand, - Perl_pp_exp, - Perl_pp_log, - Perl_pp_sqrt, - Perl_pp_int, - Perl_pp_hex, - Perl_pp_oct, - Perl_pp_abs, - Perl_pp_length, - Perl_pp_substr, - Perl_pp_vec, - Perl_pp_index, - Perl_pp_rindex, - Perl_pp_sprintf, - Perl_pp_formline, - Perl_pp_ord, - Perl_pp_chr, - Perl_pp_crypt, - Perl_pp_ucfirst, - Perl_pp_lcfirst, - Perl_pp_uc, - Perl_pp_lc, - Perl_pp_quotemeta, - Perl_pp_rv2av, - Perl_pp_aelemfast, - Perl_pp_aelem, - Perl_pp_aslice, - Perl_pp_each, - Perl_pp_values, - Perl_pp_keys, - Perl_pp_delete, - Perl_pp_exists, - Perl_pp_rv2hv, - Perl_pp_helem, - Perl_pp_hslice, - Perl_pp_unpack, - Perl_pp_pack, - Perl_pp_split, - Perl_pp_join, - Perl_pp_list, - Perl_pp_lslice, - Perl_pp_anonlist, - Perl_pp_anonhash, - Perl_pp_splice, - Perl_pp_push, - Perl_pp_pop, - Perl_pp_shift, - Perl_pp_unshift, - Perl_pp_sort, - Perl_pp_reverse, - Perl_pp_grepstart, - Perl_pp_grepwhile, - Perl_pp_mapstart, - Perl_pp_mapwhile, - Perl_pp_range, - Perl_pp_flip, - Perl_pp_flop, - Perl_pp_and, - Perl_pp_or, - Perl_pp_xor, - Perl_pp_cond_expr, - Perl_pp_andassign, - Perl_pp_orassign, - Perl_pp_method, - Perl_pp_entersub, - Perl_pp_leavesub, - Perl_pp_leavesublv, - Perl_pp_caller, - Perl_pp_warn, - Perl_pp_die, - Perl_pp_reset, - Perl_pp_lineseq, - Perl_pp_nextstate, - Perl_pp_dbstate, - Perl_pp_unstack, - Perl_pp_enter, - Perl_pp_leave, - Perl_pp_scope, - Perl_pp_enteriter, - Perl_pp_iter, - Perl_pp_enterloop, - Perl_pp_leaveloop, - Perl_pp_return, - Perl_pp_last, - Perl_pp_next, - Perl_pp_redo, - Perl_pp_dump, - Perl_pp_goto, - Perl_pp_exit, - Perl_pp_open, - Perl_pp_close, - Perl_pp_pipe_op, - Perl_pp_fileno, - Perl_pp_umask, - Perl_pp_binmode, - Perl_pp_tie, - Perl_pp_untie, - Perl_pp_tied, - Perl_pp_dbmopen, - Perl_pp_dbmclose, - Perl_pp_sselect, - Perl_pp_select, - Perl_pp_getc, - Perl_pp_read, - Perl_pp_enterwrite, - Perl_pp_leavewrite, - Perl_pp_prtf, - Perl_pp_print, - Perl_pp_sysopen, - Perl_pp_sysseek, - Perl_pp_sysread, - Perl_pp_syswrite, - Perl_pp_send, - Perl_pp_recv, - Perl_pp_eof, - Perl_pp_tell, - Perl_pp_seek, - Perl_pp_truncate, - Perl_pp_fcntl, - Perl_pp_ioctl, - Perl_pp_flock, - Perl_pp_socket, - Perl_pp_sockpair, - Perl_pp_bind, - Perl_pp_connect, - Perl_pp_listen, - Perl_pp_accept, - Perl_pp_shutdown, - Perl_pp_gsockopt, - Perl_pp_ssockopt, - Perl_pp_getsockname, - Perl_pp_getpeername, - Perl_pp_lstat, - Perl_pp_stat, - Perl_pp_ftrread, - Perl_pp_ftrwrite, - Perl_pp_ftrexec, - Perl_pp_fteread, - Perl_pp_ftewrite, - Perl_pp_fteexec, - Perl_pp_ftis, - Perl_pp_fteowned, - Perl_pp_ftrowned, - Perl_pp_ftzero, - Perl_pp_ftsize, - Perl_pp_ftmtime, - Perl_pp_ftatime, - Perl_pp_ftctime, - Perl_pp_ftsock, - Perl_pp_ftchr, - Perl_pp_ftblk, - Perl_pp_ftfile, - Perl_pp_ftdir, - Perl_pp_ftpipe, - Perl_pp_ftlink, - Perl_pp_ftsuid, - Perl_pp_ftsgid, - Perl_pp_ftsvtx, - Perl_pp_fttty, - Perl_pp_fttext, - Perl_pp_ftbinary, - Perl_pp_chdir, - Perl_pp_chown, - Perl_pp_chroot, - Perl_pp_unlink, - Perl_pp_chmod, - Perl_pp_utime, - Perl_pp_rename, - Perl_pp_link, - Perl_pp_symlink, - Perl_pp_readlink, - Perl_pp_mkdir, - Perl_pp_rmdir, - Perl_pp_open_dir, - Perl_pp_readdir, - Perl_pp_telldir, - Perl_pp_seekdir, - Perl_pp_rewinddir, - Perl_pp_closedir, - Perl_pp_fork, - Perl_pp_wait, - Perl_pp_waitpid, - Perl_pp_system, - Perl_pp_exec, - Perl_pp_kill, - Perl_pp_getppid, - Perl_pp_getpgrp, - Perl_pp_setpgrp, - Perl_pp_getpriority, - Perl_pp_setpriority, - Perl_pp_time, - Perl_pp_tms, - Perl_pp_localtime, - Perl_pp_gmtime, - Perl_pp_alarm, - Perl_pp_sleep, - Perl_pp_shmget, - Perl_pp_shmctl, - Perl_pp_shmread, - Perl_pp_shmwrite, - Perl_pp_msgget, - Perl_pp_msgctl, - Perl_pp_msgsnd, - Perl_pp_msgrcv, - Perl_pp_semget, - Perl_pp_semctl, - Perl_pp_semop, - Perl_pp_require, - Perl_pp_dofile, - Perl_pp_entereval, - Perl_pp_leaveeval, - Perl_pp_entertry, - Perl_pp_leavetry, - Perl_pp_ghbyname, - Perl_pp_ghbyaddr, - Perl_pp_ghostent, - Perl_pp_gnbyname, - Perl_pp_gnbyaddr, - Perl_pp_gnetent, - Perl_pp_gpbyname, - Perl_pp_gpbynumber, - Perl_pp_gprotoent, - Perl_pp_gsbyname, - Perl_pp_gsbyport, - Perl_pp_gservent, - Perl_pp_shostent, - Perl_pp_snetent, - Perl_pp_sprotoent, - Perl_pp_sservent, - Perl_pp_ehostent, - Perl_pp_enetent, - Perl_pp_eprotoent, - Perl_pp_eservent, - Perl_pp_gpwnam, - Perl_pp_gpwuid, - Perl_pp_gpwent, - Perl_pp_spwent, - Perl_pp_epwent, - Perl_pp_ggrnam, - Perl_pp_ggrgid, - Perl_pp_ggrent, - Perl_pp_sgrent, - Perl_pp_egrent, - Perl_pp_getlogin, - Perl_pp_syscall, - Perl_pp_lock, - Perl_pp_threadsv, - Perl_pp_setstate, - Perl_pp_method_named, + MEMBER_TO_FPTR(Perl_pp_null), + MEMBER_TO_FPTR(Perl_pp_stub), + MEMBER_TO_FPTR(Perl_pp_scalar), + MEMBER_TO_FPTR(Perl_pp_pushmark), + MEMBER_TO_FPTR(Perl_pp_wantarray), + MEMBER_TO_FPTR(Perl_pp_const), + MEMBER_TO_FPTR(Perl_pp_gvsv), + MEMBER_TO_FPTR(Perl_pp_gv), + MEMBER_TO_FPTR(Perl_pp_gelem), + MEMBER_TO_FPTR(Perl_pp_padsv), + MEMBER_TO_FPTR(Perl_pp_padav), + MEMBER_TO_FPTR(Perl_pp_padhv), + MEMBER_TO_FPTR(Perl_pp_padany), + MEMBER_TO_FPTR(Perl_pp_pushre), + MEMBER_TO_FPTR(Perl_pp_rv2gv), + MEMBER_TO_FPTR(Perl_pp_rv2sv), + MEMBER_TO_FPTR(Perl_pp_av2arylen), + MEMBER_TO_FPTR(Perl_pp_rv2cv), + MEMBER_TO_FPTR(Perl_pp_anoncode), + MEMBER_TO_FPTR(Perl_pp_prototype), + MEMBER_TO_FPTR(Perl_pp_refgen), + MEMBER_TO_FPTR(Perl_pp_srefgen), + MEMBER_TO_FPTR(Perl_pp_ref), + MEMBER_TO_FPTR(Perl_pp_bless), + MEMBER_TO_FPTR(Perl_pp_backtick), + MEMBER_TO_FPTR(Perl_pp_glob), + MEMBER_TO_FPTR(Perl_pp_readline), + MEMBER_TO_FPTR(Perl_pp_rcatline), + MEMBER_TO_FPTR(Perl_pp_regcmaybe), + MEMBER_TO_FPTR(Perl_pp_regcreset), + MEMBER_TO_FPTR(Perl_pp_regcomp), + MEMBER_TO_FPTR(Perl_pp_match), + MEMBER_TO_FPTR(Perl_pp_qr), + MEMBER_TO_FPTR(Perl_pp_subst), + MEMBER_TO_FPTR(Perl_pp_substcont), + MEMBER_TO_FPTR(Perl_pp_trans), + MEMBER_TO_FPTR(Perl_pp_sassign), + MEMBER_TO_FPTR(Perl_pp_aassign), + MEMBER_TO_FPTR(Perl_pp_chop), + MEMBER_TO_FPTR(Perl_pp_schop), + MEMBER_TO_FPTR(Perl_pp_chomp), + MEMBER_TO_FPTR(Perl_pp_schomp), + MEMBER_TO_FPTR(Perl_pp_defined), + MEMBER_TO_FPTR(Perl_pp_undef), + MEMBER_TO_FPTR(Perl_pp_study), + MEMBER_TO_FPTR(Perl_pp_pos), + MEMBER_TO_FPTR(Perl_pp_preinc), + MEMBER_TO_FPTR(Perl_pp_i_preinc), + MEMBER_TO_FPTR(Perl_pp_predec), + MEMBER_TO_FPTR(Perl_pp_i_predec), + MEMBER_TO_FPTR(Perl_pp_postinc), + MEMBER_TO_FPTR(Perl_pp_i_postinc), + MEMBER_TO_FPTR(Perl_pp_postdec), + MEMBER_TO_FPTR(Perl_pp_i_postdec), + MEMBER_TO_FPTR(Perl_pp_pow), + MEMBER_TO_FPTR(Perl_pp_multiply), + MEMBER_TO_FPTR(Perl_pp_i_multiply), + MEMBER_TO_FPTR(Perl_pp_divide), + MEMBER_TO_FPTR(Perl_pp_i_divide), + MEMBER_TO_FPTR(Perl_pp_modulo), + MEMBER_TO_FPTR(Perl_pp_i_modulo), + MEMBER_TO_FPTR(Perl_pp_repeat), + MEMBER_TO_FPTR(Perl_pp_add), + MEMBER_TO_FPTR(Perl_pp_i_add), + MEMBER_TO_FPTR(Perl_pp_subtract), + MEMBER_TO_FPTR(Perl_pp_i_subtract), + MEMBER_TO_FPTR(Perl_pp_concat), + MEMBER_TO_FPTR(Perl_pp_stringify), + MEMBER_TO_FPTR(Perl_pp_left_shift), + MEMBER_TO_FPTR(Perl_pp_right_shift), + MEMBER_TO_FPTR(Perl_pp_lt), + MEMBER_TO_FPTR(Perl_pp_i_lt), + MEMBER_TO_FPTR(Perl_pp_gt), + MEMBER_TO_FPTR(Perl_pp_i_gt), + MEMBER_TO_FPTR(Perl_pp_le), + MEMBER_TO_FPTR(Perl_pp_i_le), + MEMBER_TO_FPTR(Perl_pp_ge), + MEMBER_TO_FPTR(Perl_pp_i_ge), + MEMBER_TO_FPTR(Perl_pp_eq), + MEMBER_TO_FPTR(Perl_pp_i_eq), + MEMBER_TO_FPTR(Perl_pp_ne), + MEMBER_TO_FPTR(Perl_pp_i_ne), + MEMBER_TO_FPTR(Perl_pp_ncmp), + MEMBER_TO_FPTR(Perl_pp_i_ncmp), + MEMBER_TO_FPTR(Perl_pp_slt), + MEMBER_TO_FPTR(Perl_pp_sgt), + MEMBER_TO_FPTR(Perl_pp_sle), + MEMBER_TO_FPTR(Perl_pp_sge), + MEMBER_TO_FPTR(Perl_pp_seq), + MEMBER_TO_FPTR(Perl_pp_sne), + MEMBER_TO_FPTR(Perl_pp_scmp), + MEMBER_TO_FPTR(Perl_pp_bit_and), + MEMBER_TO_FPTR(Perl_pp_bit_xor), + MEMBER_TO_FPTR(Perl_pp_bit_or), + MEMBER_TO_FPTR(Perl_pp_negate), + MEMBER_TO_FPTR(Perl_pp_i_negate), + MEMBER_TO_FPTR(Perl_pp_not), + MEMBER_TO_FPTR(Perl_pp_complement), + MEMBER_TO_FPTR(Perl_pp_atan2), + MEMBER_TO_FPTR(Perl_pp_sin), + MEMBER_TO_FPTR(Perl_pp_cos), + MEMBER_TO_FPTR(Perl_pp_rand), + MEMBER_TO_FPTR(Perl_pp_srand), + MEMBER_TO_FPTR(Perl_pp_exp), + MEMBER_TO_FPTR(Perl_pp_log), + MEMBER_TO_FPTR(Perl_pp_sqrt), + MEMBER_TO_FPTR(Perl_pp_int), + MEMBER_TO_FPTR(Perl_pp_hex), + MEMBER_TO_FPTR(Perl_pp_oct), + MEMBER_TO_FPTR(Perl_pp_abs), + MEMBER_TO_FPTR(Perl_pp_length), + MEMBER_TO_FPTR(Perl_pp_substr), + MEMBER_TO_FPTR(Perl_pp_vec), + MEMBER_TO_FPTR(Perl_pp_index), + MEMBER_TO_FPTR(Perl_pp_rindex), + MEMBER_TO_FPTR(Perl_pp_sprintf), + MEMBER_TO_FPTR(Perl_pp_formline), + MEMBER_TO_FPTR(Perl_pp_ord), + MEMBER_TO_FPTR(Perl_pp_chr), + MEMBER_TO_FPTR(Perl_pp_crypt), + MEMBER_TO_FPTR(Perl_pp_ucfirst), + MEMBER_TO_FPTR(Perl_pp_lcfirst), + MEMBER_TO_FPTR(Perl_pp_uc), + MEMBER_TO_FPTR(Perl_pp_lc), + MEMBER_TO_FPTR(Perl_pp_quotemeta), + MEMBER_TO_FPTR(Perl_pp_rv2av), + MEMBER_TO_FPTR(Perl_pp_aelemfast), + MEMBER_TO_FPTR(Perl_pp_aelem), + MEMBER_TO_FPTR(Perl_pp_aslice), + MEMBER_TO_FPTR(Perl_pp_each), + MEMBER_TO_FPTR(Perl_pp_values), + MEMBER_TO_FPTR(Perl_pp_keys), + MEMBER_TO_FPTR(Perl_pp_delete), + MEMBER_TO_FPTR(Perl_pp_exists), + MEMBER_TO_FPTR(Perl_pp_rv2hv), + MEMBER_TO_FPTR(Perl_pp_helem), + MEMBER_TO_FPTR(Perl_pp_hslice), + MEMBER_TO_FPTR(Perl_pp_unpack), + MEMBER_TO_FPTR(Perl_pp_pack), + MEMBER_TO_FPTR(Perl_pp_split), + MEMBER_TO_FPTR(Perl_pp_join), + MEMBER_TO_FPTR(Perl_pp_list), + MEMBER_TO_FPTR(Perl_pp_lslice), + MEMBER_TO_FPTR(Perl_pp_anonlist), + MEMBER_TO_FPTR(Perl_pp_anonhash), + MEMBER_TO_FPTR(Perl_pp_splice), + MEMBER_TO_FPTR(Perl_pp_push), + MEMBER_TO_FPTR(Perl_pp_pop), + MEMBER_TO_FPTR(Perl_pp_shift), + MEMBER_TO_FPTR(Perl_pp_unshift), + MEMBER_TO_FPTR(Perl_pp_sort), + MEMBER_TO_FPTR(Perl_pp_reverse), + MEMBER_TO_FPTR(Perl_pp_grepstart), + MEMBER_TO_FPTR(Perl_pp_grepwhile), + MEMBER_TO_FPTR(Perl_pp_mapstart), + MEMBER_TO_FPTR(Perl_pp_mapwhile), + MEMBER_TO_FPTR(Perl_pp_range), + MEMBER_TO_FPTR(Perl_pp_flip), + MEMBER_TO_FPTR(Perl_pp_flop), + MEMBER_TO_FPTR(Perl_pp_and), + MEMBER_TO_FPTR(Perl_pp_or), + MEMBER_TO_FPTR(Perl_pp_xor), + MEMBER_TO_FPTR(Perl_pp_cond_expr), + MEMBER_TO_FPTR(Perl_pp_andassign), + MEMBER_TO_FPTR(Perl_pp_orassign), + MEMBER_TO_FPTR(Perl_pp_method), + MEMBER_TO_FPTR(Perl_pp_entersub), + MEMBER_TO_FPTR(Perl_pp_leavesub), + MEMBER_TO_FPTR(Perl_pp_leavesublv), + MEMBER_TO_FPTR(Perl_pp_caller), + MEMBER_TO_FPTR(Perl_pp_warn), + MEMBER_TO_FPTR(Perl_pp_die), + MEMBER_TO_FPTR(Perl_pp_reset), + MEMBER_TO_FPTR(Perl_pp_lineseq), + MEMBER_TO_FPTR(Perl_pp_nextstate), + MEMBER_TO_FPTR(Perl_pp_dbstate), + MEMBER_TO_FPTR(Perl_pp_unstack), + MEMBER_TO_FPTR(Perl_pp_enter), + MEMBER_TO_FPTR(Perl_pp_leave), + MEMBER_TO_FPTR(Perl_pp_scope), + MEMBER_TO_FPTR(Perl_pp_enteriter), + MEMBER_TO_FPTR(Perl_pp_iter), + MEMBER_TO_FPTR(Perl_pp_enterloop), + MEMBER_TO_FPTR(Perl_pp_leaveloop), + MEMBER_TO_FPTR(Perl_pp_return), + MEMBER_TO_FPTR(Perl_pp_last), + MEMBER_TO_FPTR(Perl_pp_next), + MEMBER_TO_FPTR(Perl_pp_redo), + MEMBER_TO_FPTR(Perl_pp_dump), + MEMBER_TO_FPTR(Perl_pp_goto), + MEMBER_TO_FPTR(Perl_pp_exit), + MEMBER_TO_FPTR(Perl_pp_open), + MEMBER_TO_FPTR(Perl_pp_close), + MEMBER_TO_FPTR(Perl_pp_pipe_op), + MEMBER_TO_FPTR(Perl_pp_fileno), + MEMBER_TO_FPTR(Perl_pp_umask), + MEMBER_TO_FPTR(Perl_pp_binmode), + MEMBER_TO_FPTR(Perl_pp_tie), + MEMBER_TO_FPTR(Perl_pp_untie), + MEMBER_TO_FPTR(Perl_pp_tied), + MEMBER_TO_FPTR(Perl_pp_dbmopen), + MEMBER_TO_FPTR(Perl_pp_dbmclose), + MEMBER_TO_FPTR(Perl_pp_sselect), + MEMBER_TO_FPTR(Perl_pp_select), + MEMBER_TO_FPTR(Perl_pp_getc), + MEMBER_TO_FPTR(Perl_pp_read), + MEMBER_TO_FPTR(Perl_pp_enterwrite), + MEMBER_TO_FPTR(Perl_pp_leavewrite), + MEMBER_TO_FPTR(Perl_pp_prtf), + MEMBER_TO_FPTR(Perl_pp_print), + MEMBER_TO_FPTR(Perl_pp_sysopen), + MEMBER_TO_FPTR(Perl_pp_sysseek), + MEMBER_TO_FPTR(Perl_pp_sysread), + MEMBER_TO_FPTR(Perl_pp_syswrite), + MEMBER_TO_FPTR(Perl_pp_send), + MEMBER_TO_FPTR(Perl_pp_recv), + MEMBER_TO_FPTR(Perl_pp_eof), + MEMBER_TO_FPTR(Perl_pp_tell), + MEMBER_TO_FPTR(Perl_pp_seek), + MEMBER_TO_FPTR(Perl_pp_truncate), + MEMBER_TO_FPTR(Perl_pp_fcntl), + MEMBER_TO_FPTR(Perl_pp_ioctl), + MEMBER_TO_FPTR(Perl_pp_flock), + MEMBER_TO_FPTR(Perl_pp_socket), + MEMBER_TO_FPTR(Perl_pp_sockpair), + MEMBER_TO_FPTR(Perl_pp_bind), + MEMBER_TO_FPTR(Perl_pp_connect), + MEMBER_TO_FPTR(Perl_pp_listen), + MEMBER_TO_FPTR(Perl_pp_accept), + MEMBER_TO_FPTR(Perl_pp_shutdown), + MEMBER_TO_FPTR(Perl_pp_gsockopt), + MEMBER_TO_FPTR(Perl_pp_ssockopt), + MEMBER_TO_FPTR(Perl_pp_getsockname), + MEMBER_TO_FPTR(Perl_pp_getpeername), + MEMBER_TO_FPTR(Perl_pp_lstat), + MEMBER_TO_FPTR(Perl_pp_stat), + MEMBER_TO_FPTR(Perl_pp_ftrread), + MEMBER_TO_FPTR(Perl_pp_ftrwrite), + MEMBER_TO_FPTR(Perl_pp_ftrexec), + MEMBER_TO_FPTR(Perl_pp_fteread), + MEMBER_TO_FPTR(Perl_pp_ftewrite), + MEMBER_TO_FPTR(Perl_pp_fteexec), + MEMBER_TO_FPTR(Perl_pp_ftis), + MEMBER_TO_FPTR(Perl_pp_fteowned), + MEMBER_TO_FPTR(Perl_pp_ftrowned), + MEMBER_TO_FPTR(Perl_pp_ftzero), + MEMBER_TO_FPTR(Perl_pp_ftsize), + MEMBER_TO_FPTR(Perl_pp_ftmtime), + MEMBER_TO_FPTR(Perl_pp_ftatime), + MEMBER_TO_FPTR(Perl_pp_ftctime), + MEMBER_TO_FPTR(Perl_pp_ftsock), + MEMBER_TO_FPTR(Perl_pp_ftchr), + MEMBER_TO_FPTR(Perl_pp_ftblk), + MEMBER_TO_FPTR(Perl_pp_ftfile), + MEMBER_TO_FPTR(Perl_pp_ftdir), + MEMBER_TO_FPTR(Perl_pp_ftpipe), + MEMBER_TO_FPTR(Perl_pp_ftlink), + MEMBER_TO_FPTR(Perl_pp_ftsuid), + MEMBER_TO_FPTR(Perl_pp_ftsgid), + MEMBER_TO_FPTR(Perl_pp_ftsvtx), + MEMBER_TO_FPTR(Perl_pp_fttty), + MEMBER_TO_FPTR(Perl_pp_fttext), + MEMBER_TO_FPTR(Perl_pp_ftbinary), + MEMBER_TO_FPTR(Perl_pp_chdir), + MEMBER_TO_FPTR(Perl_pp_chown), + MEMBER_TO_FPTR(Perl_pp_chroot), + MEMBER_TO_FPTR(Perl_pp_unlink), + MEMBER_TO_FPTR(Perl_pp_chmod), + MEMBER_TO_FPTR(Perl_pp_utime), + MEMBER_TO_FPTR(Perl_pp_rename), + MEMBER_TO_FPTR(Perl_pp_link), + MEMBER_TO_FPTR(Perl_pp_symlink), + MEMBER_TO_FPTR(Perl_pp_readlink), + MEMBER_TO_FPTR(Perl_pp_mkdir), + MEMBER_TO_FPTR(Perl_pp_rmdir), + MEMBER_TO_FPTR(Perl_pp_open_dir), + MEMBER_TO_FPTR(Perl_pp_readdir), + MEMBER_TO_FPTR(Perl_pp_telldir), + MEMBER_TO_FPTR(Perl_pp_seekdir), + MEMBER_TO_FPTR(Perl_pp_rewinddir), + MEMBER_TO_FPTR(Perl_pp_closedir), + MEMBER_TO_FPTR(Perl_pp_fork), + MEMBER_TO_FPTR(Perl_pp_wait), + MEMBER_TO_FPTR(Perl_pp_waitpid), + MEMBER_TO_FPTR(Perl_pp_system), + MEMBER_TO_FPTR(Perl_pp_exec), + MEMBER_TO_FPTR(Perl_pp_kill), + MEMBER_TO_FPTR(Perl_pp_getppid), + MEMBER_TO_FPTR(Perl_pp_getpgrp), + MEMBER_TO_FPTR(Perl_pp_setpgrp), + MEMBER_TO_FPTR(Perl_pp_getpriority), + MEMBER_TO_FPTR(Perl_pp_setpriority), + MEMBER_TO_FPTR(Perl_pp_time), + MEMBER_TO_FPTR(Perl_pp_tms), + MEMBER_TO_FPTR(Perl_pp_localtime), + MEMBER_TO_FPTR(Perl_pp_gmtime), + MEMBER_TO_FPTR(Perl_pp_alarm), + MEMBER_TO_FPTR(Perl_pp_sleep), + MEMBER_TO_FPTR(Perl_pp_shmget), + MEMBER_TO_FPTR(Perl_pp_shmctl), + MEMBER_TO_FPTR(Perl_pp_shmread), + MEMBER_TO_FPTR(Perl_pp_shmwrite), + MEMBER_TO_FPTR(Perl_pp_msgget), + MEMBER_TO_FPTR(Perl_pp_msgctl), + MEMBER_TO_FPTR(Perl_pp_msgsnd), + MEMBER_TO_FPTR(Perl_pp_msgrcv), + MEMBER_TO_FPTR(Perl_pp_semget), + MEMBER_TO_FPTR(Perl_pp_semctl), + MEMBER_TO_FPTR(Perl_pp_semop), + MEMBER_TO_FPTR(Perl_pp_require), + MEMBER_TO_FPTR(Perl_pp_dofile), + MEMBER_TO_FPTR(Perl_pp_entereval), + MEMBER_TO_FPTR(Perl_pp_leaveeval), + MEMBER_TO_FPTR(Perl_pp_entertry), + MEMBER_TO_FPTR(Perl_pp_leavetry), + MEMBER_TO_FPTR(Perl_pp_ghbyname), + MEMBER_TO_FPTR(Perl_pp_ghbyaddr), + MEMBER_TO_FPTR(Perl_pp_ghostent), + MEMBER_TO_FPTR(Perl_pp_gnbyname), + MEMBER_TO_FPTR(Perl_pp_gnbyaddr), + MEMBER_TO_FPTR(Perl_pp_gnetent), + MEMBER_TO_FPTR(Perl_pp_gpbyname), + MEMBER_TO_FPTR(Perl_pp_gpbynumber), + MEMBER_TO_FPTR(Perl_pp_gprotoent), + MEMBER_TO_FPTR(Perl_pp_gsbyname), + MEMBER_TO_FPTR(Perl_pp_gsbyport), + MEMBER_TO_FPTR(Perl_pp_gservent), + MEMBER_TO_FPTR(Perl_pp_shostent), + MEMBER_TO_FPTR(Perl_pp_snetent), + MEMBER_TO_FPTR(Perl_pp_sprotoent), + MEMBER_TO_FPTR(Perl_pp_sservent), + MEMBER_TO_FPTR(Perl_pp_ehostent), + MEMBER_TO_FPTR(Perl_pp_enetent), + MEMBER_TO_FPTR(Perl_pp_eprotoent), + MEMBER_TO_FPTR(Perl_pp_eservent), + MEMBER_TO_FPTR(Perl_pp_gpwnam), + MEMBER_TO_FPTR(Perl_pp_gpwuid), + MEMBER_TO_FPTR(Perl_pp_gpwent), + MEMBER_TO_FPTR(Perl_pp_spwent), + MEMBER_TO_FPTR(Perl_pp_epwent), + MEMBER_TO_FPTR(Perl_pp_ggrnam), + MEMBER_TO_FPTR(Perl_pp_ggrgid), + MEMBER_TO_FPTR(Perl_pp_ggrent), + MEMBER_TO_FPTR(Perl_pp_sgrent), + MEMBER_TO_FPTR(Perl_pp_egrent), + MEMBER_TO_FPTR(Perl_pp_getlogin), + MEMBER_TO_FPTR(Perl_pp_syscall), + MEMBER_TO_FPTR(Perl_pp_lock), + MEMBER_TO_FPTR(Perl_pp_threadsv), + MEMBER_TO_FPTR(Perl_pp_setstate), + MEMBER_TO_FPTR(Perl_pp_method_named), }; #endif @@ -1094,357 +1094,357 @@ EXT OP * (CPERLscope(*PL_ppaddr)[])(pTHX) = { EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op); #else EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = { - Perl_ck_null, /* null */ - Perl_ck_null, /* stub */ - Perl_ck_fun, /* scalar */ - Perl_ck_null, /* pushmark */ - Perl_ck_null, /* wantarray */ - Perl_ck_svconst,/* const */ - Perl_ck_null, /* gvsv */ - Perl_ck_null, /* gv */ - Perl_ck_null, /* gelem */ - Perl_ck_null, /* padsv */ - Perl_ck_null, /* padav */ - Perl_ck_null, /* padhv */ - Perl_ck_null, /* padany */ - Perl_ck_null, /* pushre */ - Perl_ck_rvconst,/* rv2gv */ - Perl_ck_rvconst,/* rv2sv */ - Perl_ck_null, /* av2arylen */ - Perl_ck_rvconst,/* rv2cv */ - Perl_ck_anoncode,/* anoncode */ - Perl_ck_null, /* prototype */ - Perl_ck_spair, /* refgen */ - Perl_ck_null, /* srefgen */ - Perl_ck_fun, /* ref */ - Perl_ck_fun, /* bless */ - Perl_ck_null, /* backtick */ - Perl_ck_glob, /* glob */ - Perl_ck_null, /* readline */ - Perl_ck_null, /* rcatline */ - Perl_ck_fun, /* regcmaybe */ - Perl_ck_fun, /* regcreset */ - Perl_ck_null, /* regcomp */ - Perl_ck_match, /* match */ - Perl_ck_match, /* qr */ - Perl_ck_null, /* subst */ - Perl_ck_null, /* substcont */ - Perl_ck_null, /* trans */ - Perl_ck_sassign,/* sassign */ - Perl_ck_null, /* aassign */ - Perl_ck_spair, /* chop */ - Perl_ck_null, /* schop */ - Perl_ck_spair, /* chomp */ - Perl_ck_null, /* schomp */ - Perl_ck_defined,/* defined */ - Perl_ck_lfun, /* undef */ - Perl_ck_fun, /* study */ - Perl_ck_lfun, /* pos */ - Perl_ck_lfun, /* preinc */ - Perl_ck_lfun, /* i_preinc */ - Perl_ck_lfun, /* predec */ - Perl_ck_lfun, /* i_predec */ - Perl_ck_lfun, /* postinc */ - Perl_ck_lfun, /* i_postinc */ - Perl_ck_lfun, /* postdec */ - Perl_ck_lfun, /* i_postdec */ - Perl_ck_null, /* pow */ - Perl_ck_null, /* multiply */ - Perl_ck_null, /* i_multiply */ - Perl_ck_null, /* divide */ - Perl_ck_null, /* i_divide */ - Perl_ck_null, /* modulo */ - Perl_ck_null, /* i_modulo */ - Perl_ck_repeat, /* repeat */ - Perl_ck_null, /* add */ - Perl_ck_null, /* i_add */ - Perl_ck_null, /* subtract */ - Perl_ck_null, /* i_subtract */ - Perl_ck_concat, /* concat */ - Perl_ck_fun, /* stringify */ - Perl_ck_bitop, /* left_shift */ - Perl_ck_bitop, /* right_shift */ - Perl_ck_null, /* lt */ - Perl_ck_null, /* i_lt */ - Perl_ck_null, /* gt */ - Perl_ck_null, /* i_gt */ - Perl_ck_null, /* le */ - Perl_ck_null, /* i_le */ - Perl_ck_null, /* ge */ - Perl_ck_null, /* i_ge */ - Perl_ck_null, /* eq */ - Perl_ck_null, /* i_eq */ - Perl_ck_null, /* ne */ - Perl_ck_null, /* i_ne */ - Perl_ck_null, /* ncmp */ - Perl_ck_null, /* i_ncmp */ - Perl_ck_scmp, /* slt */ - Perl_ck_scmp, /* sgt */ - Perl_ck_scmp, /* sle */ - Perl_ck_scmp, /* sge */ - Perl_ck_null, /* seq */ - Perl_ck_null, /* sne */ - Perl_ck_scmp, /* scmp */ - Perl_ck_bitop, /* bit_and */ - Perl_ck_bitop, /* bit_xor */ - Perl_ck_bitop, /* bit_or */ - Perl_ck_null, /* negate */ - Perl_ck_null, /* i_negate */ - Perl_ck_null, /* not */ - Perl_ck_bitop, /* complement */ - Perl_ck_fun, /* atan2 */ - Perl_ck_fun, /* sin */ - Perl_ck_fun, /* cos */ - Perl_ck_fun, /* rand */ - Perl_ck_fun, /* srand */ - Perl_ck_fun, /* exp */ - Perl_ck_fun, /* log */ - Perl_ck_fun, /* sqrt */ - Perl_ck_fun, /* int */ - Perl_ck_fun, /* hex */ - Perl_ck_fun, /* oct */ - Perl_ck_fun, /* abs */ - Perl_ck_lengthconst,/* length */ - Perl_ck_fun, /* substr */ - Perl_ck_fun, /* vec */ - Perl_ck_index, /* index */ - Perl_ck_index, /* rindex */ - Perl_ck_fun_locale,/* sprintf */ - Perl_ck_fun, /* formline */ - Perl_ck_fun, /* ord */ - Perl_ck_fun, /* chr */ - Perl_ck_fun, /* crypt */ - Perl_ck_fun_locale,/* ucfirst */ - Perl_ck_fun_locale,/* lcfirst */ - Perl_ck_fun_locale,/* uc */ - Perl_ck_fun_locale,/* lc */ - Perl_ck_fun, /* quotemeta */ - Perl_ck_rvconst,/* rv2av */ - Perl_ck_null, /* aelemfast */ - Perl_ck_null, /* aelem */ - Perl_ck_null, /* aslice */ - Perl_ck_fun, /* each */ - Perl_ck_fun, /* values */ - Perl_ck_fun, /* keys */ - Perl_ck_delete, /* delete */ - Perl_ck_exists, /* exists */ - Perl_ck_rvconst,/* rv2hv */ - Perl_ck_null, /* helem */ - Perl_ck_null, /* hslice */ - Perl_ck_fun, /* unpack */ - Perl_ck_fun, /* pack */ - Perl_ck_split, /* split */ - Perl_ck_join, /* join */ - Perl_ck_null, /* list */ - Perl_ck_null, /* lslice */ - Perl_ck_fun, /* anonlist */ - Perl_ck_fun, /* anonhash */ - Perl_ck_fun, /* splice */ - Perl_ck_fun, /* push */ - Perl_ck_shift, /* pop */ - Perl_ck_shift, /* shift */ - Perl_ck_fun, /* unshift */ - Perl_ck_sort, /* sort */ - Perl_ck_fun, /* reverse */ - Perl_ck_grep, /* grepstart */ - Perl_ck_null, /* grepwhile */ - Perl_ck_grep, /* mapstart */ - Perl_ck_null, /* mapwhile */ - Perl_ck_null, /* range */ - Perl_ck_null, /* flip */ - Perl_ck_null, /* flop */ - Perl_ck_null, /* and */ - Perl_ck_null, /* or */ - Perl_ck_null, /* xor */ - Perl_ck_null, /* cond_expr */ - Perl_ck_null, /* andassign */ - Perl_ck_null, /* orassign */ - Perl_ck_method, /* method */ - Perl_ck_subr, /* entersub */ - Perl_ck_null, /* leavesub */ - Perl_ck_null, /* leavesublv */ - Perl_ck_fun, /* caller */ - Perl_ck_fun, /* warn */ - Perl_ck_fun, /* die */ - Perl_ck_fun, /* reset */ - Perl_ck_null, /* lineseq */ - Perl_ck_null, /* nextstate */ - Perl_ck_null, /* dbstate */ - Perl_ck_null, /* unstack */ - Perl_ck_null, /* enter */ - Perl_ck_null, /* leave */ - Perl_ck_null, /* scope */ - Perl_ck_null, /* enteriter */ - Perl_ck_null, /* iter */ - Perl_ck_null, /* enterloop */ - Perl_ck_null, /* leaveloop */ - Perl_ck_null, /* return */ - Perl_ck_null, /* last */ - Perl_ck_null, /* next */ - Perl_ck_null, /* redo */ - Perl_ck_null, /* dump */ - Perl_ck_null, /* goto */ - Perl_ck_fun, /* exit */ - Perl_ck_fun, /* open */ - Perl_ck_fun, /* close */ - Perl_ck_fun, /* pipe_op */ - Perl_ck_fun, /* fileno */ - Perl_ck_fun, /* umask */ - Perl_ck_fun, /* binmode */ - Perl_ck_fun, /* tie */ - Perl_ck_fun, /* untie */ - Perl_ck_fun, /* tied */ - Perl_ck_fun, /* dbmopen */ - Perl_ck_fun, /* dbmclose */ - Perl_ck_select, /* sselect */ - Perl_ck_select, /* select */ - Perl_ck_eof, /* getc */ - Perl_ck_fun, /* read */ - Perl_ck_fun, /* enterwrite */ - Perl_ck_null, /* leavewrite */ - Perl_ck_listiob,/* prtf */ - Perl_ck_listiob,/* print */ - Perl_ck_fun, /* sysopen */ - Perl_ck_fun, /* sysseek */ - Perl_ck_fun, /* sysread */ - Perl_ck_fun, /* syswrite */ - Perl_ck_fun, /* send */ - Perl_ck_fun, /* recv */ - Perl_ck_eof, /* eof */ - Perl_ck_fun, /* tell */ - Perl_ck_fun, /* seek */ - Perl_ck_trunc, /* truncate */ - Perl_ck_fun, /* fcntl */ - Perl_ck_fun, /* ioctl */ - Perl_ck_fun, /* flock */ - Perl_ck_fun, /* socket */ - Perl_ck_fun, /* sockpair */ - Perl_ck_fun, /* bind */ - Perl_ck_fun, /* connect */ - Perl_ck_fun, /* listen */ - Perl_ck_fun, /* accept */ - Perl_ck_fun, /* shutdown */ - Perl_ck_fun, /* gsockopt */ - Perl_ck_fun, /* ssockopt */ - Perl_ck_fun, /* getsockname */ - Perl_ck_fun, /* getpeername */ - Perl_ck_ftst, /* lstat */ - Perl_ck_ftst, /* stat */ - Perl_ck_ftst, /* ftrread */ - Perl_ck_ftst, /* ftrwrite */ - Perl_ck_ftst, /* ftrexec */ - Perl_ck_ftst, /* fteread */ - Perl_ck_ftst, /* ftewrite */ - Perl_ck_ftst, /* fteexec */ - Perl_ck_ftst, /* ftis */ - Perl_ck_ftst, /* fteowned */ - Perl_ck_ftst, /* ftrowned */ - Perl_ck_ftst, /* ftzero */ - Perl_ck_ftst, /* ftsize */ - Perl_ck_ftst, /* ftmtime */ - Perl_ck_ftst, /* ftatime */ - Perl_ck_ftst, /* ftctime */ - Perl_ck_ftst, /* ftsock */ - Perl_ck_ftst, /* ftchr */ - Perl_ck_ftst, /* ftblk */ - Perl_ck_ftst, /* ftfile */ - Perl_ck_ftst, /* ftdir */ - Perl_ck_ftst, /* ftpipe */ - Perl_ck_ftst, /* ftlink */ - Perl_ck_ftst, /* ftsuid */ - Perl_ck_ftst, /* ftsgid */ - Perl_ck_ftst, /* ftsvtx */ - Perl_ck_ftst, /* fttty */ - Perl_ck_ftst, /* fttext */ - Perl_ck_ftst, /* ftbinary */ - Perl_ck_fun, /* chdir */ - Perl_ck_fun, /* chown */ - Perl_ck_fun, /* chroot */ - Perl_ck_fun, /* unlink */ - Perl_ck_fun, /* chmod */ - Perl_ck_fun, /* utime */ - Perl_ck_fun, /* rename */ - Perl_ck_fun, /* link */ - Perl_ck_fun, /* symlink */ - Perl_ck_fun, /* readlink */ - Perl_ck_fun, /* mkdir */ - Perl_ck_fun, /* rmdir */ - Perl_ck_fun, /* open_dir */ - Perl_ck_fun, /* readdir */ - Perl_ck_fun, /* telldir */ - Perl_ck_fun, /* seekdir */ - Perl_ck_fun, /* rewinddir */ - Perl_ck_fun, /* closedir */ - Perl_ck_null, /* fork */ - Perl_ck_null, /* wait */ - Perl_ck_fun, /* waitpid */ - Perl_ck_exec, /* system */ - Perl_ck_exec, /* exec */ - Perl_ck_fun, /* kill */ - Perl_ck_null, /* getppid */ - Perl_ck_fun, /* getpgrp */ - Perl_ck_fun, /* setpgrp */ - Perl_ck_fun, /* getpriority */ - Perl_ck_fun, /* setpriority */ - Perl_ck_null, /* time */ - Perl_ck_null, /* tms */ - Perl_ck_fun, /* localtime */ - Perl_ck_fun, /* gmtime */ - Perl_ck_fun, /* alarm */ - Perl_ck_fun, /* sleep */ - Perl_ck_fun, /* shmget */ - Perl_ck_fun, /* shmctl */ - Perl_ck_fun, /* shmread */ - Perl_ck_fun, /* shmwrite */ - Perl_ck_fun, /* msgget */ - Perl_ck_fun, /* msgctl */ - Perl_ck_fun, /* msgsnd */ - Perl_ck_fun, /* msgrcv */ - Perl_ck_fun, /* semget */ - Perl_ck_fun, /* semctl */ - Perl_ck_fun, /* semop */ - Perl_ck_require,/* require */ - Perl_ck_fun, /* dofile */ - Perl_ck_eval, /* entereval */ - Perl_ck_null, /* leaveeval */ - Perl_ck_null, /* entertry */ - Perl_ck_null, /* leavetry */ - Perl_ck_fun, /* ghbyname */ - Perl_ck_fun, /* ghbyaddr */ - Perl_ck_null, /* ghostent */ - Perl_ck_fun, /* gnbyname */ - Perl_ck_fun, /* gnbyaddr */ - Perl_ck_null, /* gnetent */ - Perl_ck_fun, /* gpbyname */ - Perl_ck_fun, /* gpbynumber */ - Perl_ck_null, /* gprotoent */ - Perl_ck_fun, /* gsbyname */ - Perl_ck_fun, /* gsbyport */ - Perl_ck_null, /* gservent */ - Perl_ck_fun, /* shostent */ - Perl_ck_fun, /* snetent */ - Perl_ck_fun, /* sprotoent */ - Perl_ck_fun, /* sservent */ - Perl_ck_null, /* ehostent */ - Perl_ck_null, /* enetent */ - Perl_ck_null, /* eprotoent */ - Perl_ck_null, /* eservent */ - Perl_ck_fun, /* gpwnam */ - Perl_ck_fun, /* gpwuid */ - Perl_ck_null, /* gpwent */ - Perl_ck_null, /* spwent */ - Perl_ck_null, /* epwent */ - Perl_ck_fun, /* ggrnam */ - Perl_ck_fun, /* ggrgid */ - Perl_ck_null, /* ggrent */ - Perl_ck_null, /* sgrent */ - Perl_ck_null, /* egrent */ - Perl_ck_null, /* getlogin */ - Perl_ck_fun, /* syscall */ - Perl_ck_rfun, /* lock */ - Perl_ck_null, /* threadsv */ - Perl_ck_null, /* setstate */ - Perl_ck_null, /* method_named */ + MEMBER_TO_FPTR(Perl_ck_null), /* null */ + MEMBER_TO_FPTR(Perl_ck_null), /* stub */ + MEMBER_TO_FPTR(Perl_ck_fun), /* scalar */ + MEMBER_TO_FPTR(Perl_ck_null), /* pushmark */ + MEMBER_TO_FPTR(Perl_ck_null), /* wantarray */ + MEMBER_TO_FPTR(Perl_ck_svconst), /* const */ + MEMBER_TO_FPTR(Perl_ck_null), /* gvsv */ + MEMBER_TO_FPTR(Perl_ck_null), /* gv */ + MEMBER_TO_FPTR(Perl_ck_null), /* gelem */ + MEMBER_TO_FPTR(Perl_ck_null), /* padsv */ + MEMBER_TO_FPTR(Perl_ck_null), /* padav */ + MEMBER_TO_FPTR(Perl_ck_null), /* padhv */ + MEMBER_TO_FPTR(Perl_ck_null), /* padany */ + MEMBER_TO_FPTR(Perl_ck_null), /* pushre */ + MEMBER_TO_FPTR(Perl_ck_rvconst), /* rv2gv */ + MEMBER_TO_FPTR(Perl_ck_rvconst), /* rv2sv */ + MEMBER_TO_FPTR(Perl_ck_null), /* av2arylen */ + MEMBER_TO_FPTR(Perl_ck_rvconst), /* rv2cv */ + MEMBER_TO_FPTR(Perl_ck_anoncode), /* anoncode */ + MEMBER_TO_FPTR(Perl_ck_null), /* prototype */ + MEMBER_TO_FPTR(Perl_ck_spair), /* refgen */ + MEMBER_TO_FPTR(Perl_ck_null), /* srefgen */ + MEMBER_TO_FPTR(Perl_ck_fun), /* ref */ + MEMBER_TO_FPTR(Perl_ck_fun), /* bless */ + MEMBER_TO_FPTR(Perl_ck_null), /* backtick */ + MEMBER_TO_FPTR(Perl_ck_glob), /* glob */ + MEMBER_TO_FPTR(Perl_ck_null), /* readline */ + MEMBER_TO_FPTR(Perl_ck_null), /* rcatline */ + MEMBER_TO_FPTR(Perl_ck_fun), /* regcmaybe */ + MEMBER_TO_FPTR(Perl_ck_fun), /* regcreset */ + MEMBER_TO_FPTR(Perl_ck_null), /* regcomp */ + MEMBER_TO_FPTR(Perl_ck_match), /* match */ + MEMBER_TO_FPTR(Perl_ck_match), /* qr */ + MEMBER_TO_FPTR(Perl_ck_null), /* subst */ + MEMBER_TO_FPTR(Perl_ck_null), /* substcont */ + MEMBER_TO_FPTR(Perl_ck_null), /* trans */ + MEMBER_TO_FPTR(Perl_ck_sassign), /* sassign */ + MEMBER_TO_FPTR(Perl_ck_null), /* aassign */ + MEMBER_TO_FPTR(Perl_ck_spair), /* chop */ + MEMBER_TO_FPTR(Perl_ck_null), /* schop */ + MEMBER_TO_FPTR(Perl_ck_spair), /* chomp */ + MEMBER_TO_FPTR(Perl_ck_null), /* schomp */ + MEMBER_TO_FPTR(Perl_ck_defined), /* defined */ + MEMBER_TO_FPTR(Perl_ck_lfun), /* undef */ + MEMBER_TO_FPTR(Perl_ck_fun), /* study */ + MEMBER_TO_FPTR(Perl_ck_lfun), /* pos */ + MEMBER_TO_FPTR(Perl_ck_lfun), /* preinc */ + MEMBER_TO_FPTR(Perl_ck_lfun), /* i_preinc */ + MEMBER_TO_FPTR(Perl_ck_lfun), /* predec */ + MEMBER_TO_FPTR(Perl_ck_lfun), /* i_predec */ + MEMBER_TO_FPTR(Perl_ck_lfun), /* postinc */ + MEMBER_TO_FPTR(Perl_ck_lfun), /* i_postinc */ + MEMBER_TO_FPTR(Perl_ck_lfun), /* postdec */ + MEMBER_TO_FPTR(Perl_ck_lfun), /* i_postdec */ + MEMBER_TO_FPTR(Perl_ck_null), /* pow */ + MEMBER_TO_FPTR(Perl_ck_null), /* multiply */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_multiply */ + MEMBER_TO_FPTR(Perl_ck_null), /* divide */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_divide */ + MEMBER_TO_FPTR(Perl_ck_null), /* modulo */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_modulo */ + MEMBER_TO_FPTR(Perl_ck_repeat), /* repeat */ + MEMBER_TO_FPTR(Perl_ck_null), /* add */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_add */ + MEMBER_TO_FPTR(Perl_ck_null), /* subtract */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_subtract */ + MEMBER_TO_FPTR(Perl_ck_concat), /* concat */ + MEMBER_TO_FPTR(Perl_ck_fun), /* stringify */ + MEMBER_TO_FPTR(Perl_ck_bitop), /* left_shift */ + MEMBER_TO_FPTR(Perl_ck_bitop), /* right_shift */ + MEMBER_TO_FPTR(Perl_ck_null), /* lt */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_lt */ + MEMBER_TO_FPTR(Perl_ck_null), /* gt */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_gt */ + MEMBER_TO_FPTR(Perl_ck_null), /* le */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_le */ + MEMBER_TO_FPTR(Perl_ck_null), /* ge */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_ge */ + MEMBER_TO_FPTR(Perl_ck_null), /* eq */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_eq */ + MEMBER_TO_FPTR(Perl_ck_null), /* ne */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_ne */ + MEMBER_TO_FPTR(Perl_ck_null), /* ncmp */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_ncmp */ + MEMBER_TO_FPTR(Perl_ck_scmp), /* slt */ + MEMBER_TO_FPTR(Perl_ck_scmp), /* sgt */ + MEMBER_TO_FPTR(Perl_ck_scmp), /* sle */ + MEMBER_TO_FPTR(Perl_ck_scmp), /* sge */ + MEMBER_TO_FPTR(Perl_ck_null), /* seq */ + MEMBER_TO_FPTR(Perl_ck_null), /* sne */ + MEMBER_TO_FPTR(Perl_ck_scmp), /* scmp */ + MEMBER_TO_FPTR(Perl_ck_bitop), /* bit_and */ + MEMBER_TO_FPTR(Perl_ck_bitop), /* bit_xor */ + MEMBER_TO_FPTR(Perl_ck_bitop), /* bit_or */ + MEMBER_TO_FPTR(Perl_ck_null), /* negate */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_negate */ + MEMBER_TO_FPTR(Perl_ck_null), /* not */ + MEMBER_TO_FPTR(Perl_ck_bitop), /* complement */ + MEMBER_TO_FPTR(Perl_ck_fun), /* atan2 */ + MEMBER_TO_FPTR(Perl_ck_fun), /* sin */ + MEMBER_TO_FPTR(Perl_ck_fun), /* cos */ + MEMBER_TO_FPTR(Perl_ck_fun), /* rand */ + MEMBER_TO_FPTR(Perl_ck_fun), /* srand */ + MEMBER_TO_FPTR(Perl_ck_fun), /* exp */ + MEMBER_TO_FPTR(Perl_ck_fun), /* log */ + MEMBER_TO_FPTR(Perl_ck_fun), /* sqrt */ + MEMBER_TO_FPTR(Perl_ck_fun), /* int */ + MEMBER_TO_FPTR(Perl_ck_fun), /* hex */ + MEMBER_TO_FPTR(Perl_ck_fun), /* oct */ + MEMBER_TO_FPTR(Perl_ck_fun), /* abs */ + MEMBER_TO_FPTR(Perl_ck_lengthconst), /* length */ + MEMBER_TO_FPTR(Perl_ck_fun), /* substr */ + MEMBER_TO_FPTR(Perl_ck_fun), /* vec */ + MEMBER_TO_FPTR(Perl_ck_index), /* index */ + MEMBER_TO_FPTR(Perl_ck_index), /* rindex */ + MEMBER_TO_FPTR(Perl_ck_fun_locale), /* sprintf */ + MEMBER_TO_FPTR(Perl_ck_fun), /* formline */ + MEMBER_TO_FPTR(Perl_ck_fun), /* ord */ + MEMBER_TO_FPTR(Perl_ck_fun), /* chr */ + MEMBER_TO_FPTR(Perl_ck_fun), /* crypt */ + MEMBER_TO_FPTR(Perl_ck_fun_locale), /* ucfirst */ + MEMBER_TO_FPTR(Perl_ck_fun_locale), /* lcfirst */ + MEMBER_TO_FPTR(Perl_ck_fun_locale), /* uc */ + MEMBER_TO_FPTR(Perl_ck_fun_locale), /* lc */ + MEMBER_TO_FPTR(Perl_ck_fun), /* quotemeta */ + MEMBER_TO_FPTR(Perl_ck_rvconst), /* rv2av */ + MEMBER_TO_FPTR(Perl_ck_null), /* aelemfast */ + MEMBER_TO_FPTR(Perl_ck_null), /* aelem */ + MEMBER_TO_FPTR(Perl_ck_null), /* aslice */ + MEMBER_TO_FPTR(Perl_ck_fun), /* each */ + MEMBER_TO_FPTR(Perl_ck_fun), /* values */ + MEMBER_TO_FPTR(Perl_ck_fun), /* keys */ + MEMBER_TO_FPTR(Perl_ck_delete), /* delete */ + MEMBER_TO_FPTR(Perl_ck_exists), /* exists */ + MEMBER_TO_FPTR(Perl_ck_rvconst), /* rv2hv */ + MEMBER_TO_FPTR(Perl_ck_null), /* helem */ + MEMBER_TO_FPTR(Perl_ck_null), /* hslice */ + MEMBER_TO_FPTR(Perl_ck_fun), /* unpack */ + MEMBER_TO_FPTR(Perl_ck_fun), /* pack */ + MEMBER_TO_FPTR(Perl_ck_split), /* split */ + MEMBER_TO_FPTR(Perl_ck_join), /* join */ + MEMBER_TO_FPTR(Perl_ck_null), /* list */ + MEMBER_TO_FPTR(Perl_ck_null), /* lslice */ + MEMBER_TO_FPTR(Perl_ck_fun), /* anonlist */ + MEMBER_TO_FPTR(Perl_ck_fun), /* anonhash */ + MEMBER_TO_FPTR(Perl_ck_fun), /* splice */ + MEMBER_TO_FPTR(Perl_ck_fun), /* push */ + MEMBER_TO_FPTR(Perl_ck_shift), /* pop */ + MEMBER_TO_FPTR(Perl_ck_shift), /* shift */ + MEMBER_TO_FPTR(Perl_ck_fun), /* unshift */ + MEMBER_TO_FPTR(Perl_ck_sort), /* sort */ + MEMBER_TO_FPTR(Perl_ck_fun), /* reverse */ + MEMBER_TO_FPTR(Perl_ck_grep), /* grepstart */ + MEMBER_TO_FPTR(Perl_ck_null), /* grepwhile */ + MEMBER_TO_FPTR(Perl_ck_grep), /* mapstart */ + MEMBER_TO_FPTR(Perl_ck_null), /* mapwhile */ + MEMBER_TO_FPTR(Perl_ck_null), /* range */ + MEMBER_TO_FPTR(Perl_ck_null), /* flip */ + MEMBER_TO_FPTR(Perl_ck_null), /* flop */ + MEMBER_TO_FPTR(Perl_ck_null), /* and */ + MEMBER_TO_FPTR(Perl_ck_null), /* or */ + MEMBER_TO_FPTR(Perl_ck_null), /* xor */ + MEMBER_TO_FPTR(Perl_ck_null), /* cond_expr */ + MEMBER_TO_FPTR(Perl_ck_null), /* andassign */ + MEMBER_TO_FPTR(Perl_ck_null), /* orassign */ + MEMBER_TO_FPTR(Perl_ck_method), /* method */ + MEMBER_TO_FPTR(Perl_ck_subr), /* entersub */ + MEMBER_TO_FPTR(Perl_ck_null), /* leavesub */ + MEMBER_TO_FPTR(Perl_ck_null), /* leavesublv */ + MEMBER_TO_FPTR(Perl_ck_fun), /* caller */ + MEMBER_TO_FPTR(Perl_ck_fun), /* warn */ + MEMBER_TO_FPTR(Perl_ck_fun), /* die */ + MEMBER_TO_FPTR(Perl_ck_fun), /* reset */ + MEMBER_TO_FPTR(Perl_ck_null), /* lineseq */ + MEMBER_TO_FPTR(Perl_ck_null), /* nextstate */ + MEMBER_TO_FPTR(Perl_ck_null), /* dbstate */ + MEMBER_TO_FPTR(Perl_ck_null), /* unstack */ + MEMBER_TO_FPTR(Perl_ck_null), /* enter */ + MEMBER_TO_FPTR(Perl_ck_null), /* leave */ + MEMBER_TO_FPTR(Perl_ck_null), /* scope */ + MEMBER_TO_FPTR(Perl_ck_null), /* enteriter */ + MEMBER_TO_FPTR(Perl_ck_null), /* iter */ + MEMBER_TO_FPTR(Perl_ck_null), /* enterloop */ + MEMBER_TO_FPTR(Perl_ck_null), /* leaveloop */ + MEMBER_TO_FPTR(Perl_ck_null), /* return */ + MEMBER_TO_FPTR(Perl_ck_null), /* last */ + MEMBER_TO_FPTR(Perl_ck_null), /* next */ + MEMBER_TO_FPTR(Perl_ck_null), /* redo */ + MEMBER_TO_FPTR(Perl_ck_null), /* dump */ + MEMBER_TO_FPTR(Perl_ck_null), /* goto */ + MEMBER_TO_FPTR(Perl_ck_fun), /* exit */ + MEMBER_TO_FPTR(Perl_ck_fun), /* open */ + MEMBER_TO_FPTR(Perl_ck_fun), /* close */ + MEMBER_TO_FPTR(Perl_ck_fun), /* pipe_op */ + MEMBER_TO_FPTR(Perl_ck_fun), /* fileno */ + MEMBER_TO_FPTR(Perl_ck_fun), /* umask */ + MEMBER_TO_FPTR(Perl_ck_fun), /* binmode */ + MEMBER_TO_FPTR(Perl_ck_fun), /* tie */ + MEMBER_TO_FPTR(Perl_ck_fun), /* untie */ + MEMBER_TO_FPTR(Perl_ck_fun), /* tied */ + MEMBER_TO_FPTR(Perl_ck_fun), /* dbmopen */ + MEMBER_TO_FPTR(Perl_ck_fun), /* dbmclose */ + MEMBER_TO_FPTR(Perl_ck_select), /* sselect */ + MEMBER_TO_FPTR(Perl_ck_select), /* select */ + MEMBER_TO_FPTR(Perl_ck_eof), /* getc */ + MEMBER_TO_FPTR(Perl_ck_fun), /* read */ + MEMBER_TO_FPTR(Perl_ck_fun), /* enterwrite */ + MEMBER_TO_FPTR(Perl_ck_null), /* leavewrite */ + MEMBER_TO_FPTR(Perl_ck_listiob), /* prtf */ + MEMBER_TO_FPTR(Perl_ck_listiob), /* print */ + MEMBER_TO_FPTR(Perl_ck_fun), /* sysopen */ + MEMBER_TO_FPTR(Perl_ck_fun), /* sysseek */ + MEMBER_TO_FPTR(Perl_ck_fun), /* sysread */ + MEMBER_TO_FPTR(Perl_ck_fun), /* syswrite */ + MEMBER_TO_FPTR(Perl_ck_fun), /* send */ + MEMBER_TO_FPTR(Perl_ck_fun), /* recv */ + MEMBER_TO_FPTR(Perl_ck_eof), /* eof */ + MEMBER_TO_FPTR(Perl_ck_fun), /* tell */ + MEMBER_TO_FPTR(Perl_ck_fun), /* seek */ + MEMBER_TO_FPTR(Perl_ck_trunc), /* truncate */ + MEMBER_TO_FPTR(Perl_ck_fun), /* fcntl */ + MEMBER_TO_FPTR(Perl_ck_fun), /* ioctl */ + MEMBER_TO_FPTR(Perl_ck_fun), /* flock */ + MEMBER_TO_FPTR(Perl_ck_fun), /* socket */ + MEMBER_TO_FPTR(Perl_ck_fun), /* sockpair */ + MEMBER_TO_FPTR(Perl_ck_fun), /* bind */ + MEMBER_TO_FPTR(Perl_ck_fun), /* connect */ + MEMBER_TO_FPTR(Perl_ck_fun), /* listen */ + MEMBER_TO_FPTR(Perl_ck_fun), /* accept */ + MEMBER_TO_FPTR(Perl_ck_fun), /* shutdown */ + MEMBER_TO_FPTR(Perl_ck_fun), /* gsockopt */ + MEMBER_TO_FPTR(Perl_ck_fun), /* ssockopt */ + MEMBER_TO_FPTR(Perl_ck_fun), /* getsockname */ + MEMBER_TO_FPTR(Perl_ck_fun), /* getpeername */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* lstat */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* stat */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftrread */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftrwrite */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftrexec */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* fteread */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftewrite */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* fteexec */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftis */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* fteowned */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftrowned */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftzero */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftsize */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftmtime */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftatime */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftctime */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftsock */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftchr */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftblk */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftfile */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftdir */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftpipe */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftlink */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftsuid */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftsgid */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftsvtx */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* fttty */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* fttext */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftbinary */ + MEMBER_TO_FPTR(Perl_ck_fun), /* chdir */ + MEMBER_TO_FPTR(Perl_ck_fun), /* chown */ + MEMBER_TO_FPTR(Perl_ck_fun), /* chroot */ + MEMBER_TO_FPTR(Perl_ck_fun), /* unlink */ + MEMBER_TO_FPTR(Perl_ck_fun), /* chmod */ + MEMBER_TO_FPTR(Perl_ck_fun), /* utime */ + MEMBER_TO_FPTR(Perl_ck_fun), /* rename */ + MEMBER_TO_FPTR(Perl_ck_fun), /* link */ + MEMBER_TO_FPTR(Perl_ck_fun), /* symlink */ + MEMBER_TO_FPTR(Perl_ck_fun), /* readlink */ + MEMBER_TO_FPTR(Perl_ck_fun), /* mkdir */ + MEMBER_TO_FPTR(Perl_ck_fun), /* rmdir */ + MEMBER_TO_FPTR(Perl_ck_fun), /* open_dir */ + MEMBER_TO_FPTR(Perl_ck_fun), /* readdir */ + MEMBER_TO_FPTR(Perl_ck_fun), /* telldir */ + MEMBER_TO_FPTR(Perl_ck_fun), /* seekdir */ + MEMBER_TO_FPTR(Perl_ck_fun), /* rewinddir */ + MEMBER_TO_FPTR(Perl_ck_fun), /* closedir */ + MEMBER_TO_FPTR(Perl_ck_null), /* fork */ + MEMBER_TO_FPTR(Perl_ck_null), /* wait */ + MEMBER_TO_FPTR(Perl_ck_fun), /* waitpid */ + MEMBER_TO_FPTR(Perl_ck_exec), /* system */ + MEMBER_TO_FPTR(Perl_ck_exec), /* exec */ + MEMBER_TO_FPTR(Perl_ck_fun), /* kill */ + MEMBER_TO_FPTR(Perl_ck_null), /* getppid */ + MEMBER_TO_FPTR(Perl_ck_fun), /* getpgrp */ + MEMBER_TO_FPTR(Perl_ck_fun), /* setpgrp */ + MEMBER_TO_FPTR(Perl_ck_fun), /* getpriority */ + MEMBER_TO_FPTR(Perl_ck_fun), /* setpriority */ + MEMBER_TO_FPTR(Perl_ck_null), /* time */ + MEMBER_TO_FPTR(Perl_ck_null), /* tms */ + MEMBER_TO_FPTR(Perl_ck_fun), /* localtime */ + MEMBER_TO_FPTR(Perl_ck_fun), /* gmtime */ + MEMBER_TO_FPTR(Perl_ck_fun), /* alarm */ + MEMBER_TO_FPTR(Perl_ck_fun), /* sleep */ + MEMBER_TO_FPTR(Perl_ck_fun), /* shmget */ + MEMBER_TO_FPTR(Perl_ck_fun), /* shmctl */ + MEMBER_TO_FPTR(Perl_ck_fun), /* shmread */ + MEMBER_TO_FPTR(Perl_ck_fun), /* shmwrite */ + MEMBER_TO_FPTR(Perl_ck_fun), /* msgget */ + MEMBER_TO_FPTR(Perl_ck_fun), /* msgctl */ + MEMBER_TO_FPTR(Perl_ck_fun), /* msgsnd */ + MEMBER_TO_FPTR(Perl_ck_fun), /* msgrcv */ + MEMBER_TO_FPTR(Perl_ck_fun), /* semget */ + MEMBER_TO_FPTR(Perl_ck_fun), /* semctl */ + MEMBER_TO_FPTR(Perl_ck_fun), /* semop */ + MEMBER_TO_FPTR(Perl_ck_require), /* require */ + MEMBER_TO_FPTR(Perl_ck_fun), /* dofile */ + MEMBER_TO_FPTR(Perl_ck_eval), /* entereval */ + MEMBER_TO_FPTR(Perl_ck_null), /* leaveeval */ + MEMBER_TO_FPTR(Perl_ck_null), /* entertry */ + MEMBER_TO_FPTR(Perl_ck_null), /* leavetry */ + MEMBER_TO_FPTR(Perl_ck_fun), /* ghbyname */ + MEMBER_TO_FPTR(Perl_ck_fun), /* ghbyaddr */ + MEMBER_TO_FPTR(Perl_ck_null), /* ghostent */ + MEMBER_TO_FPTR(Perl_ck_fun), /* gnbyname */ + MEMBER_TO_FPTR(Perl_ck_fun), /* gnbyaddr */ + MEMBER_TO_FPTR(Perl_ck_null), /* gnetent */ + MEMBER_TO_FPTR(Perl_ck_fun), /* gpbyname */ + MEMBER_TO_FPTR(Perl_ck_fun), /* gpbynumber */ + MEMBER_TO_FPTR(Perl_ck_null), /* gprotoent */ + MEMBER_TO_FPTR(Perl_ck_fun), /* gsbyname */ + MEMBER_TO_FPTR(Perl_ck_fun), /* gsbyport */ + MEMBER_TO_FPTR(Perl_ck_null), /* gservent */ + MEMBER_TO_FPTR(Perl_ck_fun), /* shostent */ + MEMBER_TO_FPTR(Perl_ck_fun), /* snetent */ + MEMBER_TO_FPTR(Perl_ck_fun), /* sprotoent */ + MEMBER_TO_FPTR(Perl_ck_fun), /* sservent */ + MEMBER_TO_FPTR(Perl_ck_null), /* ehostent */ + MEMBER_TO_FPTR(Perl_ck_null), /* enetent */ + MEMBER_TO_FPTR(Perl_ck_null), /* eprotoent */ + MEMBER_TO_FPTR(Perl_ck_null), /* eservent */ + MEMBER_TO_FPTR(Perl_ck_fun), /* gpwnam */ + MEMBER_TO_FPTR(Perl_ck_fun), /* gpwuid */ + MEMBER_TO_FPTR(Perl_ck_null), /* gpwent */ + MEMBER_TO_FPTR(Perl_ck_null), /* spwent */ + MEMBER_TO_FPTR(Perl_ck_null), /* epwent */ + MEMBER_TO_FPTR(Perl_ck_fun), /* ggrnam */ + MEMBER_TO_FPTR(Perl_ck_fun), /* ggrgid */ + MEMBER_TO_FPTR(Perl_ck_null), /* ggrent */ + MEMBER_TO_FPTR(Perl_ck_null), /* sgrent */ + MEMBER_TO_FPTR(Perl_ck_null), /* egrent */ + MEMBER_TO_FPTR(Perl_ck_null), /* getlogin */ + MEMBER_TO_FPTR(Perl_ck_fun), /* syscall */ + MEMBER_TO_FPTR(Perl_ck_rfun), /* lock */ + MEMBER_TO_FPTR(Perl_ck_null), /* threadsv */ + MEMBER_TO_FPTR(Perl_ck_null), /* setstate */ + MEMBER_TO_FPTR(Perl_ck_null), /* method_named */ }; #endif @@ -129,7 +129,7 @@ EXT OP * (CPERLscope(*PL_ppaddr)[])(pTHX) = { END for (@ops) { - print "\tPerl_pp_$_,\n"; + print "\tMEMBER_TO_FPTR(Perl_pp_$_),\n"; } print <<END; @@ -148,7 +148,7 @@ EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = { END for (@ops) { - print "\t", &tab(3, "Perl_$check{$_},"), "/* $_ */\n"; + print "\t", &tab(3, "MEMBER_TO_FPTR(Perl_$check{$_}),"), "\t/* $_ */\n"; } print <<END; diff --git a/os2/Changes b/os2/Changes index 910ec467f4..e56b7081ff 100644 --- a/os2/Changes +++ b/os2/Changes @@ -296,3 +296,29 @@ after 5.005_54: If the only shell-metachars of a command are ' 2>&1' at the end of a command, it is executed without calling the external shell. + +after 5.005_57: + Make UDP sockets return correct caller address (OS2 API bug); + Enable TCPIPV4 defines (works with Warp 3 IAK too?!); + Force Unix-domain sockets to start with "/socket", convert + '/' to '\' in the calls; + Make C<system 1, $cmd> to treat $cmd as in C<system $cmd>; + Autopatch Configure; + Find name and location of g[nu]patch.exe; + Autocopy perl????.dll to t/ when testing; + +after 5.005_62: + Extract a lightweight DLL access module OS2::DLL from OS2::REXX + which would not load REXX runtime system; + Allow compile with os2.h which loads os2tk.h instead of os2emx.h; + Put the version of EMX CRTL into -D define; + Use _setsyserror() to store last error of OS/2 API for $^E; + New macro PERL_SYS_INIT3(argvp, argcp, envp); + Make Dynaloader return info on the failing module after failed dl_open(); + OS2::REXX test were done for interactive testing (were writing + "ok" to stderr); + system() and friends return -1 on failure (was 0xFF00); + Put the full name of executable into $^X + (alas, uppercased - but with /); + t/io/fs.t was failing on HPFS386; + Remove extra ';' from defines for MQ operations. diff --git a/os2/OS2/REXX/Changes b/os2/OS2/REXX/Changes index 46b38ef46c..7c19710db6 100644 --- a/os2/OS2/REXX/Changes +++ b/os2/OS2/REXX/Changes @@ -2,3 +2,6 @@ After fixpak17 a lot of other places have mismatched lengths returned in the REXXPool interface. Also drop does not work on stems any more. +0.22: + A subsystem module OS2::DLL extracted which does not link + with REXX runtime library. diff --git a/os2/OS2/REXX/DLL/Changes b/os2/OS2/REXX/DLL/Changes new file mode 100644 index 0000000000..874f7fab4a --- /dev/null +++ b/os2/OS2/REXX/DLL/Changes @@ -0,0 +1,2 @@ +0.01: + Split out of OS2::REXX diff --git a/os2/OS2/REXX/DLL/DLL.pm b/os2/OS2/REXX/DLL/DLL.pm new file mode 100644 index 0000000000..7e54371973 --- /dev/null +++ b/os2/OS2/REXX/DLL/DLL.pm @@ -0,0 +1,136 @@ +package OS2::DLL; + +use Carp; +use DynaLoader; + +@ISA = qw(DynaLoader); + +sub AUTOLOAD { + $AUTOLOAD =~ /^OS2::DLL::.+::(.+)$/ + or confess("Undefined subroutine &$AUTOLOAD called"); + return undef if $1 eq "DESTROY"; + $_[0]->find($1) + or confess("Can't find entry '$1' to DLL '$_[0]->{File}': $^E"); + goto &$AUTOLOAD; +} + +@libs = split(/;/, $ENV{'PERL5REXX'} || $ENV{'PERLREXX'} || $ENV{'LIBPATH'} || $ENV{'PATH'}); +%dlls = (); + +# Preloaded methods go here. Autoload methods go after __END__, and are +# processed by the autosplit program. + +# Cannot autoload, the autoloader is used for the REXX functions. + +sub load +{ + confess 'Usage: load OS2::DLL <file> [<dirs>]' unless $#_ >= 1; + my ($class, $file, @where) = (@_, @libs); + return $dlls{$file} if $dlls{$file}; + my $handle; + foreach (@where) { + $handle = DynaLoader::dl_load_file("$_/$file.dll"); + last if $handle; + } + $handle = DynaLoader::dl_load_file($file) unless $handle; + return undef unless $handle; + my $packs = $INC{'OS2/REXX.pm'} ? 'OS2::DLL OS2::REXX' : 'OS2::DLL'; + eval <<EOE or die "eval package $@"; +package OS2::DLL::$file; \@ISA = qw($packs); +sub AUTOLOAD { + \$OS2::DLL::AUTOLOAD = \$AUTOLOAD; + goto &OS2::DLL::AUTOLOAD; +} +1; +EOE + return $dlls{$file} = + bless {Handle => $handle, File => $file, Queue => 'SESSION' }, + "OS2::DLL::$file"; +} + +sub find +{ + my $self = shift; + my $file = $self->{File}; + my $handle = $self->{Handle}; + my $prefix = exists($self->{Prefix}) ? $self->{Prefix} : ""; + my $queue = $self->{Queue}; + foreach (@_) { + my $name = "OS2::DLL::${file}::$_"; + next if defined(&$name); + my $addr = DynaLoader::dl_find_symbol($handle, uc $prefix.$_) + || DynaLoader::dl_find_symbol($handle, $prefix.$_) + or return 0; + eval <<EOE or die "eval sub"; +package OS2::DLL::$file; +sub $_ { + shift; + OS2::DLL::_call('$_', $addr, '$queue', \@_); +} +1; +EOE + } + return 1; +} + +bootstrap OS2::DLL; + +1; +__END__ + +=head1 NAME + +OS2::DLL - access to DLLs with REXX calling convention. + +=head2 NOTE + +When you use this module, the REXX variable pool is not available. + +See documentation of L<OS2::REXX> module if you need the variable pool. + +=head1 SYNOPSIS + + use OS2::DLL; + $emx_dll = OS2::DLL->load('emx'); + $emx_version = $emx_dll->emx_revision(); + +=head1 DESCRIPTION + +=head2 Load REXX DLL + + $dll = load OS2::DLL NAME [, WHERE]; + +NAME is DLL name, without path and extension. + +Directories are searched WHERE first (list of dirs), then environment +paths PERL5REXX, PERLREXX, PATH or, as last resort, OS/2-ish search +is performed in default DLL path (without adding paths and extensions). + +The DLL is not unloaded when the variable dies. + +Returns DLL object reference, or undef on failure. + +=head2 Check for functions (optional): + + BOOL = $dll->find(NAME [, NAME [, ...]]); + +Returns true if all functions are available. + +=head2 Call external REXX function: + + $dll->function(arguments); + +Returns the return string if the return code is 0, else undef. +Dies with error message if the function is not available. + +=head1 ENVIRONMENT + +If C<PERL_REXX_DEBUG> is set, emits debugging output. Looks for DLLs +in C<PERL5REXX>, C<PERLREXX>, C<PATH>. + +=head1 AUTHOR + +Extracted by Ilya Zakharevich ilya@math.ohio-state.edu from L<OS2::REXX> +written by Andreas Kaiser ak@ananke.s.bawue.de. + +=cut diff --git a/os2/OS2/REXX/DLL/DLL.xs b/os2/OS2/REXX/DLL/DLL.xs new file mode 100644 index 0000000000..c8e7c58007 --- /dev/null +++ b/os2/OS2/REXX/DLL/DLL.xs @@ -0,0 +1,72 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define INCL_BASE +#define INCL_REXXSAA +#include <os2emx.h> + +static RXSTRING * strs; +static int nstrs; +static char * trace; + +static void +needstrs(int n) +{ + if (n > nstrs) { + if (strs) + free(strs); + nstrs = 2 * n; + strs = malloc(nstrs * sizeof(RXSTRING)); + } +} + +MODULE = OS2::DLL PACKAGE = OS2::DLL + +BOOT: + needstrs(8); + trace = getenv("PERL_REXX_DEBUG"); + +SV * +_call(name, address, queue="SESSION", ...) + char * name + void * address + char * queue + CODE: + { + ULONG rc; + int argc, i; + RXSTRING result; + UCHAR resbuf[256]; + RexxFunctionHandler *fcn = address; + argc = items-3; + needstrs(argc); + if (trace) + fprintf(stderr, "REXXCALL::_call name: '%s' args:", name); + for (i = 0; i < argc; ++i) { + STRLEN len; + char *ptr = SvPV(ST(3+i), len); + MAKERXSTRING(strs[i], ptr, len); + if (trace) + fprintf(stderr, " '%.*s'", len, ptr); + } + if (!*queue) + queue = "SESSION"; + if (trace) + fprintf(stderr, "\n"); + MAKERXSTRING(result, resbuf, sizeof resbuf); + rc = fcn(name, argc, strs, queue, &result); + if (trace) + fprintf(stderr, " rc=%X, result='%.*s'\n", rc, + result.strlength, result.strptr); + ST(0) = sv_newmortal(); + if (rc == 0) { + if (result.strptr) + sv_setpvn(ST(0), result.strptr, result.strlength); + else + sv_setpvn(ST(0), "", 0); + } + if (result.strptr && result.strptr != resbuf) + DosFreeMem(result.strptr); + } + diff --git a/os2/OS2/REXX/DLL/MANIFEST b/os2/OS2/REXX/DLL/MANIFEST new file mode 100644 index 0000000000..d7ad9b6338 --- /dev/null +++ b/os2/OS2/REXX/DLL/MANIFEST @@ -0,0 +1,5 @@ +Changes +MANIFEST +Makefile.PL +DLL.pm +DLL.xs diff --git a/os2/OS2/REXX/DLL/Makefile.PL b/os2/OS2/REXX/DLL/Makefile.PL new file mode 100644 index 0000000000..fe2403d0c2 --- /dev/null +++ b/os2/OS2/REXX/DLL/Makefile.PL @@ -0,0 +1,9 @@ +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'OS2::DLL', + VERSION => '0.01', + MAN3PODS => ' ', # Pods will be built by installman. + XSPROTOARG => '-noprototypes', + PERL_MALLOC_OK => 1, +); diff --git a/os2/OS2/REXX/Makefile.PL b/os2/OS2/REXX/Makefile.PL index 5eda5a35d1..6648b2c575 100644 --- a/os2/OS2/REXX/Makefile.PL +++ b/os2/OS2/REXX/Makefile.PL @@ -2,7 +2,7 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'OS2::REXX', - VERSION => '0.21', + VERSION => '0.22', MAN3PODS => ' ', # Pods will be built by installman. XSPROTOARG => '-noprototypes', PERL_MALLOC_OK => 1, diff --git a/os2/OS2/REXX/REXX.pm b/os2/OS2/REXX/REXX.pm index 4580ede294..5c6dfd226f 100644 --- a/os2/OS2/REXX/REXX.pm +++ b/os2/OS2/REXX/REXX.pm @@ -3,6 +3,8 @@ package OS2::REXX; use Carp; require Exporter; require DynaLoader; +require OS2::DLL; + @ISA = qw(Exporter DynaLoader); # Items to export into callers namespace by default # (move infrequently used names to @EXPORT_OK below) @@ -10,66 +12,18 @@ require DynaLoader; # Other items we are prepared to export if requested @EXPORT_OK = qw(drop); -sub AUTOLOAD { - $AUTOLOAD =~ /^OS2::REXX::.+::(.+)$/ - or confess("Undefined subroutine &$AUTOLOAD called"); - return undef if $1 eq "DESTROY"; - $_[0]->find($1) - or confess("Can't find entry '$1' to DLL '$_[0]->{File}'"); - goto &$AUTOLOAD; -} +# We cannot just put OS2::DLL in @ISA, since some scripts would use +# function interface, not method interface... -@libs = split(/;/, $ENV{'PERL5REXX'} || $ENV{'PERLREXX'} || $ENV{'LIBPATH'} || $ENV{'PATH'}); -%dlls = (); +*_call = \&OS2::DLL::_call; +*load = \&OS2::DLL::load; +*find = \&OS2::DLL::find; bootstrap OS2::REXX; # Preloaded methods go here. Autoload methods go after __END__, and are # processed by the autosplit program. -# Cannot autoload, the autoloader is used for the REXX functions. - -sub load -{ - confess 'Usage: load OS2::REXX <file> [<dirs>]' unless $#_ >= 1; - my ($class, $file, @where) = (@_, @libs); - return $dlls{$file} if $dlls{$file}; - my $handle; - foreach (@where) { - $handle = DynaLoader::dl_load_file("$_/$file.dll"); - last if $handle; - } - $handle = DynaLoader::dl_load_file($file) unless $handle; - return undef unless $handle; - eval "package OS2::REXX::$file; \@ISA = ('OS2::REXX');" - . "sub AUTOLOAD {" - . " \$OS2::REXX::AUTOLOAD = \$AUTOLOAD;" - . " goto &OS2::REXX::AUTOLOAD;" - . "} 1;" or die "eval package $@"; - return $dlls{$file} = bless {Handle => $handle, File => $file, Queue => 'SESSION' }, "OS2::REXX::$file"; -} - -sub find -{ - my $self = shift; - my $file = $self->{File}; - my $handle = $self->{Handle}; - my $prefix = exists($self->{Prefix}) ? $self->{Prefix} : ""; - my $queue = $self->{Queue}; - foreach (@_) { - my $name = "OS2::REXX::${file}::$_"; - next if defined(&$name); - my $addr = DynaLoader::dl_find_symbol($handle, uc $prefix.$_) - || DynaLoader::dl_find_symbol($handle, $prefix.$_) - or return 0; - eval "package OS2::REXX::$file; sub $_". - "{ shift; OS2::REXX::_call('$_', $addr, '$queue', \@_); }". - "1;" - or die "eval sub"; - } - return 1; -} - sub prefix { my $self = shift; @@ -386,4 +340,8 @@ See C<t/rx*.t> for examples. Andreas Kaiser ak@ananke.s.bawue.de, with additions by Ilya Zakharevich ilya@math.ohio-state.edu. +=head1 SEE ALSO + +L<OS2::DLL>. + =cut diff --git a/os2/OS2/REXX/REXX.xs b/os2/OS2/REXX/REXX.xs index 9f2371488c..8a8e5f2da0 100644 --- a/os2/OS2/REXX/REXX.xs +++ b/os2/OS2/REXX/REXX.xs @@ -236,49 +236,6 @@ constant(name,arg) char * name int arg -SV * -_call(name, address, queue="SESSION", ...) - char * name - void * address - char * queue - CODE: - { - ULONG rc; - int argc, i; - RXSTRING result; - UCHAR resbuf[256]; - RexxFunctionHandler *fcn = address; - argc = items-3; - needstrs(argc); - if (trace) - fprintf(stderr, "REXXCALL::_call name: '%s' args:", name); - for (i = 0; i < argc; ++i) { - STRLEN len; - char *ptr = SvPV(ST(3+i), len); - MAKERXSTRING(strs[i], ptr, len); - if (trace) - fprintf(stderr, " '%.*s'", len, ptr); - } - if (!*queue) - queue = "SESSION"; - if (trace) - fprintf(stderr, "\n"); - MAKERXSTRING(result, resbuf, sizeof resbuf); - rc = fcn(name, argc, strs, queue, &result); - if (trace) - fprintf(stderr, " rc=%X, result='%.*s'\n", rc, - result.strlength, result.strptr); - ST(0) = sv_newmortal(); - if (rc == 0) { - if (result.strptr) - sv_setpvn(ST(0), result.strptr, result.strlength); - else - sv_setpvn(ST(0), "", 0); - } - if (result.strptr && result.strptr != resbuf) - DosFreeMem(result.strptr); - } - int _set(name,value,...) char * name diff --git a/os2/OS2/REXX/t/rx_dllld.t b/os2/OS2/REXX/t/rx_dllld.t index 9d81bf3e56..15362d78e9 100644 --- a/os2/OS2/REXX/t/rx_dllld.t +++ b/os2/OS2/REXX/t/rx_dllld.t @@ -16,7 +16,7 @@ foreach $dir (split(';', $path)) { $found = "$dir/YDBAUTIL.DLL"; last; } -$found or die "1..0\n#Cannot find YDBAUTIL.DLL\n"; +$found or print "1..0 # skipped: cannot find YDBAUTIL.DLL\n" and exit; print "1..5\n"; diff --git a/os2/OS2/REXX/t/rx_emxrv.t b/os2/OS2/REXX/t/rx_emxrv.t new file mode 100644 index 0000000000..d51e1b0e32 --- /dev/null +++ b/os2/OS2/REXX/t/rx_emxrv.t @@ -0,0 +1,24 @@ +BEGIN { + chdir 't' if -d 't/lib'; + @INC = '../lib' if -d 'lib'; + require Config; import Config; + if (-d 'lib' and $Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) { + print "1..0\n"; + exit 0; + } +} + +print "1..5\n"; + +require OS2::DLL; +print "ok 1\n"; +$emx_dll = OS2::DLL->load('emx'); +print "ok 2\n"; +$emx_version = $emx_dll->emx_revision(); +print "ok 3\n"; +$emx_version >= 40 or print "not "; # We cannot work with old EMXs +print "ok 4\n"; + +$reason = ''; +$emx_version >= 99 and $reason = ' # skipped: version of EMX 100 or more'; # Be safe +print "ok 5$reason\n"; diff --git a/os2/OS2/REXX/t/rx_objcall.t b/os2/OS2/REXX/t/rx_objcall.t index cb3c52a8b6..8bdf90564d 100644 --- a/os2/OS2/REXX/t/rx_objcall.t +++ b/os2/OS2/REXX/t/rx_objcall.t @@ -13,7 +13,8 @@ use OS2::REXX; # # DLL # -$ydba = load OS2::REXX "ydbautil" or die "1..0\n# load\n"; +$ydba = load OS2::REXX "ydbautil" + or print "1..0 # skipped: cannot find YDBAUTIL.DLL\n" and exit; print "1..5\n", "ok 1\n"; # diff --git a/os2/OS2/REXX/t/rx_tievar.t b/os2/OS2/REXX/t/rx_tievar.t index 77f90c2f59..5f43f4e5fc 100644 --- a/os2/OS2/REXX/t/rx_tievar.t +++ b/os2/OS2/REXX/t/rx_tievar.t @@ -13,7 +13,8 @@ use OS2::REXX; # # DLL # -load OS2::REXX "ydbautil" or die "1..0\n# load\n"; +load OS2::REXX "ydbautil" + or print "1..0 # skipped: cannot find YDBAUTIL.DLL\n" and exit; print "1..19\n"; diff --git a/os2/OS2/REXX/t/rx_tieydb.t b/os2/OS2/REXX/t/rx_tieydb.t index 30a2dafb62..1653a2081c 100644 --- a/os2/OS2/REXX/t/rx_tieydb.t +++ b/os2/OS2/REXX/t/rx_tieydb.t @@ -9,7 +9,9 @@ BEGIN { } use OS2::REXX; -$rx = load OS2::REXX "ydbautil" or die "1..0\n# load\n"; # from RXU17.ZIP +$rx = load OS2::REXX "ydbautil" # from RXU17.ZIP + or print "1..0 # skipped: cannot find YDBAUTIL.DLL\n" and exit; + print "1..7\n", "ok 1\n"; $rx->prefix("Rx"); # implicit function prefix diff --git a/os2/OS2/REXX/t/rx_vrexx.t b/os2/OS2/REXX/t/rx_vrexx.t index 04ca6636db..b0621f4e22 100644 --- a/os2/OS2/REXX/t/rx_vrexx.t +++ b/os2/OS2/REXX/t/rx_vrexx.t @@ -18,7 +18,7 @@ foreach $dir (split(';', $path)) { print "# found at `$found'\n"; last; } -$found or die "1..0\n#Cannot find $name.DLL\n"; +$found or print "1..0 # skipped: cannot find $name.DLL\n" and exit; print "1..10\n"; diff --git a/os2/dl_os2.c b/os2/dl_os2.c index 19f36f6aa7..4a9688cb59 100644 --- a/os2/dl_os2.c +++ b/os2/dl_os2.c @@ -4,15 +4,16 @@ #include <os2.h> static ULONG retcode; +static char fail[300]; void * dlopen(char *path, int mode) { HMODULE handle; char tmp[260], *beg, *dot; - char fail[300]; ULONG rc; + fail[0] = 0; if ((rc = DosLoadModule(fail, sizeof fail, path, &handle)) == 0) return (void *)handle; @@ -42,6 +43,7 @@ dlsym(void *handle, char *symbol) ULONG rc, type; PFN addr; + fail[0] = 0; rc = DosQueryProcAddr((HMODULE)handle, 0, symbol, &addr); if (rc == 0) { rc = DosQueryProcType((HMODULE)handle, 0, symbol, &type); @@ -56,15 +58,31 @@ dlsym(void *handle, char *symbol) char * dlerror(void) { - static char buf[300]; + static char buf[700]; ULONG len; if (retcode == 0) return NULL; - if (DosGetMessage(NULL, 0, buf, sizeof buf - 1, retcode, "OSO001.MSG", &len)) - sprintf(buf, "OS/2 system error code %d", retcode); - else + if (DosGetMessage(NULL, 0, buf, sizeof buf - 1, retcode, + "OSO001.MSG", &len)) { + if (fail[0]) + sprintf(buf, +"OS/2 system error code %d, possible problematic module: '%s'", + retcode, fail); + else + sprintf(buf, "OS/2 system error code %d", retcode); + } else { buf[len] = '\0'; + if (len && buf[len - 1] == '\n') + buf[--len] = 0; + if (len && buf[len - 1] == '\r') + buf[--len] = 0; + if (len && buf[len - 1] == '.') + buf[--len] = 0; + if (fail[0] && len < 300) + sprintf(buf + len, ", possible problematic module: '%s'", + fail); + } retcode = 0; return buf; } @@ -3,6 +3,10 @@ #define INCL_DOSFILEMGR #define INCL_DOSMEMMGR #define INCL_DOSERRORS +/* These 3 are needed for compile if os2.h includes os2tk.h, not os2emx.h */ +#define INCL_DOSPROCESS +#define SPU_DISABLESUPPRESSION 0 +#define SPU_ENABLESUPPRESSION 1 #include <os2.h> #include <sys/uflags.h> @@ -802,7 +806,7 @@ U32 addflag; PL_Argv[0], Strerror(errno)); if (rc < 0 && (execf != EXECF_SPAWN_NOWAIT) && ((trueflag & 0xFF) == P_WAIT)) - rc = 255 << 8; /* Emulate the fork(). */ + rc = -1; finish: if (new_stderr != -1) { /* How can we use error codes? */ @@ -907,7 +911,8 @@ do_spawn3(char *cmd, int execf, int flag) Perl_warner(aTHX_ WARN_EXEC, "Can't %s \"%s\": %s", (execf == EXECF_SPAWN ? "spawn" : "exec"), shell, Strerror(errno)); - if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */ + if (rc < 0) + rc = -1; } if (news) Safefree(news); @@ -1356,18 +1361,37 @@ os2error(int rc) return NULL; if (DosGetMessage(NULL, 0, buf, sizeof buf - 1, rc, "OSO001.MSG", &len)) sprintf(buf, "OS/2 system error code %d=0x%x", rc, rc); - else + else { buf[len] = '\0'; - if (len > 0 && buf[len - 1] == '\n') - buf[len - 1] = '\0'; - if (len > 1 && buf[len - 2] == '\r') - buf[len - 2] = '\0'; - if (len > 2 && buf[len - 3] == '.') - buf[len - 3] = '\0'; + if (len && buf[len - 1] == '\n') + buf[--len] = 0; + if (len && buf[len - 1] == '\r') + buf[--len] = 0; + if (len && buf[len - 1] == '.') + buf[--len] = 0; + } return buf; } char * +os2_execname(void) +{ + char buf[300], *p; + + if (_execname(buf, sizeof buf) != 0) + return PL_origargv[0]; + p = buf; + while (*p) { + if (*p == '\\') + *p = '/'; + p++; + } + p = savepv(buf); + SAVEFREEPV(p); + return p; +} + +char * perllib_mangle(char *s, unsigned int l) { static char *newp, *oldp; @@ -2067,7 +2091,7 @@ Perl_OS2_init(char **env) settmppath(); OS2_Perl_data.xs_init = &Xs_OS2_init; _uflags (_UF_SBRK_MODEL, _UF_SBRK_ARBITRARY); - if (environ == NULL) { + if (environ == NULL && env) { environ = env; } if ( (shell = getenv("PERL_SH_DRIVE")) ) { diff --git a/os2/os2ish.h b/os2/os2ish.h index 6993dfca5d..23b109670f 100644 --- a/os2/os2ish.h +++ b/os2/os2ish.h @@ -183,16 +183,26 @@ void Perl_OS2_init(char **); /* XXX This code hideously puts env inside: */ -#ifdef __EMX__ +#ifdef PERL_CORE +# define PERL_SYS_INIT3(argcp, argvp, envp) STMT_START { \ + _response(argcp, argvp); \ + _wildcard(argcp, argvp); \ + Perl_OS2_init(*envp); } STMT_END # define PERL_SYS_INIT(argcp, argvp) STMT_START { \ _response(argcp, argvp); \ _wildcard(argcp, argvp); \ - Perl_OS2_init(env); } STMT_END -#else /* Compiling embedded Perl with non-EMX compiler */ + Perl_OS2_init(NULL); } STMT_END +#else /* Compiling embedded Perl or Perl extension */ +# define PERL_SYS_INIT3(argcp, argvp, envp) STMT_START { \ + Perl_OS2_init(*envp); } STMT_END # define PERL_SYS_INIT(argcp, argvp) STMT_START { \ - Perl_OS2_init(env); } STMT_END + Perl_OS2_init(NULL); } STMT_END +#endif + +#ifndef __EMX__ # define PERL_CALLCONV _System #endif + #define PERL_SYS_TERM() MALLOC_TERM /* #define PERL_SYS_TERM() STMT_START { \ @@ -318,6 +328,7 @@ extern OS2_Perl_data_t OS2_Perl_data; #define Perl_rc (OS2_Perl_data.rc) #define Perl_severity (OS2_Perl_data.severity) #define errno_isOS2 12345678 +#define errno_isOS2_set 12345679 #define OS2_Perl_flags (OS2_Perl_data.flags) #define Perl_HAB_set_f 1 #define Perl_HAB_set (OS2_Perl_flags & Perl_HAB_set_f) @@ -339,6 +350,7 @@ void Perl_Deregister_MQ(int serve); int Perl_Serve_Messages(int force); /* Cannot prototype with I32 at this point. */ int Perl_Process_Messages(int force, long *cntp); +char *os2_execname(void); struct _QMSG; struct PMWIN_entries_t { @@ -356,23 +368,29 @@ struct PMWIN_entries_t { extern struct PMWIN_entries_t PMWIN_entries; void init_PMWIN_entries(void); -#define perl_hmq_GET(serve) Perl_Register_MQ(serve); -#define perl_hmq_UNSET(serve) Perl_Deregister_MQ(serve); +#define perl_hmq_GET(serve) Perl_Register_MQ(serve) +#define perl_hmq_UNSET(serve) Perl_Deregister_MQ(serve) #define OS2_XS_init() (*OS2_Perl_data.xs_init)() + +#if _EMX_CRT_REV_ >= 60 +# define os2_setsyserrno(rc) (Perl_rc = rc, errno = errno_isOS2_set, \ + _setsyserrno(rc)) +#else +# define os2_setsyserrno(rc) (Perl_rc = rc, errno = errno_isOS2) +#endif + /* The expressions below return true on error. */ /* INCL_DOSERRORS needed. rc should be declared outside. */ #define CheckOSError(expr) (!(rc = (expr)) ? 0 : (FillOSError(rc), 1)) /* INCL_WINERRORS needed. */ #define SaveWinError(expr) ((expr) ? : (FillWinError, 0)) #define CheckWinError(expr) ((expr) ? 0: (FillWinError, 1)) -#define FillOSError(rc) (Perl_rc = rc, \ - errno = errno_isOS2, \ +#define FillOSError(rc) (os2_setsyserrno(rc), \ Perl_severity = SEVERITY_ERROR) -#define FillWinError (Perl_rc = WinGetLastError(Perl_hab), \ - errno = errno_isOS2, \ - Perl_severity = ERRORIDSEV(Perl_rc), \ - Perl_rc = ERRORIDERROR(Perl_rc)) +#define FillWinError (Perl_severity = ERRORIDSEV(Perl_rc), \ + Perl_rc = ERRORIDERROR(Perl_rc)), \ + os2_setsyserrno(Perl_rc) #define STATIC_FILE_LENGTH 127 @@ -392,7 +410,7 @@ char *os2error(int rc); #define QSS_FILE 8 /* Buggy until fixpack18 */ #define QSS_SHARED 16 -#ifdef _OS2EMX_H +#ifdef _OS2_H APIRET APIENTRY Dos32QuerySysState(ULONG func,ULONG arg1,ULONG pid, ULONG _res_,PVOID buf,ULONG bufsz); @@ -550,5 +568,5 @@ typedef struct { PQTOPLEVEL get_sysinfo(ULONG pid, ULONG flags); -#endif /* _OS2EMX_H */ +#endif /* _OS2_H */ @@ -201,6 +201,7 @@ perl_construct(pTHXx) init_i18nl10n(1); SET_NUMERIC_STANDARD(); + #if defined(PERL_SUBVERSION) && PERL_SUBVERSION > 0 sprintf(PL_patchlevel, "%7.5f", (double) PERL_REVISION + ((double) PERL_VERSION / (double) 1000) @@ -219,11 +220,6 @@ perl_construct(pTHXx) PL_fdpid = newAV(); /* for remembering popen pids by fd */ PL_modglobal = newHV(); /* pointers to per-interpreter module globals */ - DEBUG( { - New(51,PL_debname,128,char); - New(52,PL_debdelim,128,char); - } ) - ENTER; } @@ -389,8 +385,6 @@ perl_destruct(pTHXx) PL_dowarn = G_WARN_OFF; PL_doextract = FALSE; PL_sawampersand = FALSE; /* must save all match strings */ - PL_sawstudy = FALSE; /* do fbm_instr on all strings */ - PL_sawvec = FALSE; PL_unsafe = FALSE; Safefree(PL_inplace); @@ -446,7 +440,6 @@ perl_destruct(pTHXx) /* shortcuts just get cleared */ PL_envgv = Nullgv; - PL_siggv = Nullgv; PL_incgv = Nullgv; PL_hintgv = Nullgv; PL_errgv = Nullgv; @@ -701,6 +694,7 @@ S_parse_body(pTHX_ va_list args) AV* comppadlist; register SV *sv; register char *s; + char *cddir = Nullch; XSINIT_t xsinit = va_arg(args, XSINIT_t); @@ -869,7 +863,7 @@ print \" \\@INC:\\n @INC\\n\";"); PL_doextract = TRUE; s++; if (*s) - PL_cddir = savepv(s); + cddir = s; break; case 0: break; @@ -942,8 +936,27 @@ print \" \\@INC:\\n @INC\\n\";"); validate_suid(validarg, scriptname,fdscript); - if (PL_doextract) +#if defined(SIGCHLD) || defined(SIGCLD) + { +#ifndef SIGCHLD +# define SIGCHLD SIGCLD +#endif + Sighandler_t sigstate = rsignal_state(SIGCHLD); + if (sigstate == SIG_IGN) { + if (ckWARN(WARN_SIGNAL)) + Perl_warner(aTHX_ WARN_SIGNAL, + "Can't ignore signal CHLD, forcing to default"); + (void)rsignal(SIGCHLD, (Sighandler_t)SIG_DFL); + } + } +#endif + + if (PL_doextract) { find_beginning(); + if (cddir && PerlDir_chdir(cddir) < 0) + Perl_croak(aTHX_ "Can't chdir to %s",cddir); + + } PL_main_cv = PL_compcv = (CV*)NEWSV(1104,0); sv_upgrade((SV *)PL_compcv, SVt_PVCV); @@ -1576,7 +1589,7 @@ Perl_moreswitches(pTHX_ char *s) case '0': { dTHR; - rschar = scan_oct(s, 4, &numlen); + rschar = (U32)scan_oct(s, 4, &numlen); SvREFCNT_dec(PL_nrs); if (rschar & ~((U8)~0)) PL_nrs = &PL_sv_undef; @@ -1678,7 +1691,7 @@ Perl_moreswitches(pTHX_ char *s) if (isDIGIT(*s)) { PL_ors = savepv("\n"); PL_orslen = 1; - *PL_ors = scan_oct(s, 3 + (*s == '0'), &numlen); + *PL_ors = (char)scan_oct(s, 3 + (*s == '0'), &numlen); s += numlen; } else { @@ -1901,7 +1914,6 @@ S_init_interp(pTHX) PL_curcop = &PL_compiling;\ PL_curcopdb = NULL; \ PL_dbargs = 0; \ - PL_dlmax = 128; \ PL_dumpindent = 4; \ PL_laststatval = -1; \ PL_laststype = OP_STAT; \ @@ -1911,7 +1923,6 @@ S_init_interp(pTHX) PL_tmps_floor = -1; \ PL_tmps_ix = -1; \ PL_op_mask = NULL; \ - PL_dlmax = 128; \ PL_laststatval = -1; \ PL_laststype = OP_STAT; \ PL_mess_sv = Nullsv; \ @@ -2527,8 +2538,6 @@ S_find_beginning(pTHX) /*SUPPRESS 530*/ while (s = moreswitches(s)) ; } - if (PL_cddir && PerlDir_chdir(PL_cddir) < 0) - Perl_croak(aTHX_ "Can't chdir to %s",PL_cddir); } } } @@ -2643,10 +2652,6 @@ S_nuke_stacks(pTHX) Safefree(PL_scopestack); Safefree(PL_savestack); Safefree(PL_retstack); - DEBUG( { - Safefree(PL_debname); - Safefree(PL_debdelim); - } ) } #ifndef PERL_OBJECT @@ -2745,7 +2750,11 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register magicname("0", "0", 1); } if (tmpgv = gv_fetchpv("\030",TRUE, SVt_PV)) +#ifdef OS2 + sv_setpv(GvSV(tmpgv), os2_execname()); +#else sv_setpv(GvSV(tmpgv),PL_origargv[0]); +#endif if (PL_argvgv = gv_fetchpv("ARGV",TRUE, SVt_PVAV)) { GvMULTI_on(PL_argvgv); (void)gv_AVadd(PL_argvgv); @@ -1563,6 +1563,10 @@ typedef union any ANY; # endif #endif +#ifndef PERL_SYS_INIT3 +# define PERL_SYS_INIT3(argvp,argcp,envp) PERL_SYS_INIT(argvp,argcp) +#endif + #ifndef MAXPATHLEN # ifdef PATH_MAX # ifdef _POSIX_PATH_MAX @@ -2800,85 +2804,85 @@ START_EXTERN_C #ifdef DOINIT -EXT MGVTBL PL_vtbl_sv = {Perl_magic_get, - Perl_magic_set, - Perl_magic_len, +EXT MGVTBL PL_vtbl_sv = {MEMBER_TO_FPTR(Perl_magic_get), + MEMBER_TO_FPTR(Perl_magic_set), + MEMBER_TO_FPTR(Perl_magic_len), 0, 0}; -EXT MGVTBL PL_vtbl_env = {0, Perl_magic_set_all_env, - 0, Perl_magic_clear_all_env, +EXT MGVTBL PL_vtbl_env = {0, MEMBER_TO_FPTR(Perl_magic_set_all_env), + 0, MEMBER_TO_FPTR(Perl_magic_clear_all_env), 0}; -EXT MGVTBL PL_vtbl_envelem = {0, Perl_magic_setenv, - 0, Perl_magic_clearenv, +EXT MGVTBL PL_vtbl_envelem = {0, MEMBER_TO_FPTR(Perl_magic_setenv), + 0, MEMBER_TO_FPTR(Perl_magic_clearenv), 0}; EXT MGVTBL PL_vtbl_sig = {0, 0, 0, 0, 0}; -EXT MGVTBL PL_vtbl_sigelem = {Perl_magic_getsig, - Perl_magic_setsig, - 0, Perl_magic_clearsig, +EXT MGVTBL PL_vtbl_sigelem = {MEMBER_TO_FPTR(Perl_magic_getsig), + MEMBER_TO_FPTR(Perl_magic_setsig), + 0, MEMBER_TO_FPTR(Perl_magic_clearsig), 0}; -EXT MGVTBL PL_vtbl_pack = {0, 0, Perl_magic_sizepack, Perl_magic_wipepack, +EXT MGVTBL PL_vtbl_pack = {0, 0, MEMBER_TO_FPTR(Perl_magic_sizepack), MEMBER_TO_FPTR(Perl_magic_wipepack), 0}; -EXT MGVTBL PL_vtbl_packelem = {Perl_magic_getpack, - Perl_magic_setpack, - 0, Perl_magic_clearpack, +EXT MGVTBL PL_vtbl_packelem = {MEMBER_TO_FPTR(Perl_magic_getpack), + MEMBER_TO_FPTR(Perl_magic_setpack), + 0, MEMBER_TO_FPTR(Perl_magic_clearpack), 0}; -EXT MGVTBL PL_vtbl_dbline = {0, Perl_magic_setdbline, +EXT MGVTBL PL_vtbl_dbline = {0, MEMBER_TO_FPTR(Perl_magic_setdbline), 0, 0, 0}; -EXT MGVTBL PL_vtbl_isa = {0, Perl_magic_setisa, - 0, Perl_magic_setisa, +EXT MGVTBL PL_vtbl_isa = {0, MEMBER_TO_FPTR(Perl_magic_setisa), + 0, MEMBER_TO_FPTR(Perl_magic_setisa), 0}; -EXT MGVTBL PL_vtbl_isaelem = {0, Perl_magic_setisa, +EXT MGVTBL PL_vtbl_isaelem = {0, MEMBER_TO_FPTR(Perl_magic_setisa), 0, 0, 0}; -EXT MGVTBL PL_vtbl_arylen = {Perl_magic_getarylen, - Perl_magic_setarylen, +EXT MGVTBL PL_vtbl_arylen = {MEMBER_TO_FPTR(Perl_magic_getarylen), + MEMBER_TO_FPTR(Perl_magic_setarylen), 0, 0, 0}; -EXT MGVTBL PL_vtbl_glob = {Perl_magic_getglob, - Perl_magic_setglob, +EXT MGVTBL PL_vtbl_glob = {MEMBER_TO_FPTR(Perl_magic_getglob), + MEMBER_TO_FPTR(Perl_magic_setglob), 0, 0, 0}; -EXT MGVTBL PL_vtbl_mglob = {0, Perl_magic_setmglob, +EXT MGVTBL PL_vtbl_mglob = {0, MEMBER_TO_FPTR(Perl_magic_setmglob), 0, 0, 0}; -EXT MGVTBL PL_vtbl_nkeys = {Perl_magic_getnkeys, - Perl_magic_setnkeys, +EXT MGVTBL PL_vtbl_nkeys = {MEMBER_TO_FPTR(Perl_magic_getnkeys), + MEMBER_TO_FPTR(Perl_magic_setnkeys), 0, 0, 0}; -EXT MGVTBL PL_vtbl_taint = {Perl_magic_gettaint,Perl_magic_settaint, +EXT MGVTBL PL_vtbl_taint = {MEMBER_TO_FPTR(Perl_magic_gettaint),MEMBER_TO_FPTR(Perl_magic_settaint), 0, 0, 0}; -EXT MGVTBL PL_vtbl_substr = {Perl_magic_getsubstr, Perl_magic_setsubstr, +EXT MGVTBL PL_vtbl_substr = {MEMBER_TO_FPTR(Perl_magic_getsubstr), MEMBER_TO_FPTR(Perl_magic_setsubstr), 0, 0, 0}; -EXT MGVTBL PL_vtbl_vec = {Perl_magic_getvec, - Perl_magic_setvec, +EXT MGVTBL PL_vtbl_vec = {MEMBER_TO_FPTR(Perl_magic_getvec), + MEMBER_TO_FPTR(Perl_magic_setvec), 0, 0, 0}; -EXT MGVTBL PL_vtbl_pos = {Perl_magic_getpos, - Perl_magic_setpos, +EXT MGVTBL PL_vtbl_pos = {MEMBER_TO_FPTR(Perl_magic_getpos), + MEMBER_TO_FPTR(Perl_magic_setpos), 0, 0, 0}; -EXT MGVTBL PL_vtbl_bm = {0, Perl_magic_setbm, +EXT MGVTBL PL_vtbl_bm = {0, MEMBER_TO_FPTR(Perl_magic_setbm), 0, 0, 0}; -EXT MGVTBL PL_vtbl_fm = {0, Perl_magic_setfm, +EXT MGVTBL PL_vtbl_fm = {0, MEMBER_TO_FPTR(Perl_magic_setfm), 0, 0, 0}; -EXT MGVTBL PL_vtbl_uvar = {Perl_magic_getuvar, - Perl_magic_setuvar, +EXT MGVTBL PL_vtbl_uvar = {MEMBER_TO_FPTR(Perl_magic_getuvar), + MEMBER_TO_FPTR(Perl_magic_setuvar), 0, 0, 0}; #ifdef USE_THREADS -EXT MGVTBL PL_vtbl_mutex = {0, 0, 0, 0, Perl_magic_mutexfree}; +EXT MGVTBL PL_vtbl_mutex = {0, 0, 0, 0, MEMBER_TO_FPTR(Perl_magic_mutexfree)}; #endif /* USE_THREADS */ -EXT MGVTBL PL_vtbl_defelem = {Perl_magic_getdefelem,Perl_magic_setdefelem, +EXT MGVTBL PL_vtbl_defelem = {MEMBER_TO_FPTR(Perl_magic_getdefelem),MEMBER_TO_FPTR(Perl_magic_setdefelem), 0, 0, 0}; -EXT MGVTBL PL_vtbl_regexp = {0,0,0,0, Perl_magic_freeregexp}; -EXT MGVTBL PL_vtbl_regdata = {0, 0, Perl_magic_regdata_cnt, 0, 0}; -EXT MGVTBL PL_vtbl_regdatum = {Perl_magic_regdatum_get, 0, 0, 0, 0}; +EXT MGVTBL PL_vtbl_regexp = {0,0,0,0, MEMBER_TO_FPTR(Perl_magic_freeregexp)}; +EXT MGVTBL PL_vtbl_regdata = {0, 0, MEMBER_TO_FPTR(Perl_magic_regdata_cnt), 0, 0}; +EXT MGVTBL PL_vtbl_regdatum = {MEMBER_TO_FPTR(Perl_magic_regdatum_get), 0, 0, 0, 0}; #ifdef USE_LOCALE_COLLATE EXT MGVTBL PL_vtbl_collxfrm = {0, - Perl_magic_setcollxfrm, + MEMBER_TO_FPTR(Perl_magic_setcollxfrm), 0, 0, 0}; #endif -EXT MGVTBL PL_vtbl_amagic = {0, Perl_magic_setamagic, - 0, 0, Perl_magic_setamagic}; -EXT MGVTBL PL_vtbl_amagicelem = {0, Perl_magic_setamagic, - 0, 0, Perl_magic_setamagic}; +EXT MGVTBL PL_vtbl_amagic = {0, MEMBER_TO_FPTR(Perl_magic_setamagic), + 0, 0, MEMBER_TO_FPTR(Perl_magic_setamagic)}; +EXT MGVTBL PL_vtbl_amagicelem = {0, MEMBER_TO_FPTR(Perl_magic_setamagic), + 0, 0, MEMBER_TO_FPTR(Perl_magic_setamagic)}; EXT MGVTBL PL_vtbl_backref = {0, 0, - 0, 0, Perl_magic_killbackrefs}; + 0, 0, MEMBER_TO_FPTR(Perl_magic_killbackrefs)}; #else /* !DOINIT */ @@ -599,13 +599,6 @@ Perl_vdeb(pTHXo_ const char* pat, va_list* args) ((CPerlObj*)pPerl)->Perl_vdeb(pat, args); } -#undef Perl_deb_growlevel -void -Perl_deb_growlevel(pTHXo) -{ - ((CPerlObj*)pPerl)->Perl_deb_growlevel(); -} - #undef Perl_debprofdump void Perl_debprofdump(pTHXo) @@ -4210,7 +4203,7 @@ Perl_taint_env(pTHXo) #undef Perl_taint_proper void -Perl_taint_proper(pTHXo_ const char* f, char* s) +Perl_taint_proper(pTHXo_ const char* f, const char* s) { ((CPerlObj*)pPerl)->Perl_taint_proper(f, s); } diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 994c868dd8..da1425e6c1 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -1422,16 +1422,6 @@ See L<perlfunc/pack>. but this did not follow some numeric unpack specification. See L<perlfunc/pack>. -=item Repeat count in pack overflows - -(F) You can't specify a repeat count so large that it overflows -your signed integers. See L<perlfunc/pack>. - -=item Repeat count in unpack overflows - -(F) You can't specify a repeat count so large that it overflows -your signed integers. See L<perlfunc/unpack>. - =item /%s/: Unrecognized escape \\%c passed through (W) You used a backslash-character combination which is not recognized @@ -1522,6 +1512,15 @@ so it was truncated to the string shown. (P) For some reason you can't check the filesystem of the script for nosuid. +=item Can't ignore signal CHLD, forcing to default + +(W) Perl has detected that it is being run with the SIGCHLD signal +(sometimes known as SIGCLD) disabled. Since disabling this signal +will interfere with proper determination of exit status of child +processes, Perl has reset the signal to its default value. +This situation typically indicates that the parent program under +which Perl may be running (e.g. cron) is being very careless. + =item Can't modify non-lvalue subroutine call (F) Subroutines meant to be used in lvalue context should be declared as @@ -1764,6 +1763,16 @@ could be a potential Year 2000 problem. See Server error. +=item Repeat count in pack overflows + +(F) You can't specify a repeat count so large that it overflows +your signed integers. See L<perlfunc/pack>. + +=item Repeat count in unpack overflows + +(F) You can't specify a repeat count so large that it overflows +your signed integers. See L<perlfunc/unpack>. + =item realloc() of freed memory ignored (S) An internal routine called realloc() on something that had already diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 006c2d9740..0b1f68e848 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -826,6 +826,15 @@ L<perlfunc/goto>. (F) The "goto subroutine" call can't be used to jump out of an eval "string". (You can use it to jump out of an eval {BLOCK}, but you probably don't want to.) +=item Can't ignore signal CHLD, forcing to default + +(W) Perl has detected that it is being run with the SIGCHLD signal +(sometimes known as SIGCLD) disabled. Since disabling this signal +will interfere with proper determination of exit status of child +processes, Perl has reset the signal to its default value. +This situation typically indicates that the parent program under +which Perl may be running (e.g. cron) is being very careless. + =item Can't localize through a reference (F) You said something like C<local $$ref>, which Perl can't currently diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 42c5d2bdd5..f8efd7e428 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -4195,13 +4195,6 @@ If C<use locale> is in effect, the character used for the decimal point in formatted real numbers is affected by the LC_NUMERIC locale. See L<perllocale>. -To cope with broken systems that allow the standard locales to be -overridden by malicious users, the return value may be tainted -if any of the floating point formats are used and the conversion -yields something that doesn't look like a normal C-locale floating -point number. This happens regardless of whether C<use locale> is -in effect or not. - If Perl understands "quads" (64-bit integers) (this requires either that the platform natively supports quads or that Perl has been specifically compiled to support quads), the characters diff --git a/pod/perllocale.pod b/pod/perllocale.pod index 510117f299..475cc0d1e5 100644 --- a/pod/perllocale.pod +++ b/pod/perllocale.pod @@ -641,11 +641,12 @@ case-mapping table is in effect. =item * -If the decimal point character in the C<LC_NUMERIC> locale is -surreptitiously changed from a dot to a comma, C<sprintf("%g", -0.123456e3)> produces a string result of "123,456". Many people would -interpret this as one hundred and twenty-three thousand, four hundred -and fifty-six. +Some systems are broken in that they allow the "C" locale to be +overridden by users. If the decimal point character in the +C<LC_NUMERIC> category of the "C" locale is surreptitiously changed +from a dot to a comma, C<sprintf("%g", 0.123456e3)> produces a +string result of "123,456". Many people would interpret this as +one hundred and twenty-three thousand, four hundred and fifty-six. =item * @@ -714,10 +715,6 @@ if modified as a result of a substitution based on a regular expression match involving C<\w>, C<\W>, C<\s>, or C<\S>; or of case-mapping with C<\l>, C<\L>,C<\u> or C<\U>. -=item B<In-memory formatting function> (sprintf()): - -Result is tainted if C<use locale> is in effect. - =item B<Output formatting functions> (printf() and write()): Success/failure result is never tainted. diff --git a/pod/perlop.pod b/pod/perlop.pod index 6e65ba35bd..c430dbc48d 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -1074,9 +1074,9 @@ this expression: qw(foo bar baz) -is exactly equivalent to the list: +is semantically equivalent to the list: - ('foo', 'bar', 'baz') + 'foo', 'bar', 'baz' Some frequently seen examples: @@ -245,8 +245,14 @@ PP(pp_rv2gv) STRLEN len = 0; char *name = ""; if (cUNOP->op_first->op_type == OP_PADSV) { - SV *padname = *av_fetch(PL_comppad_name, cUNOP->op_first->op_targ, 4); - name = SvPV(padname,len); + SV **namep = av_fetch(PL_comppad_name, cUNOP->op_first->op_targ, 4); + if (namep && *namep) { + name = SvPV(*namep,len); + if (!name) { + name = ""; + len = 0; + } + } } gv_init(gv, PL_curcop->cop_stash, name, len, 0); sv_upgrade(sv, SVt_RV); @@ -83,7 +83,6 @@ VIRTUAL PPADDR_t* Perl_get_ppaddr(pTHX); VIRTUAL I32 Perl_cxinc(pTHX); VIRTUAL void Perl_deb(pTHX_ const char* pat, ...); VIRTUAL void Perl_vdeb(pTHX_ const char* pat, va_list* args); -VIRTUAL void Perl_deb_growlevel(pTHX); VIRTUAL void Perl_debprofdump(pTHX); VIRTUAL I32 Perl_debop(pTHX_ OP* o); VIRTUAL I32 Perl_debstack(pTHX); @@ -639,7 +638,7 @@ VIRTUAL void Perl_sv_vsetpvfn(pTHX_ SV* sv, const char* pat, STRLEN patlen, va_l VIRTUAL SV* Perl_swash_init(pTHX_ char* pkg, char* name, SV* listsv, I32 minbits, I32 none); VIRTUAL UV Perl_swash_fetch(pTHX_ SV *sv, U8 *ptr); VIRTUAL void Perl_taint_env(pTHX); -VIRTUAL void Perl_taint_proper(pTHX_ const char* f, char* s); +VIRTUAL void Perl_taint_proper(pTHX_ const char* f, const char* s); VIRTUAL UV Perl_to_utf8_lower(pTHX_ U8 *p); VIRTUAL UV Perl_to_utf8_upper(pTHX_ U8 *p); VIRTUAL UV Perl_to_utf8_title(pTHX_ U8 *p); @@ -992,7 +991,7 @@ STATIC I32 S_sublex_done(pTHX); STATIC I32 S_sublex_push(pTHX); STATIC I32 S_sublex_start(pTHX); STATIC char * S_filter_gets(pTHX_ SV *sv, PerlIO *fp, STRLEN append); -STATIC SV* S_new_constant(pTHX_ char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type); +STATIC SV* S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv, const char *type); STATIC int S_ao(pTHX_ int toketype); STATIC void S_depcom(pTHX); STATIC char* S_incl_perldb(pTHX); @@ -2027,7 +2027,7 @@ tryagain: if (!e) FAIL("Missing right brace on \\x{}"); else if (UTF) { - ender = scan_hex(p + 1, e - p, &numlen); + ender = (UV)scan_hex(p + 1, e - p, &numlen); if (numlen + len >= 127) { /* numlen is generous */ p--; goto loopdone; @@ -2038,7 +2038,7 @@ tryagain: FAIL("Can't use \\x{} without 'use utf8' declaration"); } else { - ender = scan_hex(p, 2, &numlen); + ender = (UV)scan_hex(p, 2, &numlen); p += numlen; } break; @@ -2051,7 +2051,7 @@ tryagain: case '5': case '6': case '7': case '8':case '9': if (*p == '0' || (isDIGIT(p[1]) && atoi(p) >= PL_regnpar) ) { - ender = scan_oct(p, 3, &numlen); + ender = (UV)scan_oct(p, 3, &numlen); p += numlen; } else { @@ -2356,7 +2356,7 @@ S_regclass(pTHX) case 'e': value = '\033'; break; case 'a': value = '\007'; break; case 'x': - value = scan_hex(PL_regcomp_parse, 2, &numlen); + value = (UV)scan_hex(PL_regcomp_parse, 2, &numlen); PL_regcomp_parse += numlen; break; case 'c': @@ -2365,7 +2365,7 @@ S_regclass(pTHX) break; case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': - value = scan_oct(--PL_regcomp_parse, 3, &numlen); + value = (UV)scan_oct(--PL_regcomp_parse, 3, &numlen); PL_regcomp_parse += numlen; break; default: @@ -2810,13 +2810,13 @@ S_regclassutf8(pTHX) e = strchr(PL_regcomp_parse++, '}'); if (!e) FAIL("Missing right brace on \\x{}"); - value = scan_hex(PL_regcomp_parse, + value = (UV)scan_hex(PL_regcomp_parse, e - PL_regcomp_parse, &numlen); PL_regcomp_parse = e + 1; } else { - value = scan_hex(PL_regcomp_parse, 2, &numlen); + value = (UV)scan_hex(PL_regcomp_parse, 2, &numlen); PL_regcomp_parse += numlen; } break; @@ -2826,7 +2826,7 @@ S_regclassutf8(pTHX) break; case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': - value = scan_oct(--PL_regcomp_parse, 3, &numlen); + value = (UV)scan_oct(--PL_regcomp_parse, 3, &numlen); PL_regcomp_parse += numlen; break; default: @@ -3057,7 +3057,7 @@ Perl_sv_unmagic(pTHX_ SV *sv, int type) if (mg->mg_type == type) { MGVTBL* vtbl = mg->mg_virtual; *mgp = mg->mg_moremagic; - if (vtbl && (vtbl->svt_free != NULL)) + if (vtbl && vtbl->svt_free) CALL_FPTR(vtbl->svt_free)(aTHX_ sv, mg); if (mg->mg_ptr && mg->mg_type != 'g') if (mg->mg_len >= 0) @@ -5355,7 +5355,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV case 16: if (!uv) alt = FALSE; - p = (c == 'X') ? "0123456789ABCDEF" : "0123456789abcdef"; + p = (char*)((c == 'X') + ? "0123456789ABCDEF" : "0123456789abcdef"); do { dig = uv & 15; *--eptr = p[dig]; @@ -5485,38 +5486,6 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV eptr = PL_efloatbuf; elen = strlen(PL_efloatbuf); - -#ifdef USE_LOCALE_NUMERIC - /* - * User-defined locales may include arbitrary characters. - * And, unfortunately, some (broken) systems may allow the - * "C" locale to be overridden by a malicious user. - * XXX This is an extreme way to cope with broken systems. - */ - if (maybe_tainted && PL_tainting) { - /* safe if it matches /[-+]?\d*(\.\d*)?([eE][-+]?\d*)?/ */ - if (*eptr == '-' || *eptr == '+') - ++eptr; - while (isDIGIT(*eptr)) - ++eptr; - if (*eptr == '.') { - ++eptr; - while (isDIGIT(*eptr)) - ++eptr; - } - if (*eptr == 'e' || *eptr == 'E') { - ++eptr; - if (*eptr == '-' || *eptr == '+') - ++eptr; - while (isDIGIT(*eptr)) - ++eptr; - } - if (*eptr) - *maybe_tainted = TRUE; /* results are suspect */ - eptr = PL_efloatbuf; - } -#endif /* USE_LOCALE_NUMERIC */ - break; /* SPECIAL */ @@ -147,12 +147,18 @@ else { print FH "helloworld\n"; truncate FH, 5; } - if ($^O eq 'dos') { + if ($^O eq 'dos' + # Not needed on HPFS, but needed on HPFS386 ?! + or $^O eq 'os2') + { close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp"; } if (-s "Iofs.tmp" == 5) {print "ok 25\n"} else {print "not ok 25\n"} truncate FH, 0; - if ($^O eq 'dos') { + if ($^O eq 'dos' + # Not needed on HPFS, but needed on HPFS386 ?! + or $^O eq 'os2') + { close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp"; } if (-z "Iofs.tmp") {print "ok 26\n"} else {print "not ok 26\n"} diff --git a/t/op/int.t b/t/op/int.t index eb060acd72..6ac0866a2b 100755 --- a/t/op/int.t +++ b/t/op/int.t @@ -1,8 +1,11 @@ #!./perl -# $RCSfile: int.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:00 $ +BEGIN { + chdir 't' if -d 't'; + unshift @INC, '../lib'; +} -print "1..4\n"; +print "1..6\n"; # compile time evaluation @@ -15,3 +18,13 @@ if (int(-1.234) == -1) {print "ok 2\n";} else {print "not ok 2\n";} $x = 1.234; if (int($x) == 1) {print "ok 3\n";} else {print "not ok 3\n";} if (int(-$x) == -1) {print "ok 4\n";} else {print "not ok 4\n";} + +$x = length("abc") % -10; +print $x == -7 ? "ok 5\n" : "# expected -7, got $x\nnot ok 5\n"; + +{ + use integer; + $x = length("abc") % -10; + $y = (3/-10)*-10; + print $x+$y == 3 && abs($x) < 10 ? "ok 6\n" : "not ok 6\n"; +} diff --git a/t/op/lex_assign.t b/t/op/lex_assign.t index b5c471a5a0..0f658694dd 100755 --- a/t/op/lex_assign.t +++ b/t/op/lex_assign.t @@ -4,6 +4,7 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; } +$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; umask 0; $xref = \ ""; diff --git a/t/op/magic.t b/t/op/magic.t index 31765e2c50..fe55521814 100755 --- a/t/op/magic.t +++ b/t/op/magic.t @@ -22,6 +22,7 @@ sub ok { $Is_MSWin32 = $^O eq 'MSWin32'; $Is_VMS = $^O eq 'VMS'; $Is_Dos = $^O eq 'dos'; +$Is_os2 = $^O eq 'os2'; $Is_Cygwin = $^O =~ /cygwin/; $PERL = ($Is_MSWin32 ? '.\perl' : './perl'); @@ -117,6 +118,9 @@ ok 18, $$ > 0, $$; chomp($wd = `pwd`); $wd =~ s#/t$##; } + elsif($Is_os2) { + $wd = Cwd::sys_cwd(); + } else { $wd = '.'; } @@ -142,6 +146,9 @@ __END__ :endofperl EOT } + elsif ($Is_os2) { + $script = "./show-shebang"; + } if ($^O eq 'os390' or $^O eq 'posix-bc' or $^O eq 'vmesa') { # no shebang $headmaybe = <<EOH ; eval 'exec ./perl -S \$0 \${1+"\$\@"}' @@ -158,15 +165,15 @@ EOF ok 21, close(SCRIPT), $!; ok 22, chmod(0755, $script), $!; $_ = `$script`; - s/\.exe//i if $Is_Dos or $Is_Cygwin; + s/\.exe//i if $Is_Dos or $Is_Cygwin or $Is_os2; s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl s{is perl}{is $perl}; # for systems where $^X is only a basename s{\\}{/}g; - ok 23, ($Is_MSWin32 ? uc($_) eq uc($s1) : $_ eq $s1), ":$_:!=:$s1:"; + ok 23, (($Is_MSWin32 || $Is_os2) ? uc($_) eq uc($s1) : $_ eq $s1), " :$_:!=:$s1:"; $_ = `$perl $script`; - s/\.exe//i if $Is_Dos; + s/\.exe//i if $Is_Dos or $Is_os2; s{\\}{/}g; - ok 24, ($Is_MSWin32 ? uc($_) eq uc($s1) : $_ eq $s1), ":$_:!=:$s1: after `$perl $script`"; + ok 24, (($Is_MSWin32 || $Is_os2) ? uc($_) eq uc($s1) : $_ eq $s1), " :$_:!=:$s1: after `$perl $script`"; ok 25, unlink($script), $!; } @@ -211,8 +218,8 @@ if ($Is_MSWin32) { ok 35, (scalar(keys(%ENV)) == 0); } else { - ok "32 # skipped",1; - ok "33 # skipped",1; - ok "34 # skipped",1; - ok "35 # skipped",1; + ok "32 # skipped: no caseless %ENV support",1; + ok "33 # skipped: no caseless %ENV support",1; + ok "34 # skipped: no caseless %ENV support",1; + ok "35 # skipped: no caseless %ENV support",1; } diff --git a/t/pragma/warn/op b/t/pragma/warn/op index 950c0c8ffd..9a278effe9 100644 --- a/t/pragma/warn/op +++ b/t/pragma/warn/op @@ -558,7 +558,7 @@ Useless use of a constant in void context at - line 3. Useless use of a constant in void context at - line 4. ######## # op.c -$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; # known scalar leak +BEGIN{ $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; } # known scalar leak use warnings 'unsafe' ; my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ; @a =~ /abc/ ; @@ -9,7 +9,7 @@ #include "perl.h" void -Perl_taint_proper(pTHX_ const char *f, char *s) +Perl_taint_proper(pTHX_ const char *f, const char *s) { dTHR; /* just for taint */ char *ug; @@ -1153,7 +1153,7 @@ S_scan_const(pTHX_ char *start) ? (PL_sublex_info.sub_op->op_private & (PL_lex_repl ? OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF)) : UTF; - char *leaveit = /* set of acceptably-backslashed characters */ + const char *leaveit = /* set of acceptably-backslashed characters */ PL_lex_inpat ? "\\.^$@AGZdDwWsSbBpPXC+*?|()-nrtfeaxcz0123456789[{]} \t\n\r\f\v#" : ""; @@ -1330,7 +1330,7 @@ S_scan_const(pTHX_ char *start) /* \132 indicates an octal constant */ case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': - *d++ = scan_oct(s, 3, &len); + *d++ = (char)scan_oct(s, 3, &len); s += len; continue; @@ -1352,7 +1352,7 @@ S_scan_const(pTHX_ char *start) } /* note: utf always shorter than hex */ d = (char*)uv_to_utf8((U8*)d, - scan_hex(s + 1, e - s - 1, &len)); + (UV)scan_hex(s + 1, e - s - 1, &len)); s = e + 1; } else { @@ -1772,10 +1772,9 @@ S_incl_perldb(pTHX) SV * Perl_filter_add(pTHX_ filter_t funcp, SV *datasv) { - if (!funcp){ /* temporary handy debugging hack to be deleted */ - PL_filter_debug = atoi((char*)datasv); - return NULL; - } + if (!funcp) + return Nullsv; + if (!PL_rsfp_filters) PL_rsfp_filters = newAV(); if (!datasv) @@ -1783,12 +1782,8 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv) if (!SvUPGRADE(datasv, SVt_PVIO)) Perl_die(aTHX_ "Can't upgrade filter_add data to SVt_PVIO"); IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */ -#ifdef DEBUGGING - if (PL_filter_debug) { - STRLEN n_a; - Perl_warn(aTHX_ "filter_add func %p (%s)", funcp, SvPV(datasv, n_a)); - } -#endif /* DEBUGGING */ + DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_add func %p (%s)\n", + funcp, SvPV_nolen(datasv))); av_unshift(PL_rsfp_filters, 1); av_store(PL_rsfp_filters, 0, datasv) ; return(datasv); @@ -1799,10 +1794,7 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv) void Perl_filter_del(pTHX_ filter_t funcp) { -#ifdef DEBUGGING - if (PL_filter_debug) - Perl_warn(aTHX_ "filter_del func %p", funcp); -#endif /* DEBUGGING */ + DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", funcp)); if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0) return; /* if filter is on top of stack (usual case) just pop it off */ @@ -1832,10 +1824,8 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) if (idx > AvFILLp(PL_rsfp_filters)){ /* Any more filters? */ /* Provide a default input filter to make life easy. */ /* Note that we append to the line. This is handy. */ -#ifdef DEBUGGING - if (PL_filter_debug) - Perl_warn(aTHX_ "filter_read %d: from rsfp\n", idx); -#endif /* DEBUGGING */ + DEBUG_P(PerlIO_printf(Perl_debug_log, + "filter_read %d: from rsfp\n", idx)); if (maxlen) { /* Want a block */ int len ; @@ -1863,21 +1853,16 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) } /* Skip this filter slot if filter has been deleted */ if ( (datasv = FILTER_DATA(idx)) == &PL_sv_undef){ -#ifdef DEBUGGING - if (PL_filter_debug) - Perl_warn(aTHX_ "filter_read %d: skipped (filter deleted)\n", idx); -#endif /* DEBUGGING */ + DEBUG_P(PerlIO_printf(Perl_debug_log, + "filter_read %d: skipped (filter deleted)\n", + idx)); return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */ } /* Get function pointer hidden within datasv */ funcp = (filter_t)IoDIRP(datasv); -#ifdef DEBUGGING - if (PL_filter_debug) { - STRLEN n_a; - Perl_warn(aTHX_ "filter_read %d: via function %p (%s)\n", - idx, funcp, SvPV(datasv,n_a)); - } -#endif /* DEBUGGING */ + DEBUG_P(PerlIO_printf(Perl_debug_log, + "filter_read %d: via function %p (%s)\n", + idx, funcp, SvPV_nolen(datasv))); /* Call function. The function is expected to */ /* call "FILTER_READ(idx+1, buf_sv)" first. */ /* Return: <0:error, =0:eof, >0:not eof */ @@ -3858,8 +3843,10 @@ Perl_yylex(pTHX) case KEY_crypt: #ifdef FCRYPT - if (!PL_cryptseen++) + if (!PL_cryptseen) { + PL_cryptseen = TRUE; init_des(); + } #endif LOP(OP_CRYPT,XTERM); @@ -4543,7 +4530,6 @@ Perl_yylex(pTHX) UNI(OP_STAT); case KEY_study: - PL_sawstudy++; UNI(OP_STUDY); case KEY_substr: @@ -4754,7 +4740,6 @@ Perl_yylex(pTHX) UNI(OP_VALUES); case KEY_vec: - PL_sawvec = TRUE; LOP(OP_VEC,XTERM); case KEY_while: @@ -5475,14 +5460,15 @@ S_checkcomma(pTHX_ register char *s, char *name, char *what) and type is used with error messages only. */ STATIC SV * -S_new_constant(pTHX_ char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type) +S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv, + const char *type) { dSP; HV *table = GvHV(PL_hintgv); /* ^H */ SV *res; SV **cvp; SV *cv, *typesv; - char *why, *why1, *why2; + const char *why, *why1, *why2; if (!(PL_hints & HINT_LOCALIZE_HH)) { SV *msg; @@ -5710,7 +5696,7 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) { dTHR; /* only for ckWARN */ if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) { - char *brack = *s == '[' ? "[...]" : "{...}"; + const char *brack = *s == '[' ? "[...]" : "{...}"; Perl_warner(aTHX_ WARN_AMBIGUOUS, "Ambiguous use of %c{%s%s} resolved to %c%s%s", funny, dest, brack, funny, dest, brack); diff --git a/win32/makefile.mk b/win32/makefile.mk index bb87b58269..b48ba1ec4c 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -325,7 +325,7 @@ LIBFILES = $(CRYPT_LIB) -ladvapi32 -luser32 -lnetapi32 -lwsock32 \ -lmingw32 -lgcc -lmoldname $(LIBC) -lkernel32 .IF "$(CFG)" == "Debug" -OPTIMIZE = -g -O2 $(RUNTIME) -DDEBUGGING +OPTIMIZE = -g $(RUNTIME) -DDEBUGGING LINK_DBG = -g .ELSE OPTIMIZE = -g -O2 $(RUNTIME) @@ -896,7 +896,7 @@ $(PERLDLL): perldll.def $(PERLDLL_OBJ) $(LINK32) -mdll -o $@ -Wl,--base-file -Wl,perl.base $(LINK_FLAGS) \ $(mktmp $(LKPRE) $(PERLDLL_OBJ:s,\,\\) $(LIBFILES) $(LKPOST)) dlltool --output-lib $(PERLIMPLIB) \ - --dllname perl.dll \ + --dllname $(PERLDLL:b).dll \ --def perldll.def \ --base-file perl.base \ --output-exp perl.exp diff --git a/win32/perllib.c b/win32/perllib.c index f6cc6322bf..e8d59cdf36 100644 --- a/win32/perllib.c +++ b/win32/perllib.c @@ -1170,6 +1170,7 @@ PerlProcPauseProc(struct IPerlProc *I) PerlIO* PerlProcPopen(struct IPerlProc *I, const char *command, const char *mode) { + dTHXo; PERL_FLUSHALL_FOR_CHILD; return (PerlIO*)win32_popen(command, mode); } diff --git a/win32/win32.c b/win32/win32.c index 1bfb6feaa0..52692d797f 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -66,7 +66,11 @@ int _CRT_glob = 0; #endif -#ifdef __BORLANDC__ +#if defined(__MINGW32__) +# define _stat stat +#endif + +#if defined(__BORLANDC__) # define _stat stat # define _utimbuf utimbuf #endif @@ -94,7 +98,7 @@ int _CRT_glob = 0; #endif static void get_shell(void); -static long tokenize(char *str, char **dest, char ***destv); +static long tokenize(const char *str, char **dest, char ***destv); int do_spawn2(char *cmd, int exectype); static BOOL has_shell_metachars(char *ptr); static long filetime_to_clock(PFILETIME ft); @@ -427,7 +431,7 @@ win32_os_id(void) * Returns number of words in result buffer. */ static long -tokenize(char *str, char **dest, char ***destv) +tokenize(const char *str, char **dest, char ***destv) { char *retstart = Nullch; char **retvstart = 0; @@ -485,8 +489,9 @@ get_shell(void) * interactive use (which is what most programs look in COMSPEC * for). */ - char* defaultshell = (IsWinNT() ? "cmd.exe /x/c" : "command.com /c"); - char *usershell = getenv("PERL5SHELL"); + const char* defaultshell = (IsWinNT() + ? "cmd.exe /x/c" : "command.com /c"); + const char *usershell = getenv("PERL5SHELL"); w32_perlshell_items = tokenize(usershell ? usershell : defaultshell, &w32_perlshell_tokens, &w32_perlshell_vec); @@ -2552,7 +2557,7 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv) return spawnvp(mode, cmdname, (char * const *)argv); #else dTHXo; - DWORD ret; + int ret; void* env; char* dir; STARTUPINFO StartupInfo; @@ -2629,12 +2634,15 @@ RETRY: if (mode == P_NOWAIT) { /* asynchronous spawn -- store handle, return PID */ w32_child_handles[w32_num_children] = ProcessInformation.hProcess; - ret = w32_child_pids[w32_num_children] = ProcessInformation.dwProcessId; + w32_child_pids[w32_num_children] = ProcessInformation.dwProcessId; + ret = (int)ProcessInformation.dwProcessId; ++w32_num_children; } else { + DWORD status; WaitForSingleObject(ProcessInformation.hProcess, INFINITE); - GetExitCodeProcess(ProcessInformation.hProcess, &ret); + GetExitCodeProcess(ProcessInformation.hProcess, &status); + ret = (int)status; CloseHandle(ProcessInformation.hProcess); } @@ -2645,7 +2653,7 @@ RETVAL: PerlEnv_free_childdir(dir); Safefree(cmd); Safefree(fullcmd); - return (int)ret; + return ret; #endif } diff --git a/x2p/walk.c b/x2p/walk.c index 34361abc0c..3344688117 100644 --- a/x2p/walk.c +++ b/x2p/walk.c @@ -863,7 +863,7 @@ sub Pick {\n\ str_scat(tmp3str,tmp2str); str_cat(tmp3str,").'\"') =~ s/&/\\$&/g, "); str_set(tmp2str,"eval $s_"); - s = (*s == 'g' ? "ge" : "e"); + s = (char*)(*s == 'g' ? "ge" : "e"); i++; } type = ops[ops[node+1].ival].ival; @@ -1219,7 +1219,7 @@ sub Pick {\n\ } tmpstr = walk(1+(type==OPRINT),level,ops[node+1].ival,&numarg,P_MIN); if (!*tmpstr->str_ptr && lval_field) { - t = saw_OFS ? "$," : "' '"; + t = (char*)(saw_OFS ? "$," : "' '"); if (split_to_array) { sprintf(tokenbuf,"join(%s,@Fld)",t); str_cat(tmpstr,tokenbuf); @@ -1295,7 +1295,7 @@ sub Pick {\n\ tmpstr = str_new(0); if (!tmpstr->str_ptr || !*tmpstr->str_ptr) { if (lval_field) { - t = saw_OFS ? "$," : "' '"; + t = (char*)(saw_OFS ? "$," : "' '"); if (split_to_array) { sprintf(tokenbuf,"join(%s,@Fld)",t); str_cat(tmpstr,tokenbuf); |