diff options
| author | Nick Ing-Simmons <nik@tiuk.ti.com> | 2001-03-01 23:25:30 +0000 |
|---|---|---|
| committer | Nick Ing-Simmons <nik@tiuk.ti.com> | 2001-03-01 23:25:30 +0000 |
| commit | 0c1d5eeb2119d0fea75cdbf9cbe912379684c13b (patch) | |
| tree | 1d8103683ceca52c0fb9c70c9d08e8f5afc51042 | |
| parent | f39fb8cc9d88ca007aab35d5a7373417b639dd74 (diff) | |
| parent | 207e3d1a90c36a3515e39bab07091689f949bfbe (diff) | |
| download | perl-0c1d5eeb2119d0fea75cdbf9cbe912379684c13b.tar.gz | |
Integrate mainline.
p4raw-id: //depot/perlio@8976
54 files changed, 1080 insertions, 758 deletions
@@ -391,7 +391,7 @@ Nick Gianniotis Nick Ing-Simmons <nick@ing-simmons.net> Norbert Pueschel <pueschel@imsdd.meb.uni-bonn.de> Norton T. Allen <allen@huarp.harvard.edu> -Olaf Flebbe <o.flebbe@gmx.de> +Olaf Flebbe <o.flebbe@science-computing.de> Olaf Titz <olaf@bigred.inka.de> Ollivier Robert <roberto@keltia.freenix.fr> Owen Taylor <owt1@cornell.edu> @@ -32,6 +32,151 @@ Version v5.7.1 Development release working toward v5.8 -------------- ____________________________________________________________________________ +[ 8956] By: jhi on 2001/02/27 06:12:11 + Log: Subject: [perl-current] EPOC + From: Olaf Flebbe <O.Flebbe@science-computing.de> + Date: Mon, 26 Feb 2001 23:34:36 +0100 (CET) + Message-ID: <Pine.LNX.4.02.10102262333490.3781-100000@milkyway.science-computing.de> + Branch: perl + ! AUTHORS README.epoc epoc/createpkg.pl epoc/epoc.c + ! epoc/epocish.c epoc/epocish.h pp_sys.c +____________________________________________________________________________ +[ 8955] By: jhi on 2001/02/27 05:59:50 + Log: Subject: Re: Compile with perlcc.. + From: Edward Peschko <edwardp@excitehome.net> + Date: Mon, 26 Feb 2001 18:51:58 -0800 + Message-ID: <20010226185158.A9871@excitehome.net> + + plus add a simple usage message if no arguments given. + Branch: perl + ! lib/Test/Harness.pm pod/Makefile.SH t/TEST t/harness + ! utils/Makefile utils/perlcc.PL win32/pod.mak +____________________________________________________________________________ +[ 8954] By: nick on 2001/02/26 21:02:59 + Log: Integrate mainline + Branch: perlio + !> README.bs2000 ext/Encode/compile lib/Test.pm op.c perlio.c + !> pod/perlguts.pod pod/perlop.pod pp_ctl.c run.c t/op/bop.t + !> t/op/sprintf.t +____________________________________________________________________________ +[ 8953] By: jhi on 2001/02/26 14:43:54 + Log: Subject: Documenting coderef @INC (Re: CPAN "make this script work" feature) + From: Nicholas Clark <nick@ccl4.org> + Date: Mon, 26 Feb 2001 00:42:07 +0000 + Message-ID: <20010226004207.F23333@plum.flirble.org> + Branch: perl + ! pp_ctl.c +____________________________________________________________________________ +[ 8952] By: jhi on 2001/02/26 14:42:13 + Log: Subject: [PATCH] XPUSH[insp] was Re: progress + From: Simon Cozens <simon@netthink.co.uk> + Date: Mon, 26 Feb 2001 12:23:48 +0000 + Message-ID: <20010226122348.A25536@pembro26.pmb.ox.ac.uk> + Branch: perl + ! pod/perlguts.pod +____________________________________________________________________________ +[ 8951] By: jhi on 2001/02/26 14:39:15 + Log: Subject: [PATCH] perlio - unknown layer + From: Nicholas Clark <nick@ccl4.org> + Date: Mon, 26 Feb 2001 00:27:19 +0000 + Message-ID: <20010226002719.E23333@plum.flirble.org> + Branch: perl + ! perlio.c +____________________________________________________________________________ +[ 8950] By: jhi on 2001/02/26 14:38:04 + Log: Subject: PATCH: extra tests to check on negative float to unsigned cast + From: Jeff Okamoto <okamoto@xfiles.corp.hp.com> + Message-Id: <200102232128.NAA28938@xfiles.corp.hp.com> + Date: Fri, 23 Feb 2001 13:28:33 -0800 (PST) + Branch: perl + ! t/op/bop.t +____________________________________________________________________________ +[ 8949] By: jhi on 2001/02/26 14:37:07 + Log: Subject: Re: [PATCH: perl 5.005_03] Record I/O fix for Test.pm in older perl + From: Peter Prymmer <pvhp@forte.com> + Date: Fri, 23 Feb 2001 10:51:37 -0800 (PST) + Message-ID: <Pine.OSF.4.10.10102231042010.79050-100000@aspara.forte.com> + Branch: perl + ! lib/Test.pm +____________________________________________________________________________ +[ 8948] By: jhi on 2001/02/26 14:35:53 + Log: Subject: [PATCH: perl@8890] small fix in pod/perlop.pod + From: Radu Greab <radu@netsoft.ro> + Date: Fri, 23 Feb 2001 18:50:48 +0200 (EET) + Message-ID: <14998.38120.623015.916165@ix.netsoft.ro> + Branch: perl + ! pod/perlop.pod +____________________________________________________________________________ +[ 8947] By: jhi on 2001/02/26 14:34:46 + Log: Subject: [PATCH: perl@8935] -Dt padsv($var) + From: David Mitchell <davem@fdgroup.co.uk> + Date: Mon, 26 Feb 2001 11:01:24 +0000 (GMT) + Message-Id: <200102261101.LAA12915@tiree.fdgroup.co.uk> + Branch: perl + ! run.c +____________________________________________________________________________ +[ 8946] By: jhi on 2001/02/26 14:32:37 + Log: Subject: Modified README.bs2000 + From: Dorner Thomas <Thomas.Dorner@start.de> + Date: Mon, 26 Feb 2001 09:22:17 +0100 + Message-ID: <6727B1DACFCDD311A757009027CA8D69010A889D@Ex02.inhouse.start.de> + Branch: perl + ! README.bs2000 +____________________________________________________________________________ +[ 8945] By: jhi on 2001/02/26 14:19:53 + Log: Integrate the t/op/sprintf.t parts of #7909 and #8944 from mainline + to maintperl, listing the known failures on the tests 129 and 130. + Branch: maint-5.6/perl + !> t/op/sprintf.t +____________________________________________________________________________ +[ 8944] By: jhi on 2001/02/26 14:14:15 + Log: Add more known sprintf failures. + Branch: perl + ! t/op/sprintf.t +____________________________________________________________________________ +[ 8943] By: jhi on 2001/02/26 13:56:22 + Log: perlglob.exe needs to be found in Win32, patch from + Vadim Konovalov. Nick I-S comments: "Perhaps a lingering glob() + which needs external glob at mini-perl time." + Branch: perl + ! ext/Encode/compile +____________________________________________________________________________ +[ 8942] By: jhi on 2001/02/26 13:52:19 + Log: A missing dTHX from Vadim Konovalov. + Branch: perl + ! perlio.c +____________________________________________________________________________ +[ 8941] By: jhi on 2001/02/26 13:37:05 + Log: Miscommunication at #8914: #8902 was okay, #8881 was to be retracted. + Branch: perl + ! op.c +____________________________________________________________________________ +[ 8940] By: jhi on 2001/02/26 13:35:40 + Log: Integrate perlio. + Branch: perl + !> ext/Encode/Encode.pm +____________________________________________________________________________ +[ 8939] By: nick on 2001/02/25 23:47:09 + Log: Integrate mainline. + Branch: perlio + !> Changes lib/Pod/Find.pm patchlevel.h perl.h regcomp.c + !> t/op/pat.t t/op/tr.t t/pod/find.t toke.c utf8.c +____________________________________________________________________________ +[ 8938] By: nick on 2001/02/25 19:36:28 + Log: Encode implementations docs. + Branch: perlio + ! ext/Encode/Encode.pm +____________________________________________________________________________ +[ 8937] By: jhi on 2001/02/25 19:26:16 + Log: Script wasn't aligned with reality. + Branch: perl + ! t/pod/find.t +____________________________________________________________________________ +[ 8936] By: jhi on 2001/02/25 18:54:55 + Log: Update Changes. + Branch: perl + ! Changes patchlevel.h +____________________________________________________________________________ [ 8935] By: jhi on 2001/02/25 18:46:36 Log: Retract #8929,8930,8932,8933 for now. Branch: perl @@ -1596,7 +1596,6 @@ t/op/pat.t See if esoteric patterns work t/op/pos.t See if pos works t/op/push.t See if push and pop work t/op/pwent.t See if getpw*() functions work -t/op/qu.t See if qu works t/op/quotemeta.t See if quotemeta works t/op/rand.t See if rand works t/op/range.t See if .. works diff --git a/README.epoc b/README.epoc index 6c6256569d..f688b46c05 100644 --- a/README.epoc +++ b/README.epoc @@ -15,34 +15,65 @@ Perl 5 README file for the EPOC operating system. EPOC is a OS for palmtops and mobile phones. For more informations look at: http://www.symbian.com/ -This is a port of perl to EPOC. It runs on the Psion Series 5, 5mx, +This is a port of perl to EPOC. It runs on ER5 machines: Psion 5mx, 5mx Pro, Psion Revo and on the Ericson M128. I have no report about -the Psion Netbook or the S7. For information about this hardware -please refer to http://www.psion.com. +the Psion Netbook or the S7. It runs on ER3 Hardware (Series 5 +classic), too. For more information about this hardware please refer +to http://www.psion.com. + +Vendors which like to have support for their devices are free to send +me a sample. =head1 INSTALLING PERL ON EPOC -You will need ~4MB free space in order to install and run perl. +You can download a ready-to-install version from +http://www.science-computing.de/o.flebbe/perl. You may find other +versions with some CPAN modules included at this location. + +You will need at least ~4MB free space in order to install and run +perl. + +Install perl.sis on the EPOC machine. If you do not know how to do +that, consult your PsiWin documentation. + +Perl itself and its standard library is using 2.5 MB disk space. +Unicode support and some other modules are left out. (For details, +please look into epoc/createpkg.pl). If you like to use these modules, +you are free to copy them from a current perl release. -Install perl.sis on the EPOC machine (most likely a PSION Series 5, -5mx). If you do not know how to do that, you are on your own. +=head1 STARTING PERL ON EPOC -Perl itself and its standard library are using 2.5 MB disk space. I -left out unicode support modules and modules which will not work with -this version. (For details look into epoc/createpkg.pl). If you like -to use them, you are free to copy them from a current perl release. +For ER5 machines, you can get the software Perlstart +http://www.science-computing.de/o.flebbe/perl. It contains file +recognizers for files with the extension .pl and .pm. With it you can +start perl with a double click on the camel icon. Be sure to configure +the perl installation drive first. You can even provide a script with +a special commandline, if needed. -Get ESHELL from symbian: +Alternativly you can get ESHELL from symbian: http://developer.epocworld.com/downloads/progs/Eshell.zip -Now you can enter: perl -de 0 in order to run the perl debugger. If -you are leaving perl, you get into the system screen. You have to -switch back manually to ESHELL. When perl is running, you will see -a task with the name STDOUT in the task list. +Running ESHELL you can enter: perl -de 0 in order to run the perl +debugger. If you are leaving perl, you get into the system screen. You +have to switch back manually to ESHELL. When perl is running, you will +see a task with the name STDOUT in the task list. + +If you have a ER3 machine (i.e. a PSION 5), you may have to supply the +full path to the perl executable C:\system\programs\perl.exe. + +If you need to set the current directory of perl, please use the +command line switch '-x'. See L<perlrun> for details. + +=head1 STOPPING PERL ON EPOC + +You can stop a running perl process in the task list by closing the +application `STDOUT'. You cannot stop a running perl process if it has +not written anyting to stdout or stderr! Be very cautious with I/O +redirection. You will have to reboot the PDA! =head1 USING PERL ON EPOC -=head2 IO Redirection +=head2 I/O Redirection You can redirect the output with the UNIX bourne shell syntax (this is built into perl rather then eshell) For instance the following command @@ -61,12 +92,14 @@ installs perl in this special folder directory. The default drive and path are the same as folder the executable resides. The EPOC filesystem is case-preserving, not case-sensitive. -EPOC uses the ?: syntax for establishing a search order: First in C: (RAM), -then on D: (CF Card) and last in Z: (ROM). +The EPOC estdlib uses the ?: syntax for establishing a search order: +First in C: (RAM), then on D: (CF Card, if present) and last in Z: +(ROM). For instance ?:\a.txt searches for C:\a.txt, D:\a.txt (and +Z:\a.txt) -The perl @INC search path is now implemented with '?:'. Your perl -executable can now live on a different drive than the perl library or -even your scripts. +The perl @INC search path is implemented with '?:'. Your perl +executable can live on a different drive than the perl library or even +your scripts. ESHELL paths have to be written with backslashes '\', file arguments to perl with slashes '/'. Remember that I/O redirection is done @@ -74,14 +107,10 @@ internally in perl, so please use slashes for redirects. perl.exe C:/test.pl >C:/output.txt -You can automatically search for file on all EPOC drives with a ? as -the driver letter. For instance ?:\a.txt searches for C:\a.txt, -D:\b.txt (and Z:\a.txt). - =head2 Editors -A suitable text-editor can be downloaded -from symbian http://developer.epocworld.com/downloads/progs/Editor.zip +A suitable text editor can be downloaded from symbian + http://developer.epocworld.com/downloads/progs/Editor.zip =head2 Features @@ -124,12 +153,11 @@ one) See PATH. =item * -You need the shell eshell.exe in order to run perl.exe and supply -it with arguments. +Heap is limited to 4MB. =item * -Heap is limited to 4MB. +Dynamic loading is not implemented. =back @@ -150,12 +178,8 @@ http://www.science-computing.de/o.flebbe/sdk =item * -You may have to adjust config.sh (cc, cppflags) for your epoc -install location. - -=item * - -You may have to adjust config.sh for your cross SDK location +You may have to adjust config.sh (cc, cppflags) to reflect your epoc +and SDK location. =item * @@ -167,13 +191,16 @@ Unpack the sources. =item * -Build a native perl from this sources... +Build a native perl from this sources... Make sure to save the +miniperl executable as miniperl.native. + +Start again from scratch cp epoc/* . ./Configure -S - make perl.a + make cp miniperl.native miniperl - make perl + make make ext/Errno/pm_to_blib perl link.pl perlmain.o lib/auto/DynaLoader/DynaLoader.a \ lib/auto/Data/Dumper/Dumper.a \ @@ -194,11 +221,11 @@ guarantee I'll be able to answer them. =head1 AUTHOR -Olaf Flebbe <o.flebbe@gmx.de> -http://members.linuxstart.com/~oflebbe/perl/perl5.html +Olaf Flebbe <o.flebbe@science-computing.de> +http://www.science-computing.de/o.flebbe/perl/ =head1 LAST UPDATE -2000-09-18 +2001-02-26 =cut diff --git a/configure.com b/configure.com index 29339ec2ad..c27adaf41d 100644 --- a/configure.com +++ b/configure.com @@ -30,8 +30,6 @@ $! with much valuable help from Charles Bailey & $! the whole VMSPerl crew. $! Extended and messed about with by Dan Sugalski $! -$ sav_ver = F$VERIFY(0) -$! $! VMS-isms we will need: $ echo = "write sys$output " $ cat = "type" @@ -135,9 +133,7 @@ $ silent="" $ extractsh="" $ override="" $ knowitall="" -$ Using_Dec_C = "n" -$ Using_Gnu_C = "n" -$ using_cxx = "n" +$ ccname="VAX" $ Dec_C_Version = "" $ cxxversion = "" $ use_threads = "F" @@ -362,7 +358,8 @@ $! $Shut_up: $ IF F$Mode() .eqs. "BATCH" $ THEN -$ STDOUT = F$GetQuI("DISPLAY_JOB","LOG_SPECIFICATION",,"THIS_JOB") +$ STDOUT = F$PARSE(F$GETQUI("DISPLAY_ENTRY", "JOB_NAME"), - + F$GETQUI("DISPLAY_ENTRY", "LOG_SPECIFICATION"), ".LOG") $ WRITE SYS$OUTPUT "Warning: Executing in batch mode. To avoid file locking conflicts," $ WRITE SYS$OUTPUT "output intended for SYS$OUTPUT will be sent to a new version" $ WRITE SYS$OUTPUT STDOUT @@ -1613,13 +1610,14 @@ $ Mcc = ans $ IF (F$LOCATE("dec",ans).NE.F$LENGTH(ans)).or.(F$LOCATE("compaq",ans).NE.F$LENGTH(ans)) $ THEN $ Mcc = "cc/decc" -$ Using_Dec_C := Y +$! CPQ ? +$ ccname := DEC $ C_COMPILER_Replace = "CC=cc=''Mcc'" $ ENDIF $ IF F$LOCATE("cxx",F$EDIT(ans,"COLLAPSE,LOWERCASE")) .NE. F$LENGTH(ans) $ THEN $ Mcc = "cxx" -$ using_cxx := Y +$ ccname := CXX $ ld = ld_try $ C_COMPILER_Replace = "CC=cc=''Mcc'" $ ELSE ! Not_cxx @@ -1630,12 +1628,12 @@ $ IF F$LOCATE("dec",dflt) .NE. F$LENGTH(dflt) .or. - $ THEN $ C_COMPILER_Replace = "CC=cc=''Mcc'" $ ELSE -$ Using_Dec_C := Y +$ ccname := DEC $ ENDIF $ ELSE $ IF Mcc .EQS. "cc/decc" $ THEN -$ Using_Dec_C := Y +$ ccname := DEC $ C_COMPILER_Replace = "CC=cc=''Mcc'" $ ENDIF $ ENDIF @@ -1644,18 +1642,18 @@ $ ELSE $ Mcc = dflt $ IF Mcc .EQS. "cc/decc" $ THEN -$ Using_Dec_C := Y +$ ccname := DEC $ C_COMPILER_Replace = "CC=cc=''Mcc'" $ ENDIF $ IF Mcc .EQS. "gcc" $ THEN -$ Using_Gnu_C := Y +$ ccname := GCC $ C_COMPILER_Replace = "CC=cc=''Mcc'" $ ENDIF $ ENDIF $Decc_Version_check: $ ccversion="" -$ IF Using_Dec_C +$ IF ccname .EQS. "DEC" $ THEN $ echo "" $ echo4 "Checking for the Dec C version number..." @@ -1708,7 +1706,7 @@ $ DELETE/NOLOG/NOCONFIRM deccvers.*; $ ENDIF $Gcc_check: $ gccversion = "" -$ IF Using_Gnu_C +$ IF ccname .EQS. "GCC" $ THEN $ vaxcrtl_olb = F$SEARCH("SYS$LIBRARY:VAXCRTL.OLB") $ vaxcrtl_exe = F$SEARCH("SYS$SHARE:VAXCRTL.EXE") @@ -1815,14 +1813,14 @@ $ GOTO Host_name $ ELSE $ echo "You are using GNU cc ''line'" $ gccversion = line -$ Using_Gnu_C := Y +$ ccname := "GCC" $ C_COMPILER_Replace = "CC=cc=''Mcc'" $ GOTO Include_dirs $ ENDIF $ ENDIF $ ENDIF $Cxx_Version_check: -$ IF using_cxx +$ IF ccname .EQS. "CXX" $ THEN $ OPEN/WRITE CONFIG cxxvers.c $ WRITE CONFIG "#include <stdio.h>" @@ -1987,12 +1985,15 @@ is most probably close to the reality but may not be valid from outside your organization... $ EOD $ ENDIF -$ dflt = "''cf_by'@''myhostname'"+"''mydomain'" -$ rp = "What is your e-mail address? [''dflt'] " -$ GOSUB myread -$ IF ans .nes. "" -$ THEN cf_email = ans -$ ELSE cf_email = dflt +$ IF F$TYPE(cf_email) .EQS. "" +$ THEN +$ dflt = "''cf_by'@''myhostname'"+"''mydomain'" +$ rp = "What is your e-mail address? [''dflt'] " +$ GOSUB myread +$ IF ans .nes. "" +$ THEN cf_email = ans +$ ELSE cf_email = dflt +$ ENDIF $ ENDIF $! $ IF .NOT.silent @@ -2047,7 +2048,8 @@ $ echo4 "Hmm... Looks like you have SOCKETSHR Berkeley networking support." $ ELSE $ Has_socketshr = "F" $ ENDIF -$ IF (Dec_C_Version .GE. 50200000) .or. using_cxx +$ IF (ccname .EQS. "DEC" .AND. Dec_C_Version .GE. 50200000) .OR. - + (ccname .EQS. "CXX") $ THEN $ Has_Dec_C_Sockets = "T" $ echo "" @@ -2183,7 +2185,7 @@ $ ENDIF $ ENDIF ! AXP && >= 7.1 $! $! Ask about threads, if appropriate -$ IF Using_Dec_C .OR. using_cxx +$ IF ccname .EQS. "DEC" .OR. ccname .EQS. "CXX" $ THEN $ echo "" $ echo "This version of Perl can be built with threads. While really nifty," @@ -2391,7 +2393,7 @@ $ echo "" $ echo "Which modules do you want to build into perl?" $! we need to add Byteloader to this list: $ dflt = "re Fcntl Encode Errno File::Glob Filter::Util::Call IO Opcode Devel::Peek Devel::DProf Data::Dumper attrs VMS::Stdio VMS::DCLsym B SDBM_File Storable Thread Sys::Hostname" -$ IF Using_Dec_C .OR. using_cxx +$ IF ccname .EQS. "DEC" .OR. ccname .EQS. "CXX" $ THEN $ dflt = dflt + " POSIX" $ ENDIF @@ -2708,11 +2710,11 @@ $ vms_ver = F$EXTRACT(1,3, osvers) $ IF F$LENGTH(Mcc) .EQ. 0 THEN Mcc := "cc" $ MCC = f$edit(mcc, "UPCASE") $ C_Compiler_Replace := "CC=CC=''Mcc'''ccflags'" -$ IF Using_Dec_C +$ IF ccname .EQS. "DEC" $ THEN $ Checkcc := "''Mcc'/prefix=all" $ ELSE -$ IF using_cxx +$ IF ccname .EQS. "CXX" $ THEN $ Checkcc := cxx $ ELSE @@ -2739,6 +2741,7 @@ $ THEN $ use64bitint = "define" $ uselargefiles = "define" $ uselongdouble = "define" +$ alignbytes="16" $ usemorebits = "define" $ ELSE $ use64bitint = "undef" @@ -2797,7 +2800,7 @@ $ libs="SYS$SHARE:CMA$LIB_SHR.EXE/SHARE SYS$SHARE:CMA$RTL.EXE/SHARE SYS$SHARE: $ ELSE $ libs=" " $ ENDIF -$ IF Using_Dec_C .OR. using_cxx +$ IF ccname .EQS. "DEC" .OR. ccname .EQS. "CXX" $ THEN $ libc="(DECCRTL)" $ ELSE @@ -2916,7 +2919,7 @@ $ CS := "close CONFIG" $ DS := "delete/nolog/noconfirm []try.*;*" $ Needs_Opt := N $ good_compile = %X10B90001 -$ IF Using_Gnu_C +$ IF ccname .EQS. "GCC" $ THEN $ open/write OPTCHAN []try.opt $ write OPTCHAN "Gnu_CC:[000000]gcclib.olb/library" @@ -2925,7 +2928,7 @@ $ Close OPTCHAN $ Needs_Opt := Y $ good_compile = %X10000001 $ ENDIF -$ IF using_cxx +$ IF ccname .EQS. "CXX" $ THEN $ good_compile = %X15F60001 $ ENDIF @@ -4478,7 +4481,7 @@ $ IF F$SEARCH("try.obj").NES."" THEN DELETE/NOLOG/NOCONFIRM try.obj;* $ IF F$SEARCH("try.exe").NES."" THEN DELETE/NOLOG/NOCONFIRM try.exe;* $ IF F$SEARCH("try.opt").NES."" THEN DELETE/NOLOG/NOCONFIRM try.opt;* $ IF F$SEARCH("try.out").NES."" THEN DELETE/NOLOG/NOCONFIRM try.out;* -$ IF using_cxx +$ IF ccname .EQS. "CXX" $ THEN $ CALL Cxx_demangler_cleanup $ ENDIF @@ -4486,7 +4489,7 @@ $! $! Some that are compiler or VMS version sensitive $! $! Gnu C stuff -$ IF Using_Gnu_C +$ IF ccname .EQS. "GCC" $ THEN $ d_attribut="define" $ vms_cc_type="gcc" @@ -4496,7 +4499,8 @@ $ d_attribut="undef" $ ENDIF $! $! Dec C >= 5.2 and VMS ver >= 7.0 -$ IF (Using_Dec_C).AND.(F$INTEGER(Dec_C_Version).GE.50200000).AND.(vms_ver .GES. "7.0") +$ IF (ccname .EQS. "DEC") .AND. - + (F$INTEGER(Dec_C_Version).GE.50200000) .AND. (vms_ver .GES. "7.0") $ THEN $ d_bcmp="define" $ d_gettimeod="define" @@ -4546,8 +4550,15 @@ $ d_sysconf="undef" $ d_sigsetjmp="undef" $ ENDIF $! +$ IF d_gethname .EQS. "undef" .AND. d_uname .EQS. "undef" +$ THEN +$ d_phostname="define" +$ ELSE +$ d_phostname="undef" +$ ENDIF +$! $! Dec C alone -$ IF Using_Dec_C +$ IF ccname .EQS. "DEC" $ THEN $ d_mbstowcs="define" $ d_mbtowc="define" @@ -4608,7 +4619,7 @@ $ d_gethostprotos="define" $ d_getnetprotos="define" $ d_getprotoprotos="define" $ d_getservprotos="define" -$ IF Using_Dec_C .OR. using_cxx +$ IF ccname .EQS. "DEC" .OR. ccname .EQS. "CXX" $ THEN $ socksizetype="unsigned int" $ ELSE @@ -4795,7 +4806,7 @@ $ ivdformat="""ld""" $ uvuformat="""lu""" $ uvoformat="""lo""" $ uvxformat="""lx""" -$ uvxuformat="""lX""" +$ uvXUformat="""lX""" $! uselongdouble? $ nveformat="""e""" $ nvfformat="""f""" @@ -4805,12 +4816,12 @@ $! Finally the composite ones. All config $! $ myuname="''osname' ''myname' ''osvers' ''F$EDIT(hwname, "TRIM")'" $! -$ IF Using_Dec_C .AND. (.NOT. using_cxx) +$ IF ccname .EQS. "DEC" $ THEN $ ccflags="/Include=[]/Standard=Relaxed_ANSI/Prefix=All/Obj=''obj_ext'/NoList''ccflags'" $ ENDIF $ i_dirent = "undef" -$ IF using_cxx +$ IF ccname .EQS. "CXX" $ THEN $ i_dirent = "define" $ ccflags="/Include=[]/Standard=ANSI/Prefix=All/Obj=''obj_ext'/NoList''ccflags'" @@ -4847,13 +4858,13 @@ $ WC "" $ WC "CONFIG='true'" $ WC "Makefile_SH='" + Makefile_SH + "'" $ WC "Mcc='" + Mcc + "'" -$ WC "PERL_REVISION=" + revision -$ WC "PERL_VERSION=" + patchlevel -$ WC "PERL_SUBVERSION=" + subversion -$ WC "PERL_API_VERSION=" + api_version -$ WC "PERL_API_SUBVERSION=" + api_subversion +$ WC "PERL_REVISION='" + revision + "'" +$ WC "PERL_VERSION='" + patchlevel + "'" +$ WC "PERL_SUBVERSION='" + subversion + "'" +$ WC "PERL_API_VERSION='" + api_version + "'" +$ WC "PERL_API_SUBVERSION='" + api_subversion + "'" $ WC "alignbytes='" + alignbytes + "'" -$ WC "aphostname='" + "'" +$ WC "aphostname='write sys$output f$edit(f$getsyi(\""SCSNODE\""),\""TRIM,LOWERCASE\"")'" $ WC "ar='" + "'" $ WC "archlib='" + archlib + "'" $ WC "archlibexp='" + archlibexp + "'" @@ -4868,6 +4879,7 @@ $ WC "cc='" + perl_cc + "'" $ WC "cccdlflags='" + cccdlflags + "'" $ WC "ccdlflags='" + ccdlflags + "'" $ WC "ccflags='" + ccflags + "'" +$ WC "ccname='" + ccname + "'" $ WC "ccversion='" + ccversion + "'" $ WC "cf_by='" + cf_by + "'" $ WC "cf_email='" + cf_email + "'" @@ -5053,7 +5065,7 @@ $ WC "d_open3='define'" $ WC "d_pathconf='" + d_pathconf + "'" $ WC "d_pause='define'" $ WC "d_perl_otherlibdirs='undef'" -$ WC "d_phostname='undef'" +$ WC "d_phostname='" + d_phostname + "'" $ WC "d_pipe='define'" $ WC "d_poll='undef'" $ WC "d_pthread_yield='" + d_pthread_yield + "'" @@ -5078,7 +5090,7 @@ $ WC "d_rmdir='define'" $ WC "d_safebcpy='undef'" $ WC "d_safemcpy='define'" $ WC "d_sanemcmp='define'" -$ WC "d_sbrkproto='undef'" +$ WC "d_sbrkproto='define'" $ WC "d_sched_yield='" + d_sched_yield + "'" $ WC "d_scm_rights='undef'" $ WC "d_seekdir='define'" @@ -5390,7 +5402,7 @@ $ WC "seedfunc='" + seedfunc + "'" $ WC "selectminbits='32'" $ WC "selecttype='" + selecttype + "'" $ WC "sh='MCR'" -$ WC "shmattype='" + "'" +$ WC "shmattype='" + " '" $ WC "shortsize='" + shortsize + "'" $ WC "shrplib='define'" $ WC "sig_name='" + sig_name + "'" @@ -5457,7 +5469,7 @@ $ WC "uvsize='" + uvsize + "'" $ WC "uvtype='" + uvtype + "'" $ WC "uvuformat='" + uvuformat + "'" $ WC "uvxformat='" + uvxformat + "'" -$ WC "uvxuformat='" + uvxuformat + "'" +$ WC "uvXUformat='" + uvXUformat + "'" $ WC "vendorarchexp='" + "'" $ WC "vendorlib_stem='" + "'" $ WC "vendorlibexp='" + "'" @@ -5480,7 +5492,7 @@ $ 'Perl_CC' munchconfig.c $ IF Needs_Opt $ THEN $ OPEN/WRITE CONFIG []munchconfig.opt -$ IF Using_Gnu_C +$ IF ccname .EQS. "GCC" $ THEN $ WRITE CONFIG "Gnu_CC:[000000]gcclib.olb/library" $ ENDIF @@ -5493,7 +5505,7 @@ $ 'ld' munchconfig.obj $ ENDIF $ IF F$SEARCH("munchconfig.obj") .NES. "" THEN DELETE/NOLOG/NOCONFIRM munchconfig.obj; $ IF F$SEARCH("munchconfig.c") .NES. "" THEN DELETE/NOLOG/NOCONFIRM munchconfig.c; -$ IF using_cxx +$ IF ccname .EQS. "CXX" $ THEN $ CALL Cxx_demangler_cleanup $ ENDIF @@ -5543,7 +5555,7 @@ $ IF use_two_pot_malloc THEN WC "#define TWO_POT_OPTIMIZE" $ IF mymalloc THEN WC "#define EMBEDMYMALLOC" $ IF use_pack_malloc THEN WC "#define PACK_MALLOC" $ IF use_debugmalloc THEN WC "#define DEBUGGING_MSTATS" -$ IF Using_Gnu_C THEN WC "#define GNUC_ATTRIBUTE_CHECK" +$ IF ccname .EQS. "GCC" THEN WC "#define GNUC_ATTRIBUTE_CHECK" $ IF (Has_Dec_C_Sockets) $ THEN $ WC "#define VMS_DO_SOCKETS" @@ -5581,19 +5593,19 @@ $ DELETE/NOLOG [-]CONFIG.MAIN;* $ DELETE/NOLOG [-]CONFIG.LOCAL;* $ DELETE/NOLOG [-]CONFIG.FDL;* $! -$ IF Using_Dec_C +$ IF ccname .EQS. "DEC" $ THEN $ DECC_REPLACE = "DECC=decc=1" $ ELSE $ DECC_REPLACE = "DECC=" $ ENDIF -$ IF using_cxx +$ IF ccname .EQS. "CXX" $ THEN $ DECCXX_REPLACE = "DECCXX=DECCXX=1" $ ELSE $ DECCXX_REPLACE = "DECCXX=" $ ENDIF -$ IF Using_Gnu_C +$ IF ccname .EQS. "GCC" $ THEN $ GNUC_REPLACE = "GNUC=gnuc=1" $ ELSE @@ -5695,6 +5707,49 @@ $ Exit sts $!-- make_ext.com $EndOfTpl$ $! +$! Note that the /key qualifier to search, as in: +$! search README.* "=head"/key=(position=1)/window=0/output=extra.pods +$! is not supported on VMS V5.5-2, hence not used in extra_pods.com. +$! +$ echo4 "Extracting extra_pods.com (without variable substitutions)" +$ Create Sys$Disk:[-]extra_pods.com +$ Deck/Dollar="$EOExtra_Pods$" +$!++ extra_pods.com +$! NOTE: This file is extracted as part of the VMS configuration process. +$! Any changes made to it directly will be lost. If you need to make any +$! changes, please edit the template in Configure.Com instead. +$! Use FORCE if you've just podified a README.* file on VMS. +$ if f$search("extra.pods") .eqs. "" .or. P1 .eqs. "FORCE" then - + search README.* "=head"/window=0/output=extra.pods +$ open/read/error=extra_close EXTRA extra.pods +$extra_loop: +$ read/error=extra_close/END_OF_FILE=extra_close EXTRA file +$ file_type = f$parse(file,,,"TYPE",) - "." +$ if file_type .nes. "VMS" .and. file_type .nes. "vms" +$ then +$ pod_file = "[.pod]perl''file_type'.pod" +$ file = file - "''f$parse(file,,,"VERSION",)'" +$ if p1 .eqs. "CLEAN" +$ then if f$search(pod_file) .nes. "" then delete/log 'pod_file';* +$ else +$ do_copy := false +$ if f$search(pod_file) .eqs. "" +$ then do_copy := true +$ else +$ file_rdt = f$cvtime(f$file_attributes(file,"RDT")) +$ pod_file_rdt = f$cvtime(f$file_attributes(pod_file,"RDT")) +$ if file_rdt .GTS. pod_file_rdt then do_copy := true +$ endif +$ if do_copy then copy/log/noconfirm 'file' 'pod_file' +$ endif +$ endif +$ goto extra_loop +$extra_close: +$ close EXTRA +$ if p1 .eqs. "CLEAN" .and. f$search("extra.pods;-1") .nes. "" then - + purge/nolog extra.pods +$!-- extra_pods.com +$EOExtra_Pods$ $! $! Warn of dangerous symbols or logical names $! @@ -5937,8 +5992,8 @@ $ THEN $ DEASSIGN SYS$OUTPUT $! DEASSIGN SYS$ERROR $ ENDIF -$ IF F$GETJPI("","FILCNT").NE.vms_filcnt THEN CLOSE CONFIG -$ IF F$GETJPI("","FILCNT").NE.vms_filcnt +$ IF F$GETJPI("","FILCNT").GT.vms_filcnt THEN CLOSE CONFIG +$ IF F$GETJPI("","FILCNT").GT.vms_filcnt $ THEN WRITE SYS$ERROR "%Config-W-VMS, WARNING: There is a file still open" $ ENDIF $ dflt = F$ENVIRONMENT("DEFAULT") @@ -5950,6 +6005,5 @@ $ SET PROTECTION=(SYSTEM:RWED,OWNER:RWED) UU.DIR $ DELETE/NOLOG/NOCONFIRM UU.DIR; $ ENDIF $ SET DEFAULT 'vms_default_directory_name' !be kind rewind -$ STOP $ EXIT $!: End of Configure @@ -500,7 +500,7 @@ typedef struct stackinfo PERL_SI; * PUTBACK/SPAGAIN to flush/refresh any local SP that may be active */ #define POPSTACK \ STMT_START { \ - djSP; \ + dSP; \ PERL_SI *prev = PL_curstackinfo->si_prev; \ if (!prev) { \ PerlIO_printf(Perl_error_log, "panic: POPSTACK\n"); \ @@ -1190,7 +1190,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) I32 Perl_my_stat(pTHX) { - djSP; + dSP; IO *io; GV* gv; @@ -1243,7 +1243,7 @@ Perl_my_stat(pTHX) I32 Perl_my_lstat(pTHX) { - djSP; + dSP; SV *sv; STRLEN n_a; if (PL_op->op_flags & OPf_REF) { @@ -1195,7 +1195,7 @@ finish: OP * Perl_do_kv(pTHX) { - djSP; + dSP; HV *hv = (HV*)POPs; HV *keys; register HE *entry; @@ -29,6 +29,7 @@ sub walk_table (&@) { $F = $filename; } else { + unlink $filename; open F, ">$filename" or die "Can't open $filename: $!"; $F = \*F; } diff --git a/epoc/createpkg.pl b/epoc/createpkg.pl index 65a881f43f..5ce70fc92c 100644 --- a/epoc/createpkg.pl +++ b/epoc/createpkg.pl @@ -4,8 +4,8 @@ use File::Find; use Cwd; $VERSION="5.7"; -$PATCH="0"; -$EPOC_VERSION=24; +$PATCH="1"; +$EPOC_VERSION=27; $CROSSCOMPILEPATH=cwd; $CROSSREPLACEPATH="H:\\perl"; @@ -13,7 +13,7 @@ $CROSSREPLACEPATH="H:\\perl"; sub filefound { my $f = $File::Find::name; - return if ( $f =~ /CVS|unicode|CPAN|ExtUtils|IPC|User|DB.pm|\.a$|\.ld$|\.exists$/i); + return if ( $f =~ /CVS|unicode|CPAN|ExtUtils|IPC|User|DB.pm|\.a$|\.ld$|\.exists$|\.pod$/i); my $back = $f; $back =~ s|$CROSSCOMPILEPATH||; @@ -31,7 +31,7 @@ sub filefound { open OUT,">perl.pkg"; print OUT "#{\"perl$VERSION\"},(0x100051d8),$PATCH,$EPOC_VERSION,0\n"; - +print OUT "\"$CROSSREPLACEPATH\\Artistic\"-\"\",FT,TA\n"; print OUT "\"$CROSSREPLACEPATH\\perlmain.exe\"-\"!:\\system\\programs\\perl.exe\"\n"; find(\&filefound, cwd.'/lib'); diff --git a/epoc/epoc.c b/epoc/epoc.c index b9bc652c22..6652ef0ce1 100644 --- a/epoc/epoc.c +++ b/epoc/epoc.c @@ -17,6 +17,10 @@ Perl_epoc_init(int *argcp, char ***argvp) { int truecount=0; char **lastcp = (*argvp); char *ptr; + +#if 0 + epoc_spawn_posix_server(); +#endif for (i=0; i< *argcp; i++) { if ((*argvp)[i]) { if (*((*argvp)[i]) == '<') { @@ -94,54 +98,85 @@ __fixunsdfsi (a) #include "XSUB.h" int -do_aspawn( pTHX_ SV *really,SV **mark,SV **sp) { - return do_spawn( really, mark, sp); +do_spawn( char *cmd) { + dTHXo; + char *argv0, *ptr; + char *cmdptr = cmd; + int ret; + + argv0 = ptr = malloc( strlen(cmd) + 1); + + while (*cmdptr && !isSPACE( *cmdptr)) { + *ptr = *cmdptr; + if (*ptr == '/') { + *ptr = '\\'; + } + ptr++; cmdptr++; + } + while (*cmdptr && isSPACE( *cmdptr)) { + cmdptr++; + } + *ptr = '\0'; + ret = epoc_spawn( argv0, cmdptr); + free( argv0); + return ret; } int -do_spawn (pTHX_ SV *really,SV **mark,SV **sp) -{ +do_aspawn ( void *vreally, void **vmark, void **vsp) { + + dTHXo; + + SV *really = (SV*)vreally; + SV **mark = (SV**)vmark; + SV **sp = (SV**)vsp; + + char **argv; + char *str; + char *p2, **ptr; + char *cmd, *cmdline; + + int rc; - char **a,*cmd,**ptr, *cmdline, **argv, *p2; - STRLEN n_a; - size_t len = 0; + int index = 0; + int len = 0; if (sp<=mark) return -1; - a=argv=ptr=(char**) malloc ((sp-mark+3)*sizeof (char*)); + ptr = argv =(char**) malloc ((sp-mark+3)*sizeof (char*)); while (++mark <= sp) { - if (*mark) - *a = SvPVx(*mark, n_a); + if (*mark && (str = SvPV_nolen(*mark))) + argv[index] = str; else - *a = ""; - len += strlen( *a) + 1; - a++; + argv[index] = ""; + + len += strlen(argv[ index++]) + 1; } - *a = Nullch; + argv[index++] = 0; - if (!(really && *(cmd = SvPV(really, n_a)))) { - cmd = argv[0]; - argv++; + cmd = strdup((const char*)(really ? SvPV_nolen(really) : argv[0])); + + for (p2=cmd; *p2 != '\0'; p2++) { + /* Change / to \ */ + if ( *p2 == '/') + *p2 = '\\'; } cmdline = (char * ) malloc( len + 1); cmdline[ 0] = '\0'; while (*argv != NULL) { - strcat( cmdline, *argv++); + strcat( cmdline, *ptr++); strcat( cmdline, " "); } + + free( argv); - for (p2=cmd; *p2 != '\0'; p2++) { - /* Change / to \ */ - if ( *p2 == '/') - *p2 = '\\'; - } rc = epoc_spawn( cmd, cmdline); - free( ptr); free( cmdline); - + free( cmd); + return rc; } diff --git a/epoc/epocish.c b/epoc/epocish.c index a0557cc129..a8b95972d0 100644 --- a/epoc/epocish.c +++ b/epoc/epocish.c @@ -9,31 +9,60 @@ /* This is C++ Code !! */ #include <e32std.h> +#include <stdlib.h> +#include <estlib.h> +#include <string.h> extern "C" { +#if 1 +int epoc_spawn( char *cmd, char *cmdline) { RProcess p; TRequestStatus status; TInt rc; rc = p.Create( _L( cmd), _L( cmdline)); - if (rc != KErrNone) + if (rc != KErrNone) { return -1; + } p.Resume(); p.Logon( status); User::WaitForRequest( status); + p.Kill( 0); if (status!=KErrNone) { return -1; } return 0; } +#else +int +epoc_spawn( char *cmd, char *cmdline) { + int len = strlen(cmd) + strlen(cmdline) + 4; + char *n = (char *) malloc( len); + int r; + strcpy( n, cmd); + strcat( n, " "); + strcat( n, cmdline); + r = system( n); + free( n); + return r; +} +#endif +/* Workaround for defect strtoul(). Values with leading + are zero */ + +unsigned long int epoc_strtoul(const char *nptr, char **endptr, + int base) { + if (nptr && *nptr == '+') + nptr++; + return strtoul( nptr, endptr, base); +} - /* Workaround for defect atof(), see java defect list for epoc */ - double epoc_atof( char* str) { +/* Workaround for defect atof(), see java defect list for epoc */ +double epoc_atof( char* str) { TReal64 aRes; while (TChar( *str).IsSpace()) { @@ -43,9 +72,9 @@ epoc_spawn( char *cmd, char *cmdline) { TLex lex( _L( str)); TInt err = lex.Val( aRes, TChar( '.')); return aRes; - } +} - void epoc_gcvt( double x, int digits, unsigned char *buf) { +void epoc_gcvt( double x, int digits, unsigned char *buf) { TRealFormat trel; trel.iPlaces = digits; @@ -57,3 +86,9 @@ epoc_spawn( char *cmd, char *cmdline) { result.Append( TChar( 0)); } } + +#if 0 +void epoc_spawn_posix_server() { + SpawnPosixServerThread(); +} +#endif diff --git a/epoc/epocish.h b/epoc/epocish.h index 551d1f51d7..e365fa2c25 100644 --- a/epoc/epocish.h +++ b/epoc/epocish.h @@ -138,6 +138,7 @@ double epoc_atof( const char *ptr); #define atof(a) epoc_atof(a) +#define strtoul(a,b,c) epoc_strtoul(a,b,c) #define init_os_extras Perl_init_os_extras diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm index 54fa46fb4f..50088752ab 100644 --- a/ext/B/B/C.pm +++ b/ext/B/B/C.pm @@ -1020,7 +1020,7 @@ sub output_all { static int $init_name() { dTARG; - djSP; + dSP; EOT $init->output(\*STDOUT, "\t%s\n"); print "\treturn 0;\n}\n"; @@ -1172,7 +1172,7 @@ xs_init(pTHX) { char *file = __FILE__; dTARG; - djSP; + dSP; EOT print "\n#ifdef USE_DYNAMIC_LOADING"; print qq/\n\tnewXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);/; @@ -1208,7 +1208,7 @@ dl_init(pTHX) { char *file = __FILE__; dTARG; - djSP; + dSP; EOT print("/* Dynamicboot strapping code*/\n\tSAVETMPS;\n"); print("\ttarg=sv_newmortal();\n"); diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm index c5ca2a3df5..51922eeb2b 100644 --- a/ext/B/B/CC.pm +++ b/ext/B/B/CC.pm @@ -151,7 +151,7 @@ sub init_pp { $ppname = shift; $runtime_list_ref = []; $declare_ref = {}; - runtime("djSP;"); + runtime("dSP;"); declare("I32", "oldsave"); declare("SV", "**svp"); map { declare("SV", "*$_") } qw(sv src dst left right); diff --git a/ext/Encode/Encode.pm b/ext/Encode/Encode.pm index 2d49865491..72d6cc0fcc 100644 --- a/ext/Encode/Encode.pm +++ b/ext/Encode/Encode.pm @@ -446,7 +446,7 @@ possible values it easily fits in perl's much larger "logical character". =head2 TERMINOLOGY -=over +=over 4 =item * diff --git a/hints/hpux.sh b/hints/hpux.sh index 1d59600b7c..b01d189a44 100644 --- a/hints/hpux.sh +++ b/hints/hpux.sh @@ -155,6 +155,9 @@ fi case "$use64bitall" in $define|true|[yY]*) use64bitint="$define" ;; esac +case "$usemorebits" in +$define|true|[yY]*) use64bitint="$define"; uselongdouble="$define" ;; +esac case "$use64bitint" in $define|true|[yY]*) if [ "$xxOsRevMajor" -lt 11 ]; then @@ -435,3 +438,9 @@ EOCBU # keep that leading tab. ccisgcc='' +# Until we figure out what to be probe for in Configure (ditto for irix_6.sh) +case "$use64bitint" in +$define|true|[yY]*) ;; +*) d_casti32='undef' ;; +esac + diff --git a/hints/irix_6.sh b/hints/irix_6.sh index e6117cf1af..90f4766657 100644 --- a/hints/irix_6.sh +++ b/hints/irix_6.sh @@ -334,3 +334,12 @@ EOCBU # The -n32 makes off_t to be 8 bytes, so we should have largefileness. +# Until we figure out what to be probe for in Configure (ditto for hpux.sh) +case "$usemorebits" in # Need to expand this now, then. +$define|true|[yY]*) use64bitint="$define"; uselongdouble="$define" ;; +esac +case "$use64bitint" in +$define|true|[yY]*) ;; +*) d_casti32='undef' ;; +esac + diff --git a/lib/Exporter/Heavy.pm b/lib/Exporter/Heavy.pm index 39bce2d85e..1305318678 100644 --- a/lib/Exporter/Heavy.pm +++ b/lib/Exporter/Heavy.pm @@ -21,6 +21,7 @@ Exporter::Heavy - Exporter guts No user-serviceable parts inside. =cut + # # We go to a lot of trouble not to 'require Carp' at file scope, # because Carp requires Exporter, and something has to give. diff --git a/lib/File/Spec/Epoc.pm b/lib/File/Spec/Epoc.pm index 65d5e1fcb5..23c99fbf51 100644 --- a/lib/File/Spec/Epoc.pm +++ b/lib/File/Spec/Epoc.pm @@ -24,7 +24,7 @@ This package is still work in progress ;-) o.flebbe@gmx.de -=over +=over 4 =item devnull @@ -62,6 +62,7 @@ Takes no argument, returns the environment variable PATH as an array. Since there is no search path supported, it returns undef, sorry. =cut + sub path { return undef; } diff --git a/lib/Filter/Simple.pm b/lib/Filter/Simple.pm index fa883e65bd..d5aa55afdf 100644 --- a/lib/Filter/Simple.pm +++ b/lib/Filter/Simple.pm @@ -2,7 +2,7 @@ package Filter::Simple; use vars qw{ $VERSION }; -$VERSION = '0.01'; +$VERSION = '0.50'; use Filter::Util::Call; use Carp; @@ -170,13 +170,13 @@ C<use BANG;> statement (until the next C<no BANG;> statement, if any): 1 ; -Given this level of complexity, it's perhaps not surprising that source -code filtering is still a mystery to most users. +This level of sophistication puts filtering out of the reach of +many programmers. =head2 A Solution -The Filter::Simple module provides a vastly simplified interface to +The Filter::Simple module provides a simplified interface to Filter::Util::Call; one that is sufficient for most common cases. Instead of the above process, with Filter::Simple the task of setting up diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index ab913f77bb..55a84fe066 100644 --- a/lib/Test/Harness.pm +++ b/lib/Test/Harness.pm @@ -104,7 +104,7 @@ sub _runtests { my $cmd = ($ENV{'HARNESS_COMPILE_TEST'}) ? "./perl -I../lib ../utils/perlcc $test " - . "-run 2>> ./compilelog |" + . "-r 2>> ./compilelog |" : "$^X $s $test|"; $cmd = "MCR $cmd" if $^O eq 'VMS'; open(my $fh, $cmd) or print "can't run $test. $!\n"; @@ -765,6 +765,7 @@ ignore them. not ok 2 # got 'Bush' expected 'Gore' +=back =head1 EXPORT diff --git a/lib/utf8.pm b/lib/utf8.pm index f06b893a59..f9055b5dd9 100644 --- a/lib/utf8.pm +++ b/lib/utf8.pm @@ -57,7 +57,7 @@ rather than UTF-8). Enabling the C<utf8> pragma has the following effects: -=over +=over 4 =item * @@ -79,6 +79,8 @@ of byte semantics. @chars = split //, $data; # splits characters } +=back + =head1 SEE ALSO L<perlunicode>, L<bytes> diff --git a/makedef.pl b/makedef.pl index 1065801807..dbea24afe3 100644 --- a/makedef.pl +++ b/makedef.pl @@ -466,6 +466,8 @@ unless ($define{'USE_ITHREADS'}) { Perl_sys_intern_dup Perl_ptr_table_fetch Perl_ptr_table_new + Perl_ptr_table_clear + Perl_ptr_table_free Perl_ptr_table_split Perl_ptr_table_store perl_clone diff --git a/patchlevel.h b/patchlevel.h index 75ed885e21..438e9650b0 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -70,7 +70,7 @@ #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT) static char *local_patches[] = { NULL - ,"DEVEL8935" + ,"DEVEL8956" ,NULL }; diff --git a/pod/Makefile.SH b/pod/Makefile.SH index 58ce9bea6f..51772f1424 100644 --- a/pod/Makefile.SH +++ b/pod/Makefile.SH @@ -163,6 +163,9 @@ perlmodlib.pod: $(PERL) perlmodlib.PL ../mv-if-diff sh ../mv-if-diff perlmodlib.tmp perlmodlib.pod compile: all - $(REALPERL) -I../lib ../utils/perlcc -regex 's/$$/.exe/' pod2latex pod2man pod2text checkpods -prog -verbose dcf -log ../compilelog; + $(REALPERL) -I../lib ../utils/perlcc -o pod2latex.exe pod2latex -log ../compilelog + $(REALPERL) -I../lib ../utils/perlcc -o pod2man.exe pod2man -log ../compilelog + $(REALPERL) -I../lib ../utils/perlcc -o pod2text.exe pod2text -log ../compilelog + $(REALPERL) -I../lib ../utils/perlcc -o checkpods.exe checkpods -log ../compilelog !NO!SUBS! diff --git a/pod/perlapi.pod b/pod/perlapi.pod index 7b6ad4a621..c9cff4762e 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -2368,19 +2368,19 @@ false, defined or undefined. Does not handle 'get' magic. =for hackers Found in file sv.h -=item SvTYPE - -Returns the type of the SV. See C<svtype>. +=item svtype - svtype SvTYPE(SV* sv) +An enum of flags for Perl types. These are found in the file B<sv.h> +in the C<svtype> enum. Test these flags with the C<SvTYPE> macro. =for hackers Found in file sv.h -=item svtype +=item SvTYPE -An enum of flags for Perl types. These are found in the file B<sv.h> -in the C<svtype> enum. Test these flags with the C<SvTYPE> macro. +Returns the type of the SV. See C<svtype>. + + svtype SvTYPE(SV* sv) =for hackers Found in file sv.h @@ -3143,6 +3143,20 @@ Like C<sv_usepvn>, but also handles 'set' magic. =for hackers Found in file sv.c +=item sv_utf8_decode + +Convert the octets in the PV from UTF-8 to chars. Scan for validity and then +turn of SvUTF8 if needed so that we see characters. Used as a building block +for decode_utf8 in Encode.xs + +NOTE: this function is experimental and may change or be +removed without notice. + + bool sv_utf8_decode(SV *sv) + +=for hackers +Found in file sv.c + =item sv_utf8_downgrade Attempt to convert the PV of an SV from UTF8-encoded to byte encoding. @@ -3161,10 +3175,8 @@ Found in file sv.c =item sv_utf8_encode Convert the PV of an SV to UTF8-encoded, but then turn off the C<SvUTF8> -flag so that it looks like bytes again. Nothing calls this. - -NOTE: this function is experimental and may change or be -removed without notice. +flag so that it looks like octets again. Used as a building block +for encode_utf8 in Encode.xs void sv_utf8_encode(SV *sv) @@ -3174,8 +3186,11 @@ Found in file sv.c =item sv_utf8_upgrade Convert the PV of an SV to its UTF8-encoded form. +Forces the SV to string form it it is not already. +Always sets the SvUTF8 flag to avoid future validity checks even +if all the bytes have hibit clear. - void sv_utf8_upgrade(SV *sv) + STRLEN sv_utf8_upgrade(SV *sv) =for hackers Found in file sv.c diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index c75818e04d..725b50ecd1 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -96,9 +96,8 @@ than one place. =item Functions for SCALARs or strings C<chomp>, C<chop>, C<chr>, C<crypt>, C<hex>, C<index>, C<lc>, C<lcfirst>, -C<length>, C<oct>, C<ord>, C<pack>, C<q/STRING/>, C<qq/STRING/>, C<qu/STRING/>, -C<reverse>, C<rindex>, C<sprintf>, C<substr>, C<tr///>, C<uc>, C<ucfirst>, -C<y///> +C<length>, C<oct>, C<ord>, C<pack>, C<q/STRING/>, C<qq/STRING/>, C<reverse>, +C<rindex>, C<sprintf>, C<substr>, C<tr///>, C<uc>, C<ucfirst>, C<y///> =item Regular expressions and pattern matching @@ -3463,12 +3462,10 @@ but is more efficient. Returns the new number of elements in the array. =item qr/STRING/ -=item qu/STRING/ +=item qx/STRING/ =item qw/STRING/ -=item qx/STRING/ - Generalized quotes. See L<perlop/"Regexp Quote-Like Operators">. =item quotemeta EXPR diff --git a/pod/perlhack.pod b/pod/perlhack.pod index 155773d8e5..62c80e701f 100644 --- a/pod/perlhack.pod +++ b/pod/perlhack.pod @@ -1146,7 +1146,7 @@ the code which implements the addition operator: 1 PP(pp_add) 2 { - 3 djSP; dATARGET; tryAMAGICbin(add,opASSIGN); + 3 dSP; dATARGET; tryAMAGICbin(add,opASSIGN); 4 { 5 dPOPTOPnnrl_ul; 6 SETn( left + right ); @@ -1308,7 +1308,7 @@ Lots of junk will go past as gdb reads in the relevant source files and libraries, and then: Breakpoint 1, Perl_pp_add () at pp_hot.c:309 - 309 djSP; dATARGET; tryAMAGICbin(add,opASSIGN); + 309 dSP; dATARGET; tryAMAGICbin(add,opASSIGN); (gdb) step 311 dPOPTOPnnrl_ul; (gdb) diff --git a/pod/perlop.pod b/pod/perlop.pod index 2bc889d186..8f2ecde031 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -645,7 +645,6 @@ any pair of delimiters you choose. Customary Generic Meaning Interpolates '' q{} Literal no "" qq{} Literal yes - qu{} Literal yes (UTF-8, see below) `` qx{} Command yes (unless '' is delimiter) qw{} Word list no // m{} Pattern match yes (unless '' is delimiter) @@ -1012,48 +1011,6 @@ Options are: See L<perlre> for additional information on valid syntax for STRING, and for a detailed look at the semantics of regular expressions. -=item qw/STRING/ - -Evaluates to a list of the words extracted out of STRING, using embedded -whitespace as the word delimiters. It can be understood as being roughly -equivalent to: - - split(' ', q/STRING/); - -the difference being that it generates a real list at compile time. So -this expression: - - qw(foo bar baz) - -is semantically equivalent to the list: - - 'foo', 'bar', 'baz' - -Some frequently seen examples: - - use POSIX qw( setlocale localeconv ) - @EXPORT = qw( foo bar baz ); - -A common mistake is to try to separate the words with comma or to -put comments into a multi-line C<qw>-string. For this reason, the -C<use warnings> pragma and the B<-w> switch (that is, the C<$^W> variable) -produces warnings if the STRING contains the "," or the "#" character. - -=item qu/STRING/ - -Like L<qq> but explicitly generates UTF-8 from the \0ooo, \xHH, and -\x{HH} constructs if the code point is in the 0x80..0xff range (and -of course for the 0x100.. range). - -Normally you do not need to use this because whether characters are -internally encoded in UTF-8 should be transparent, and you can just -just use qq, also known as "". - -(In qq/STRING/ the \0ooo, \xHH, and the \x{HHH...} constructs -generate bytes for the 0x80..0xff range. For the whole 0x00..0xff -range the generated bytes are host-dependent: in ISO 8859-1 they will -be ISO 8859-1, in EBCDIC they will EBCDIC, and so on.) - =item qx/STRING/ =item `STRING` @@ -1135,6 +1092,33 @@ Just understand what you're getting yourself into. See L<"I/O Operators"> for more discussion. +=item qw/STRING/ + +Evaluates to a list of the words extracted out of STRING, using embedded +whitespace as the word delimiters. It can be understood as being roughly +equivalent to: + + split(' ', q/STRING/); + +the difference being that it generates a real list at compile time. So +this expression: + + qw(foo bar baz) + +is semantically equivalent to the list: + + 'foo', 'bar', 'baz' + +Some frequently seen examples: + + use POSIX qw( setlocale localeconv ) + @EXPORT = qw( foo bar baz ); + +A common mistake is to try to separate the words with comma or to +put comments into a multi-line C<qw>-string. For this reason, the +C<use warnings> pragma and the B<-w> switch (that is, the C<$^W> variable) +produces warnings if the STRING contains the "," or the "#" character. + =item s/PATTERN/REPLACEMENT/egimosx Searches a string for a pattern, and if found, replaces that pattern diff --git a/pod/perlre.pod b/pod/perlre.pod index 02dd2cda5d..ce2b9bd952 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -179,7 +179,6 @@ In addition, Perl defines the following: \X Match eXtended Unicode "combining character sequence", equivalent to C<(?:\PM\pM*)> \C Match a single C char (octet) even under utf8. - (Currently this does not work correctly.) A C<\w> matches a single alphanumeric character or C<_>, not a whole word. Use C<\w+> to match a string of Perl-identifier characters (which isn't diff --git a/pod/perlunicode.pod b/pod/perlunicode.pod index b8bbc5707c..30a4482260 100644 --- a/pod/perlunicode.pod +++ b/pod/perlunicode.pod @@ -16,8 +16,7 @@ The following areas need further work. There is currently no easy way to mark data read from a file or other external source as being utf8. This will be one of the major areas of -focus in the near future. Unfortunately it is unlikely that the Perl -5.6 and earlier will ever gain this capability. +focus in the near future. =item Regular Expressions @@ -67,8 +66,7 @@ or from literals and constants in the source text. If the C<-C> command line switch is used, (or the ${^WIDE_SYSTEM_CALLS} global flag is set to C<1>), all system calls will use the corresponding wide character APIs. This is currently only implemented -on Windows as other platforms do not have a unified way of handling -wide character APIs. +on Windows. Regardless of the above, the C<bytes> pragma can always be used to force byte semantics in a particular lexical scope. See L<bytes>. @@ -129,7 +127,8 @@ attempt to canonicalize variable names for you.) Regular expressions match characters instead of bytes. For instance, "." matches a character instead of a byte. (However, the C<\C> pattern -is available to force a match a single byte ("C<char>" in C, hence C<\C>).) +is provided to force a match a single byte ("C<char>" in C, hence +C<\C>).) =item * @@ -217,10 +216,7 @@ And finally, C<scalar reverse()> reverses by character rather than by byte. =head2 Character encodings for input and output -This feature is in the process of getting implemented. - -(For Perl 5.6 and earlier the support is unlikely to get integrated -to the core language and some external module will be required.) +[XXX: This feature is not yet implemented.] =head1 CAVEATS @@ -92,7 +92,7 @@ extern Pid_t getpid (void); PP(pp_stub) { - djSP; + dSP; if (GIMME_V == G_SCALAR) XPUSHs(&PL_sv_undef); RETURN; @@ -107,7 +107,7 @@ PP(pp_scalar) PP(pp_padav) { - djSP; dTARGET; + dSP; dTARGET; if (PL_op->op_private & OPpLVAL_INTRO) SAVECLEARSV(PL_curpad[PL_op->op_targ]); EXTEND(SP, 1); @@ -146,7 +146,7 @@ PP(pp_padav) PP(pp_padhv) { - djSP; dTARGET; + dSP; dTARGET; I32 gimme; XPUSHs(TARG); @@ -184,7 +184,7 @@ PP(pp_padany) PP(pp_rv2gv) { - djSP; dTOPss; + dSP; dTOPss; if (SvROK(sv)) { wasref: @@ -270,7 +270,7 @@ PP(pp_rv2gv) PP(pp_rv2sv) { - djSP; dTOPss; + dSP; dTOPss; if (SvROK(sv)) { wasref: @@ -335,7 +335,7 @@ PP(pp_rv2sv) PP(pp_av2arylen) { - djSP; + dSP; AV *av = (AV*)TOPs; SV *sv = AvARYLEN(av); if (!sv) { @@ -349,7 +349,7 @@ PP(pp_av2arylen) PP(pp_pos) { - djSP; dTARGET; dPOPss; + dSP; dTARGET; dPOPss; if (PL_op->op_flags & OPf_MOD || LVRET) { if (SvTYPE(TARG) < SVt_PVLV) { @@ -385,7 +385,7 @@ PP(pp_pos) PP(pp_rv2cv) { - djSP; + dSP; GV *gv; HV *stash; @@ -410,7 +410,7 @@ PP(pp_rv2cv) PP(pp_prototype) { - djSP; + dSP; CV *cv; HV *stash; GV *gv; @@ -476,7 +476,7 @@ PP(pp_prototype) PP(pp_anoncode) { - djSP; + dSP; CV* cv = (CV*)PL_curpad[PL_op->op_targ]; if (CvCLONE(cv)) cv = (CV*)sv_2mortal((SV*)cv_clone(cv)); @@ -487,14 +487,14 @@ PP(pp_anoncode) PP(pp_srefgen) { - djSP; + dSP; *SP = refto(*SP); RETURN; } PP(pp_refgen) { - djSP; dMARK; + dSP; dMARK; if (GIMME != G_ARRAY) { if (++MARK <= SP) *MARK = *SP; @@ -544,7 +544,7 @@ S_refto(pTHX_ SV *sv) PP(pp_ref) { - djSP; dTARGET; + dSP; dTARGET; SV *sv; char *pv; @@ -564,7 +564,7 @@ PP(pp_ref) PP(pp_bless) { - djSP; + dSP; HV *stash; if (MAXARG == 1) @@ -593,7 +593,7 @@ PP(pp_gelem) SV *sv; SV *tmpRef; char *elem; - djSP; + dSP; STRLEN n_a; sv = POPs; @@ -657,7 +657,7 @@ PP(pp_gelem) PP(pp_study) { - djSP; dPOPss; + dSP; dPOPss; register unsigned char *s; register I32 pos; register I32 ch; @@ -719,7 +719,7 @@ PP(pp_study) PP(pp_trans) { - djSP; dTARG; + dSP; dTARG; SV *sv; if (PL_op->op_flags & OPf_STACKED) @@ -737,7 +737,7 @@ PP(pp_trans) PP(pp_schop) { - djSP; dTARGET; + dSP; dTARGET; do_chop(TARG, TOPs); SETTARG; RETURN; @@ -745,7 +745,7 @@ PP(pp_schop) PP(pp_chop) { - djSP; dMARK; dTARGET; + dSP; dMARK; dTARGET; while (SP > MARK) do_chop(TARG, POPs); PUSHTARG; @@ -754,14 +754,14 @@ PP(pp_chop) PP(pp_schomp) { - djSP; dTARGET; + dSP; dTARGET; SETi(do_chomp(TOPs)); RETURN; } PP(pp_chomp) { - djSP; dMARK; dTARGET; + dSP; dMARK; dTARGET; register I32 count = 0; while (SP > MARK) @@ -772,7 +772,7 @@ PP(pp_chomp) PP(pp_defined) { - djSP; + dSP; register SV* sv; sv = POPs; @@ -802,7 +802,7 @@ PP(pp_defined) PP(pp_undef) { - djSP; + dSP; SV *sv; if (!PL_op->op_private) { @@ -869,7 +869,7 @@ PP(pp_undef) PP(pp_predec) { - djSP; + dSP; if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) DIE(aTHX_ PL_no_modify); if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && @@ -886,7 +886,7 @@ PP(pp_predec) PP(pp_postinc) { - djSP; dTARGET; + dSP; dTARGET; if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) DIE(aTHX_ PL_no_modify); sv_setsv(TARG, TOPs); @@ -907,7 +907,7 @@ PP(pp_postinc) PP(pp_postdec) { - djSP; dTARGET; + dSP; dTARGET; if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) DIE(aTHX_ PL_no_modify); sv_setsv(TARG, TOPs); @@ -928,7 +928,7 @@ PP(pp_postdec) PP(pp_pow) { - djSP; dATARGET; tryAMAGICbin(pow,opASSIGN); + dSP; dATARGET; tryAMAGICbin(pow,opASSIGN); { dPOPTOPnnrl; SETn( Perl_pow( left, right) ); @@ -938,7 +938,7 @@ PP(pp_pow) PP(pp_multiply) { - djSP; dATARGET; tryAMAGICbin(mult,opASSIGN); + dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); #ifdef PERL_PRESERVE_IVUV SvIV_please(TOPs); if (SvIOK(TOPs)) { @@ -1056,7 +1056,7 @@ PP(pp_multiply) PP(pp_divide) { - djSP; dATARGET; tryAMAGICbin(div,opASSIGN); + dSP; dATARGET; tryAMAGICbin(div,opASSIGN); { dPOPPOPnnrl; NV value; @@ -1085,7 +1085,7 @@ PP(pp_divide) PP(pp_modulo) { - djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); + dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); { UV left; UV right; @@ -1185,7 +1185,7 @@ PP(pp_modulo) PP(pp_repeat) { - djSP; dATARGET; tryAMAGICbin(repeat,opASSIGN); + dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN); { register IV count = POPi; if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) { @@ -1239,7 +1239,7 @@ PP(pp_repeat) PP(pp_subtract) { - djSP; dATARGET; bool useleft; tryAMAGICbin(subtr,opASSIGN); + dSP; dATARGET; bool useleft; tryAMAGICbin(subtr,opASSIGN); useleft = USE_LEFT(TOPm1s); #ifdef PERL_PRESERVE_IVUV /* See comments in pp_add (in pp_hot.c) about Overflow, and how @@ -1356,7 +1356,7 @@ PP(pp_subtract) PP(pp_left_shift) { - djSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); + dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); { IV shift = POPi; if (PL_op->op_private & HINT_INTEGER) { @@ -1373,7 +1373,7 @@ PP(pp_left_shift) PP(pp_right_shift) { - djSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); + dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); { IV shift = POPi; if (PL_op->op_private & HINT_INTEGER) { @@ -1390,7 +1390,7 @@ PP(pp_right_shift) PP(pp_lt) { - djSP; tryAMAGICbinSET(lt,0); + dSP; tryAMAGICbinSET(lt,0); #ifdef PERL_PRESERVE_IVUV SvIV_please(TOPs); if (SvIOK(TOPs)) { @@ -1468,7 +1468,7 @@ PP(pp_lt) PP(pp_gt) { - djSP; tryAMAGICbinSET(gt,0); + dSP; tryAMAGICbinSET(gt,0); #ifdef PERL_PRESERVE_IVUV SvIV_please(TOPs); if (SvIOK(TOPs)) { @@ -1546,7 +1546,7 @@ PP(pp_gt) PP(pp_le) { - djSP; tryAMAGICbinSET(le,0); + dSP; tryAMAGICbinSET(le,0); #ifdef PERL_PRESERVE_IVUV SvIV_please(TOPs); if (SvIOK(TOPs)) { @@ -1624,7 +1624,7 @@ PP(pp_le) PP(pp_ge) { - djSP; tryAMAGICbinSET(ge,0); + dSP; tryAMAGICbinSET(ge,0); #ifdef PERL_PRESERVE_IVUV SvIV_please(TOPs); if (SvIOK(TOPs)) { @@ -1702,7 +1702,7 @@ PP(pp_ge) PP(pp_ne) { - djSP; tryAMAGICbinSET(ne,0); + dSP; tryAMAGICbinSET(ne,0); #ifdef PERL_PRESERVE_IVUV SvIV_please(TOPs); if (SvIOK(TOPs)) { @@ -1772,7 +1772,7 @@ PP(pp_ne) PP(pp_ncmp) { - djSP; dTARGET; tryAMAGICbin(ncmp,0); + dSP; dTARGET; tryAMAGICbin(ncmp,0); #ifdef PERL_PRESERVE_IVUV /* Fortunately it seems NaN isn't IOK */ SvIV_please(TOPs); @@ -1880,7 +1880,7 @@ PP(pp_ncmp) PP(pp_slt) { - djSP; tryAMAGICbinSET(slt,0); + dSP; tryAMAGICbinSET(slt,0); { dPOPTOPssrl; int cmp = ((PL_op->op_private & OPpLOCALE) @@ -1893,7 +1893,7 @@ PP(pp_slt) PP(pp_sgt) { - djSP; tryAMAGICbinSET(sgt,0); + dSP; tryAMAGICbinSET(sgt,0); { dPOPTOPssrl; int cmp = ((PL_op->op_private & OPpLOCALE) @@ -1906,7 +1906,7 @@ PP(pp_sgt) PP(pp_sle) { - djSP; tryAMAGICbinSET(sle,0); + dSP; tryAMAGICbinSET(sle,0); { dPOPTOPssrl; int cmp = ((PL_op->op_private & OPpLOCALE) @@ -1919,7 +1919,7 @@ PP(pp_sle) PP(pp_sge) { - djSP; tryAMAGICbinSET(sge,0); + dSP; tryAMAGICbinSET(sge,0); { dPOPTOPssrl; int cmp = ((PL_op->op_private & OPpLOCALE) @@ -1932,7 +1932,7 @@ PP(pp_sge) PP(pp_seq) { - djSP; tryAMAGICbinSET(seq,0); + dSP; tryAMAGICbinSET(seq,0); { dPOPTOPssrl; SETs(boolSV(sv_eq(left, right))); @@ -1942,7 +1942,7 @@ PP(pp_seq) PP(pp_sne) { - djSP; tryAMAGICbinSET(sne,0); + dSP; tryAMAGICbinSET(sne,0); { dPOPTOPssrl; SETs(boolSV(!sv_eq(left, right))); @@ -1952,7 +1952,7 @@ PP(pp_sne) PP(pp_scmp) { - djSP; dTARGET; tryAMAGICbin(scmp,0); + dSP; dTARGET; tryAMAGICbin(scmp,0); { dPOPTOPssrl; int cmp = ((PL_op->op_private & OPpLOCALE) @@ -1965,7 +1965,7 @@ PP(pp_scmp) PP(pp_bit_and) { - djSP; dATARGET; tryAMAGICbin(band,opASSIGN); + dSP; dATARGET; tryAMAGICbin(band,opASSIGN); { dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { @@ -1988,7 +1988,7 @@ PP(pp_bit_and) PP(pp_bit_xor) { - djSP; dATARGET; tryAMAGICbin(bxor,opASSIGN); + dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN); { dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { @@ -2011,7 +2011,7 @@ PP(pp_bit_xor) PP(pp_bit_or) { - djSP; dATARGET; tryAMAGICbin(bor,opASSIGN); + dSP; dATARGET; tryAMAGICbin(bor,opASSIGN); { dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { @@ -2034,7 +2034,7 @@ PP(pp_bit_or) PP(pp_negate) { - djSP; dTARGET; tryAMAGICun(neg); + dSP; dTARGET; tryAMAGICun(neg); { dTOPss; int flags = SvFLAGS(sv); @@ -2098,14 +2098,14 @@ PP(pp_negate) PP(pp_not) { - djSP; tryAMAGICunSET(not); + dSP; tryAMAGICunSET(not); *PL_stack_sp = boolSV(!SvTRUE(*PL_stack_sp)); return NORMAL; } PP(pp_complement) { - djSP; dTARGET; tryAMAGICun(compl); + dSP; dTARGET; tryAMAGICun(compl); { dTOPss; if (SvNIOKp(sv)) { @@ -2199,7 +2199,7 @@ PP(pp_complement) PP(pp_i_multiply) { - djSP; dATARGET; tryAMAGICbin(mult,opASSIGN); + dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); { dPOPTOPiirl; SETi( left * right ); @@ -2209,7 +2209,7 @@ PP(pp_i_multiply) PP(pp_i_divide) { - djSP; dATARGET; tryAMAGICbin(div,opASSIGN); + dSP; dATARGET; tryAMAGICbin(div,opASSIGN); { dPOPiv; if (value == 0) @@ -2222,7 +2222,7 @@ PP(pp_i_divide) PP(pp_i_modulo) { - djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); + dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); { dPOPTOPiirl; if (!right) @@ -2234,7 +2234,7 @@ PP(pp_i_modulo) PP(pp_i_add) { - djSP; dATARGET; tryAMAGICbin(add,opASSIGN); + dSP; dATARGET; tryAMAGICbin(add,opASSIGN); { dPOPTOPiirl_ul; SETi( left + right ); @@ -2244,7 +2244,7 @@ PP(pp_i_add) PP(pp_i_subtract) { - djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); + dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); { dPOPTOPiirl_ul; SETi( left - right ); @@ -2254,7 +2254,7 @@ PP(pp_i_subtract) PP(pp_i_lt) { - djSP; tryAMAGICbinSET(lt,0); + dSP; tryAMAGICbinSET(lt,0); { dPOPTOPiirl; SETs(boolSV(left < right)); @@ -2264,7 +2264,7 @@ PP(pp_i_lt) PP(pp_i_gt) { - djSP; tryAMAGICbinSET(gt,0); + dSP; tryAMAGICbinSET(gt,0); { dPOPTOPiirl; SETs(boolSV(left > right)); @@ -2274,7 +2274,7 @@ PP(pp_i_gt) PP(pp_i_le) { - djSP; tryAMAGICbinSET(le,0); + dSP; tryAMAGICbinSET(le,0); { dPOPTOPiirl; SETs(boolSV(left <= right)); @@ -2284,7 +2284,7 @@ PP(pp_i_le) PP(pp_i_ge) { - djSP; tryAMAGICbinSET(ge,0); + dSP; tryAMAGICbinSET(ge,0); { dPOPTOPiirl; SETs(boolSV(left >= right)); @@ -2294,7 +2294,7 @@ PP(pp_i_ge) PP(pp_i_eq) { - djSP; tryAMAGICbinSET(eq,0); + dSP; tryAMAGICbinSET(eq,0); { dPOPTOPiirl; SETs(boolSV(left == right)); @@ -2304,7 +2304,7 @@ PP(pp_i_eq) PP(pp_i_ne) { - djSP; tryAMAGICbinSET(ne,0); + dSP; tryAMAGICbinSET(ne,0); { dPOPTOPiirl; SETs(boolSV(left != right)); @@ -2314,7 +2314,7 @@ PP(pp_i_ne) PP(pp_i_ncmp) { - djSP; dTARGET; tryAMAGICbin(ncmp,0); + dSP; dTARGET; tryAMAGICbin(ncmp,0); { dPOPTOPiirl; I32 value; @@ -2332,7 +2332,7 @@ PP(pp_i_ncmp) PP(pp_i_negate) { - djSP; dTARGET; tryAMAGICun(neg); + dSP; dTARGET; tryAMAGICun(neg); SETi(-TOPi); RETURN; } @@ -2341,7 +2341,7 @@ PP(pp_i_negate) PP(pp_atan2) { - djSP; dTARGET; tryAMAGICbin(atan2,0); + dSP; dTARGET; tryAMAGICbin(atan2,0); { dPOPTOPnnrl; SETn(Perl_atan2(left, right)); @@ -2351,7 +2351,7 @@ PP(pp_atan2) PP(pp_sin) { - djSP; dTARGET; tryAMAGICun(sin); + dSP; dTARGET; tryAMAGICun(sin); { NV value; value = POPn; @@ -2363,7 +2363,7 @@ PP(pp_sin) PP(pp_cos) { - djSP; dTARGET; tryAMAGICun(cos); + dSP; dTARGET; tryAMAGICun(cos); { NV value; value = POPn; @@ -2390,7 +2390,7 @@ extern double drand48 (void); PP(pp_rand) { - djSP; dTARGET; + dSP; dTARGET; NV value; if (MAXARG < 1) value = 1.0; @@ -2409,7 +2409,7 @@ PP(pp_rand) PP(pp_srand) { - djSP; + dSP; UV anum; if (MAXARG < 1) anum = seed(); @@ -2504,7 +2504,7 @@ S_seed(pTHX) PP(pp_exp) { - djSP; dTARGET; tryAMAGICun(exp); + dSP; dTARGET; tryAMAGICun(exp); { NV value; value = POPn; @@ -2516,7 +2516,7 @@ PP(pp_exp) PP(pp_log) { - djSP; dTARGET; tryAMAGICun(log); + dSP; dTARGET; tryAMAGICun(log); { NV value; value = POPn; @@ -2532,7 +2532,7 @@ PP(pp_log) PP(pp_sqrt) { - djSP; dTARGET; tryAMAGICun(sqrt); + dSP; dTARGET; tryAMAGICun(sqrt); { NV value; value = POPn; @@ -2548,7 +2548,7 @@ PP(pp_sqrt) PP(pp_int) { - djSP; dTARGET; tryAMAGICun(int); + dSP; dTARGET; tryAMAGICun(int); { NV value; IV iv = TOPi; /* attempt to convert to IV if possible. */ @@ -2601,7 +2601,7 @@ PP(pp_int) PP(pp_abs) { - djSP; dTARGET; tryAMAGICun(abs); + dSP; dTARGET; tryAMAGICun(abs); { /* This will cache the NV value if string isn't actually integer */ IV iv = TOPi; @@ -2635,7 +2635,7 @@ PP(pp_abs) PP(pp_hex) { - djSP; dTARGET; + dSP; dTARGET; char *tmps; STRLEN argtype; STRLEN n_a; @@ -2648,7 +2648,7 @@ PP(pp_hex) PP(pp_oct) { - djSP; dTARGET; + dSP; dTARGET; NV value; STRLEN argtype; char *tmps; @@ -2674,7 +2674,7 @@ PP(pp_oct) PP(pp_length) { - djSP; dTARGET; + dSP; dTARGET; SV *sv = TOPs; if (DO_UTF8(sv)) @@ -2686,7 +2686,7 @@ PP(pp_length) PP(pp_substr) { - djSP; dTARGET; + dSP; dTARGET; SV *sv; I32 len; STRLEN curlen; @@ -2812,7 +2812,7 @@ PP(pp_substr) PP(pp_vec) { - djSP; dTARGET; + dSP; dTARGET; register IV size = POPi; register IV offset = POPi; register SV *src = POPs; @@ -2841,7 +2841,7 @@ PP(pp_vec) PP(pp_index) { - djSP; dTARGET; + dSP; dTARGET; SV *big; SV *little; I32 offset; @@ -2877,7 +2877,7 @@ PP(pp_index) PP(pp_rindex) { - djSP; dTARGET; + dSP; dTARGET; SV *big; SV *little; STRLEN blen; @@ -2918,7 +2918,7 @@ PP(pp_rindex) PP(pp_sprintf) { - djSP; dMARK; dORIGMARK; dTARGET; + dSP; dMARK; dORIGMARK; dTARGET; do_sprintf(TARG, SP-MARK, MARK+1); TAINT_IF(SvTAINTED(TARG)); SP = ORIGMARK; @@ -2928,7 +2928,7 @@ PP(pp_sprintf) PP(pp_ord) { - djSP; dTARGET; + dSP; dTARGET; SV *argsv = POPs; STRLEN len; U8 *s = (U8*)SvPVx(argsv, len); @@ -2939,7 +2939,7 @@ PP(pp_ord) PP(pp_chr) { - djSP; dTARGET; + dSP; dTARGET; char *tmps; UV value = POPu; @@ -2968,7 +2968,7 @@ PP(pp_chr) PP(pp_crypt) { - djSP; dTARGET; dPOPTOPssrl; + dSP; dTARGET; dPOPTOPssrl; STRLEN n_a; #ifdef HAS_CRYPT char *tmps = SvPV(left, n_a); @@ -2987,7 +2987,7 @@ PP(pp_crypt) PP(pp_ucfirst) { - djSP; + dSP; SV *sv = TOPs; register U8 *s; STRLEN slen; @@ -3046,7 +3046,7 @@ PP(pp_ucfirst) PP(pp_lcfirst) { - djSP; + dSP; SV *sv = TOPs; register U8 *s; STRLEN slen; @@ -3105,7 +3105,7 @@ PP(pp_lcfirst) PP(pp_uc) { - djSP; + dSP; SV *sv = TOPs; register U8 *s; STRLEN len; @@ -3179,7 +3179,7 @@ PP(pp_uc) PP(pp_lc) { - djSP; + dSP; SV *sv = TOPs; register U8 *s; STRLEN len; @@ -3254,7 +3254,7 @@ PP(pp_lc) PP(pp_quotemeta) { - djSP; dTARGET; + dSP; dTARGET; SV *sv = TOPs; STRLEN len; register char *s = SvPV(sv,len); @@ -3307,7 +3307,7 @@ PP(pp_quotemeta) PP(pp_aslice) { - djSP; dMARK; dORIGMARK; + dSP; dMARK; dORIGMARK; register SV** svp; register AV* av = (AV*)POPs; register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET); @@ -3352,7 +3352,7 @@ PP(pp_aslice) PP(pp_each) { - djSP; + dSP; HV *hash = (HV*)POPs; HE *entry; I32 gimme = GIMME_V; @@ -3394,7 +3394,7 @@ PP(pp_keys) PP(pp_delete) { - djSP; + dSP; I32 gimme = GIMME_V; I32 discard = (gimme == G_VOID) ? G_DISCARD : 0; SV *sv; @@ -3458,7 +3458,7 @@ PP(pp_delete) PP(pp_exists) { - djSP; + dSP; SV *tmpsv; HV *hv; @@ -3495,7 +3495,7 @@ PP(pp_exists) PP(pp_hslice) { - djSP; dMARK; dORIGMARK; + dSP; dMARK; dORIGMARK; register HV *hv = (HV*)POPs; register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET); I32 realhv = (SvTYPE(hv) == SVt_PVHV); @@ -3545,7 +3545,7 @@ PP(pp_hslice) PP(pp_list) { - djSP; dMARK; + dSP; dMARK; if (GIMME != G_ARRAY) { if (++MARK <= SP) *MARK = *SP; /* unwanted list, return last item */ @@ -3558,7 +3558,7 @@ PP(pp_list) PP(pp_lslice) { - djSP; + dSP; SV **lastrelem = PL_stack_sp; SV **lastlelem = PL_stack_base + POPMARK; SV **firstlelem = PL_stack_base + POPMARK + 1; @@ -3613,7 +3613,7 @@ PP(pp_lslice) PP(pp_anonlist) { - djSP; dMARK; dORIGMARK; + dSP; dMARK; dORIGMARK; I32 items = SP - MARK; SV *av = sv_2mortal((SV*)av_make(items, MARK+1)); SP = ORIGMARK; /* av_make() might realloc stack_sp */ @@ -3623,7 +3623,7 @@ PP(pp_anonlist) PP(pp_anonhash) { - djSP; dMARK; dORIGMARK; + dSP; dMARK; dORIGMARK; HV* hv = (HV*)sv_2mortal((SV*)newHV()); while (MARK < SP) { @@ -3642,7 +3642,7 @@ PP(pp_anonhash) PP(pp_splice) { - djSP; dMARK; dORIGMARK; + dSP; dMARK; dORIGMARK; register AV *ary = (AV*)*++MARK; register SV **src; register SV **dst; @@ -3844,7 +3844,7 @@ PP(pp_splice) PP(pp_push) { - djSP; dMARK; dORIGMARK; dTARGET; + dSP; dMARK; dORIGMARK; dTARGET; register AV *ary = (AV*)*++MARK; register SV *sv = &PL_sv_undef; MAGIC *mg; @@ -3874,7 +3874,7 @@ PP(pp_push) PP(pp_pop) { - djSP; + dSP; AV *av = (AV*)POPs; SV *sv = av_pop(av); if (AvREAL(av)) @@ -3885,7 +3885,7 @@ PP(pp_pop) PP(pp_shift) { - djSP; + dSP; AV *av = (AV*)POPs; SV *sv = av_shift(av); EXTEND(SP, 1); @@ -3899,7 +3899,7 @@ PP(pp_shift) PP(pp_unshift) { - djSP; dMARK; dORIGMARK; dTARGET; + dSP; dMARK; dORIGMARK; dTARGET; register AV *ary = (AV*)*++MARK; register SV *sv; register I32 i = 0; @@ -3929,7 +3929,7 @@ PP(pp_unshift) PP(pp_reverse) { - djSP; dMARK; + dSP; dMARK; register SV *tmp; SV **oldsp = SP; @@ -4037,7 +4037,7 @@ S_mul128(pTHX_ SV *sv, U8 m) PP(pp_unpack) { - djSP; + dSP; dPOPPOPssrl; I32 start_sp_offset = SP - PL_stack_base; I32 gimme = GIMME_V; @@ -4064,7 +4064,6 @@ PP(pp_unpack) U16 aushort; unsigned int auint; U32 aulong; - UV auv; #ifdef HAS_QUAD Uquad_t auquad; #endif @@ -4332,46 +4331,20 @@ PP(pp_unpack) if (len > strend - s) len = strend - s; if (checksum) { - if (DO_UTF8(right)) { - while (len > 0) { - STRLEN l; - auv = utf8_to_uv((U8*)s, strend - s, - &l, UTF8_ALLOW_ANYUV); - culong += auv; - s += l; - len -= l; - } - } - else { - uchar_checksum: - while (len-- > 0) { - auint = *s++ & 0xFF; - culong += auint; - } + uchar_checksum: + while (len-- > 0) { + auint = *s++ & 255; + culong += auint; } } else { EXTEND(SP, len); EXTEND_MORTAL(len); - if (DO_UTF8(right)) { - while (len > 0) { - STRLEN l; - auv = utf8_to_uv((U8*)s, strend - s, - &l, UTF8_ALLOW_ANYUV); - sv = NEWSV(37, 0); - sv_setuv(sv, auv); - PUSHs(sv_2mortal(sv)); - s += l; - len -= l; - } - } - else { - while (len-- > 0) { - auint = *s++ & 0xFF; - sv = NEWSV(37, 0); - sv_setuv(sv, auint); - PUSHs(sv_2mortal(sv)); - } + while (len-- > 0) { + auint = *s++ & 255; + sv = NEWSV(37, 0); + sv_setiv(sv, (IV)auint); + PUSHs(sv_2mortal(sv)); } } break; @@ -5151,7 +5124,7 @@ S_div128(pTHX_ SV *pnum, bool *done) PP(pp_pack) { - djSP; dMARK; dORIGMARK; dTARGET; + dSP; dMARK; dORIGMARK; dTARGET; register SV *cat = TARG; register I32 items; STRLEN fromlen; @@ -5172,7 +5145,6 @@ PP(pp_pack) unsigned int auint; I32 along; U32 aulong; - UV auv; #ifdef HAS_QUAD Quad_t aquad; Uquad_t auquad; @@ -5184,7 +5156,6 @@ PP(pp_pack) #ifdef PERL_NATINT_PACK int natint; /* native integer */ #endif - bool has_utf8; items = SP - MARK; MARK++; @@ -5421,6 +5392,7 @@ PP(pp_pack) items = saveitems; } break; + case 'C': case 'c': while (len-- > 0) { fromstr = NEXTFROM; @@ -5429,41 +5401,12 @@ PP(pp_pack) sv_catpvn(cat, &achar, sizeof(char)); } break; - case 'C': - has_utf8 = SvUTF8(cat); - while (len-- > 0) { - fromstr = NEXTFROM; - auv = SvUV(fromstr); - if (!has_utf8 && auv > 0xFF && !IN_BYTE) { - has_utf8 = TRUE; - if (SvCUR(cat)) - sv_utf8_upgrade(cat); - else - SvUTF8_on(cat); /* There will be UTF8. */ - } - if (has_utf8) { - SvGROW(cat, SvCUR(cat) + UNISKIP(auv) + 1); - SvCUR_set(cat, (char*)uv_to_utf8((U8*)SvEND(cat),auv) - - SvPVX(cat)); - } - else { - achar = auv; - sv_catpvn(cat, &achar, sizeof(char)); - } - } - *SvEND(cat) = '\0'; - break; case 'U': - has_utf8 = SvUTF8(cat); while (len-- > 0) { fromstr = NEXTFROM; - auv = SvUV(fromstr); - if (!has_utf8 && auv > 0x80) { - has_utf8 = TRUE; - sv_utf8_upgrade(cat); - } - SvGROW(cat, SvCUR(cat) + UNISKIP(auv) + 1); - SvCUR_set(cat, (char*)uv_to_utf8((U8*)SvEND(cat),auv) + auint = SvUV(fromstr); + SvGROW(cat, SvCUR(cat) + UTF8_MAXLEN + 1); + SvCUR_set(cat, (char*)uv_to_utf8((U8*)SvEND(cat),auint) - SvPVX(cat)); } *SvEND(cat) = '\0'; @@ -5775,7 +5718,7 @@ PP(pp_pack) PP(pp_split) { - djSP; dTARG; + dSP; dTARG; AV *ary; register IV limit = POPi; /* note, negative is forever */ SV *sv = POPs; @@ -6098,7 +6041,7 @@ Perl_unlock_condpair(pTHX_ void *svv) PP(pp_lock) { - djSP; + dSP; dTOPss; SV *retsv = sv; #ifdef USE_THREADS @@ -6115,7 +6058,7 @@ PP(pp_lock) PP(pp_threadsv) { #ifdef USE_THREADS - djSP; + dSP; EXTEND(SP, 1); if (PL_op->op_private & OPpLVAL_INTRO) PUSHs(*save_threadsv(PL_op->op_targ)); @@ -67,8 +67,8 @@ Refetch the stack pointer. Used after a callback. See L<perlcall>. #define TOPMARK (*PL_markstack_ptr) #define POPMARK (*PL_markstack_ptr--) -#define djSP register SV **sp = PL_stack_sp -#define dSP djSP +#define dSP register SV **sp = PL_stack_sp +#define djSP dSP #define dMARK register SV **mark = PL_stack_base + POPMARK #define dORIGMARK I32 origmark = mark - PL_stack_base #define SETORIGMARK origmark = mark - PL_stack_base @@ -47,7 +47,7 @@ static I32 sv_cmp_locale_static(pTHXo_ SV *a, SV *b); PP(pp_wantarray) { - djSP; + dSP; I32 cxix; EXTEND(SP, 1); @@ -80,7 +80,7 @@ PP(pp_regcreset) PP(pp_regcomp) { - djSP; + dSP; register PMOP *pm = (PMOP*)cLOGOP->op_other; register char *t; SV *tmpstr; @@ -156,7 +156,7 @@ PP(pp_regcomp) PP(pp_substcont) { - djSP; + dSP; register PMOP *pm = (PMOP*) cLOGOP->op_other; register PERL_CONTEXT *cx = &cxstack[cxstack_ix]; register SV *dstr = cx->sb_dstr; @@ -304,7 +304,7 @@ Perl_rxres_free(pTHX_ void **rsp) PP(pp_formline) { - djSP; dMARK; dORIGMARK; + dSP; dMARK; dORIGMARK; register SV *tmpForm = *++MARK; register U16 *fpc; register char *t; @@ -750,7 +750,7 @@ PP(pp_formline) PP(pp_grepstart) { - djSP; + dSP; SV *src; if (PL_stack_base + *PL_markstack_ptr == SP) { @@ -787,7 +787,7 @@ PP(pp_mapstart) PP(pp_mapwhile) { - djSP; + dSP; I32 items = (SP - PL_stack_base) - *PL_markstack_ptr; /* how many new items */ I32 count; I32 shift; @@ -875,7 +875,7 @@ PP(pp_mapwhile) PP(pp_sort) { - djSP; dMARK; dORIGMARK; + dSP; dMARK; dORIGMARK; register SV **up; SV **myorigmark = ORIGMARK; register I32 max; @@ -1060,7 +1060,7 @@ PP(pp_range) PP(pp_flip) { - djSP; + dSP; if (GIMME == G_ARRAY) { RETURNOP(((LOGOP*)cUNOP->op_first)->op_other); @@ -1099,7 +1099,7 @@ PP(pp_flip) PP(pp_flop) { - djSP; + dSP; if (GIMME == G_ARRAY) { dPOPPOPssrl; @@ -1534,7 +1534,7 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen) PP(pp_xor) { - djSP; dPOPTOPssrl; + dSP; dPOPTOPssrl; if (SvTRUE(left) != SvTRUE(right)) RETSETYES; else @@ -1543,7 +1543,7 @@ PP(pp_xor) PP(pp_andassign) { - djSP; + dSP; if (!SvTRUE(TOPs)) RETURN; else @@ -1552,7 +1552,7 @@ PP(pp_andassign) PP(pp_orassign) { - djSP; + dSP; if (SvTRUE(TOPs)) RETURN; else @@ -1561,7 +1561,7 @@ PP(pp_orassign) PP(pp_caller) { - djSP; + dSP; register I32 cxix = dopoptosub(cxstack_ix); register PERL_CONTEXT *cx; register PERL_CONTEXT *ccstack = cxstack; @@ -1704,7 +1704,7 @@ PP(pp_caller) PP(pp_reset) { - djSP; + dSP; char *tmps; STRLEN n_a; @@ -1731,7 +1731,7 @@ PP(pp_dbstate) if (PL_op->op_private || SvIV(PL_DBsingle) || SvIV(PL_DBsignal) || SvIV(PL_DBtrace)) { - djSP; + dSP; register CV *cv; register PERL_CONTEXT *cx; I32 gimme = G_ARRAY; @@ -1775,7 +1775,7 @@ PP(pp_scope) PP(pp_enteriter) { - djSP; dMARK; + dSP; dMARK; register PERL_CONTEXT *cx; I32 gimme = GIMME_V; SV **svp; @@ -1854,7 +1854,7 @@ PP(pp_enteriter) PP(pp_enterloop) { - djSP; + dSP; register PERL_CONTEXT *cx; I32 gimme = GIMME_V; @@ -1870,7 +1870,7 @@ PP(pp_enterloop) PP(pp_leaveloop) { - djSP; + dSP; register PERL_CONTEXT *cx; I32 gimme; SV **newsp; @@ -1910,7 +1910,7 @@ PP(pp_leaveloop) PP(pp_return) { - djSP; dMARK; + dSP; dMARK; I32 cxix; register PERL_CONTEXT *cx; bool popsub2 = FALSE; @@ -2021,7 +2021,7 @@ PP(pp_return) PP(pp_last) { - djSP; + dSP; I32 cxix; register PERL_CONTEXT *cx; I32 pop2 = 0; @@ -2208,7 +2208,7 @@ PP(pp_dump) PP(pp_goto) { - djSP; + dSP; OP *retop = 0; I32 ix; register PERL_CONTEXT *cx; @@ -2585,7 +2585,7 @@ PP(pp_goto) PP(pp_exit) { - djSP; + dSP; I32 anum; if (MAXARG < 1) @@ -2606,7 +2606,7 @@ PP(pp_exit) #ifdef NOTYET PP(pp_nswitch) { - djSP; + dSP; NV value = SvNVx(GvSV(cCOP->cop_gv)); register I32 match = I_32(value); @@ -2625,7 +2625,7 @@ PP(pp_nswitch) PP(pp_cswitch) { - djSP; + dSP; register I32 match; if (PL_multiline) @@ -3024,7 +3024,7 @@ S_doopen_pmc(pTHX_ const char *name, const char *mode) PP(pp_require) { - djSP; + dSP; register PERL_CONTEXT *cx; SV *sv; char *name; @@ -3380,7 +3380,7 @@ PP(pp_dofile) PP(pp_entereval) { - djSP; + dSP; register PERL_CONTEXT *cx; dPOPss; I32 gimme = GIMME_V, was = PL_sub_generation; @@ -3464,7 +3464,7 @@ PP(pp_entereval) PP(pp_leaveeval) { - djSP; + dSP; register SV **mark; SV **newsp; PMOP *newpm; @@ -3535,7 +3535,7 @@ PP(pp_leaveeval) PP(pp_entertry) { - djSP; + dSP; register PERL_CONTEXT *cx; I32 gimme = GIMME_V; @@ -3555,7 +3555,7 @@ PP(pp_entertry) PP(pp_leavetry) { - djSP; + dSP; register SV **mark; SV **newsp; PMOP *newpm; @@ -4401,7 +4401,7 @@ run_user_filter(pTHXo_ int idx, SV *buf_sv, int maxlen) } if (filter_sub && len >= 0) { - djSP; + dSP; int count; ENTER; @@ -27,7 +27,7 @@ static void unset_cvowner(pTHXo_ void *cvarg); PP(pp_const) { - djSP; + dSP; XPUSHs(cSVOP_sv); RETURN; } @@ -43,7 +43,7 @@ PP(pp_nextstate) PP(pp_gvsv) { - djSP; + dSP; EXTEND(SP,1); if (PL_op->op_private & OPpLVAL_INTRO) PUSHs(save_scalar(cGVOP_gv)); @@ -71,7 +71,7 @@ PP(pp_pushmark) PP(pp_stringify) { - djSP; dTARGET; + dSP; dTARGET; STRLEN len; char *s; s = SvPV(TOPs,len); @@ -86,14 +86,14 @@ PP(pp_stringify) PP(pp_gv) { - djSP; + dSP; XPUSHs((SV*)cGVOP_gv); RETURN; } PP(pp_and) { - djSP; + dSP; if (!SvTRUE(TOPs)) RETURN; else { @@ -104,7 +104,7 @@ PP(pp_and) PP(pp_sassign) { - djSP; dPOPTOPssrl; + dSP; dPOPTOPssrl; if (PL_op->op_private & OPpASSIGN_BACKWARDS) { SV *temp; @@ -119,7 +119,7 @@ PP(pp_sassign) PP(pp_cond_expr) { - djSP; + dSP; if (SvTRUEx(POPs)) RETURNOP(cLOGOP->op_other); else @@ -139,7 +139,7 @@ PP(pp_unstack) PP(pp_concat) { - djSP; dATARGET; tryAMAGICbin(concat,opASSIGN); + dSP; dATARGET; tryAMAGICbin(concat,opASSIGN); { dPOPTOPssrl; SV* rcopy = Nullsv; @@ -195,7 +195,7 @@ PP(pp_concat) PP(pp_padsv) { - djSP; dTARGET; + dSP; dTARGET; XPUSHs(TARG); if (PL_op->op_flags & OPf_MOD) { if (PL_op->op_private & OPpLVAL_INTRO) @@ -229,7 +229,7 @@ PP(pp_readline) PP(pp_eq) { - djSP; tryAMAGICbinSET(eq,0); + dSP; tryAMAGICbinSET(eq,0); #ifdef PERL_PRESERVE_IVUV SvIV_please(TOPs); if (SvIOK(TOPs)) { @@ -302,7 +302,7 @@ PP(pp_eq) PP(pp_preinc) { - djSP; + dSP; if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) DIE(aTHX_ PL_no_modify); if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && @@ -319,7 +319,7 @@ PP(pp_preinc) PP(pp_or) { - djSP; + dSP; if (SvTRUE(TOPs)) RETURN; else { @@ -330,7 +330,7 @@ PP(pp_or) PP(pp_add) { - djSP; dATARGET; bool useleft; tryAMAGICbin(add,opASSIGN); + dSP; dATARGET; bool useleft; tryAMAGICbin(add,opASSIGN); useleft = USE_LEFT(TOPm1s); #ifdef PERL_PRESERVE_IVUV /* We must see if we can perform the addition with integers if possible, @@ -492,7 +492,7 @@ PP(pp_add) PP(pp_aelemfast) { - djSP; + dSP; AV *av = GvAV(cGVOP_gv); U32 lval = PL_op->op_flags & OPf_MOD; SV** svp = av_fetch(av, PL_op->op_private, lval); @@ -506,7 +506,7 @@ PP(pp_aelemfast) PP(pp_join) { - djSP; dMARK; dTARGET; + dSP; dMARK; dTARGET; MARK++; do_join(TARG, *MARK, MARK, SP); SP = MARK; @@ -516,7 +516,7 @@ PP(pp_join) PP(pp_pushre) { - djSP; + dSP; #ifdef DEBUGGING /* * We ass_u_me that LvTARGOFF() comes first, and that two STRLENs @@ -537,7 +537,7 @@ PP(pp_pushre) PP(pp_print) { - djSP; dMARK; dORIGMARK; + dSP; dMARK; dORIGMARK; GV *gv; IO *io; register PerlIO *fp; @@ -634,7 +634,7 @@ PP(pp_print) PP(pp_rv2av) { - djSP; dTOPss; + dSP; dTOPss; AV *av; if (SvROK(sv)) { @@ -758,7 +758,7 @@ PP(pp_rv2av) PP(pp_rv2hv) { - djSP; dTOPss; + dSP; dTOPss; HV *hv; if (SvROK(sv)) { @@ -963,7 +963,7 @@ S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem) PP(pp_aassign) { - djSP; + dSP; SV **lastlelem = PL_stack_sp; SV **lastrelem = PL_stack_base + POPMARK; SV **firstrelem = PL_stack_base + POPMARK + 1; @@ -1174,7 +1174,7 @@ PP(pp_aassign) PP(pp_qr) { - djSP; + dSP; register PMOP *pm = cPMOP; SV *rv = sv_newmortal(); SV *sv = newSVrv(rv, "Regexp"); @@ -1184,7 +1184,7 @@ PP(pp_qr) PP(pp_match) { - djSP; dTARG; + dSP; dTARG; register PMOP *pm = cPMOP; register char *t; register char *s; @@ -1583,7 +1583,7 @@ Perl_do_readline(pTHX) PP(pp_enter) { - djSP; + dSP; register PERL_CONTEXT *cx; I32 gimme = OP_GIMME(PL_op, -1); @@ -1604,7 +1604,7 @@ PP(pp_enter) PP(pp_helem) { - djSP; + dSP; HE* he; SV **svp; SV *keysv = POPs; @@ -1677,7 +1677,7 @@ PP(pp_helem) PP(pp_leave) { - djSP; + dSP; register PERL_CONTEXT *cx; register SV **mark; SV **newsp; @@ -1733,7 +1733,7 @@ PP(pp_leave) PP(pp_iter) { - djSP; + dSP; register PERL_CONTEXT *cx; SV* sv; AV* av; @@ -1835,7 +1835,7 @@ PP(pp_iter) PP(pp_subst) { - djSP; dTARG; + dSP; dTARG; register PMOP *pm = cPMOP; PMOP *rpm = pm; register SV *dstr; @@ -2111,7 +2111,7 @@ ret_no: PP(pp_grepwhile) { - djSP; + dSP; if (SvTRUEx(POPs)) PL_stack_base[PL_markstack_ptr[-1]++] = PL_stack_base[*PL_markstack_ptr]; @@ -2152,7 +2152,7 @@ PP(pp_grepwhile) PP(pp_leavesub) { - djSP; + dSP; SV **mark; SV **newsp; PMOP *newpm; @@ -2210,7 +2210,7 @@ PP(pp_leavesub) * get any slower by more conditions */ PP(pp_leavesublv) { - djSP; + dSP; SV **mark; SV **newsp; PMOP *newpm; @@ -2399,7 +2399,7 @@ S_get_db_sub(pTHX_ SV **svp, CV *cv) PP(pp_entersub) { - djSP; dPOPss; + dSP; dPOPss; GV *gv; HV *stash; register CV *cv; @@ -2857,7 +2857,7 @@ Perl_sub_crush_depth(pTHX_ CV *cv) PP(pp_aelem) { - djSP; + dSP; SV** svp; SV* elemsv = POPs; IV elem = SvIV(elemsv); @@ -2933,7 +2933,7 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what) PP(pp_method) { - djSP; + dSP; SV* sv = TOPs; if (SvROK(sv)) { @@ -2950,7 +2950,7 @@ PP(pp_method) PP(pp_method_named) { - djSP; + dSP; SV* sv = cSVOP->op_sv; U32 hash = SvUVX(sv); @@ -283,7 +283,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode) PP(pp_backtick) { - djSP; dTARGET; + dSP; dTARGET; PerlIO *fp; STRLEN n_a; char *tmps = POPpx; @@ -402,7 +402,7 @@ PP(pp_rcatline) PP(pp_warn) { - djSP; dMARK; + dSP; dMARK; SV *tmpsv; char *tmps; STRLEN len; @@ -433,7 +433,7 @@ PP(pp_warn) PP(pp_die) { - djSP; dMARK; + dSP; dMARK; char *tmps; SV *tmpsv; STRLEN len; @@ -492,7 +492,7 @@ PP(pp_die) PP(pp_open) { - djSP; + dSP; dMARK; dORIGMARK; dTARGET; GV *gv; @@ -542,7 +542,7 @@ PP(pp_open) PP(pp_close) { - djSP; + dSP; GV *gv; MAGIC *mg; @@ -568,7 +568,7 @@ PP(pp_close) PP(pp_pipe_op) { - djSP; + dSP; #ifdef HAS_PIPE GV *rgv; GV *wgv; @@ -623,7 +623,7 @@ badexit: PP(pp_fileno) { - djSP; dTARGET; + dSP; dTARGET; GV *gv; IO *io; PerlIO *fp; @@ -659,7 +659,7 @@ PP(pp_fileno) PP(pp_umask) { - djSP; dTARGET; + dSP; dTARGET; Mode_t anum; #ifdef HAS_UMASK @@ -684,7 +684,7 @@ PP(pp_umask) PP(pp_binmode) { - djSP; + dSP; GV *gv; IO *io; PerlIO *fp; @@ -734,7 +734,7 @@ PP(pp_binmode) PP(pp_tie) { - djSP; + dSP; dMARK; SV *varsv; HV* stash; @@ -819,7 +819,7 @@ PP(pp_tie) PP(pp_untie) { - djSP; + dSP; SV *sv = POPs; char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? 'P' : 'q'; @@ -852,7 +852,7 @@ PP(pp_untie) PP(pp_tied) { - djSP; + dSP; SV *sv = POPs; char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? 'P' : 'q'; MAGIC *mg; @@ -869,7 +869,7 @@ PP(pp_tied) PP(pp_dbmopen) { - djSP; + dSP; HV *hv; dPOPPOPssrl; HV* stash; @@ -931,7 +931,7 @@ PP(pp_dbmclose) PP(pp_sselect) { - djSP; dTARGET; + dSP; dTARGET; #ifdef HAS_SELECT register I32 i; register I32 j; @@ -1082,7 +1082,7 @@ Perl_setdefout(pTHX_ GV *gv) PP(pp_select) { - djSP; dTARGET; + dSP; dTARGET; GV *newdefout, *egv; HV *hv; @@ -1116,7 +1116,7 @@ PP(pp_select) PP(pp_getc) { - djSP; dTARGET; + dSP; dTARGET; GV *gv; MAGIC *mg; @@ -1185,7 +1185,7 @@ S_doform(pTHX_ CV *cv, GV *gv, OP *retop) PP(pp_enterwrite) { - djSP; + dSP; register GV *gv; register IO *io; GV *fgv; @@ -1229,7 +1229,7 @@ PP(pp_enterwrite) PP(pp_leavewrite) { - djSP; + dSP; GV *gv = cxstack[cxstack_ix].blk_sub.gv; register IO *io = GvIOp(gv); PerlIO *ofp = IoOFP(io); @@ -1370,7 +1370,7 @@ PP(pp_leavewrite) PP(pp_prtf) { - djSP; dMARK; dORIGMARK; + dSP; dMARK; dORIGMARK; GV *gv; IO *io; PerlIO *fp; @@ -1454,7 +1454,7 @@ PP(pp_prtf) PP(pp_sysopen) { - djSP; + dSP; GV *gv; SV *sv; char *tmps; @@ -1484,7 +1484,7 @@ PP(pp_sysopen) PP(pp_sysread) { - djSP; dMARK; dORIGMARK; dTARGET; + dSP; dMARK; dORIGMARK; dTARGET; int offset; GV *gv; IO *io; @@ -1699,7 +1699,7 @@ PP(pp_sysread) PP(pp_syswrite) { - djSP; + dSP; int items = (SP - PL_stack_base) - TOPMARK; if (items == 2) { SV *sv; @@ -1713,7 +1713,7 @@ PP(pp_syswrite) PP(pp_send) { - djSP; dMARK; dORIGMARK; dTARGET; + dSP; dMARK; dORIGMARK; dTARGET; GV *gv; IO *io; SV *bufsv; @@ -1842,7 +1842,7 @@ PP(pp_recv) PP(pp_eof) { - djSP; + dSP; GV *gv; MAGIC *mg; @@ -1886,7 +1886,7 @@ PP(pp_eof) PP(pp_tell) { - djSP; dTARGET; + dSP; dTARGET; GV *gv; MAGIC *mg; @@ -1921,7 +1921,7 @@ PP(pp_seek) PP(pp_sysseek) { - djSP; + dSP; GV *gv; int whence = POPi; #if LSEEKSIZE > IVSIZE @@ -1972,7 +1972,7 @@ PP(pp_sysseek) PP(pp_truncate) { - djSP; + dSP; /* There seems to be no consensus on the length type of truncate() * and ftruncate(), both off_t and size_t have supporters. In * general one would think that when using large files, off_t is @@ -2059,7 +2059,7 @@ PP(pp_fcntl) PP(pp_ioctl) { - djSP; dTARGET; + dSP; dTARGET; SV *argsv = POPs; unsigned int func = U_I(POPn); int optype = PL_op->op_type; @@ -2132,7 +2132,7 @@ PP(pp_ioctl) PP(pp_flock) { - djSP; dTARGET; + dSP; dTARGET; I32 value; int argtype; GV *gv; @@ -2172,7 +2172,7 @@ PP(pp_flock) PP(pp_socket) { - djSP; + dSP; #ifdef HAS_SOCKET GV *gv; register IO *io; @@ -2210,6 +2210,10 @@ PP(pp_socket) fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ #endif +#ifdef EPOC + setbuf( IoIFP(io), NULL); /* EPOC gets confused about sockets */ +#endif + RETPUSHYES; #else DIE(aTHX_ PL_no_sock_func, "socket"); @@ -2218,7 +2222,7 @@ PP(pp_socket) PP(pp_sockpair) { - djSP; + dSP; #ifdef HAS_SOCKETPAIR GV *gv1; GV *gv2; @@ -2278,7 +2282,7 @@ PP(pp_sockpair) PP(pp_bind) { - djSP; + dSP; #ifdef HAS_SOCKET #ifdef MPE /* Requires PRIV mode to bind() to ports < 1024 */ extern GETPRIVMODE(); @@ -2337,7 +2341,7 @@ nuts: PP(pp_connect) { - djSP; + dSP; #ifdef HAS_SOCKET SV *addrsv = POPs; char *addr; @@ -2367,7 +2371,7 @@ nuts: PP(pp_listen) { - djSP; + dSP; #ifdef HAS_SOCKET int backlog = POPi; GV *gv = (GV*)POPs; @@ -2393,7 +2397,7 @@ nuts: PP(pp_accept) { - djSP; dTARGET; + dSP; dTARGET; #ifdef HAS_SOCKET GV *ngv; GV *ggv; @@ -2457,7 +2461,7 @@ badexit: PP(pp_shutdown) { - djSP; dTARGET; + dSP; dTARGET; #ifdef HAS_SOCKET int how = POPi; GV *gv = (GV*)POPs; @@ -2490,7 +2494,7 @@ PP(pp_gsockopt) PP(pp_ssockopt) { - djSP; + dSP; #ifdef HAS_SOCKET int optype = PL_op->op_type; SV *sv; @@ -2571,7 +2575,7 @@ PP(pp_getsockname) PP(pp_getpeername) { - djSP; + dSP; #ifdef HAS_SOCKET int optype = PL_op->op_type; SV *sv; @@ -2642,7 +2646,7 @@ PP(pp_lstat) PP(pp_stat) { - djSP; + dSP; GV *gv; I32 gimme; I32 max = 13; @@ -2763,7 +2767,7 @@ PP(pp_stat) PP(pp_ftrread) { I32 result; - djSP; + dSP; #if defined(HAS_ACCESS) && defined(R_OK) STRLEN n_a; if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) { @@ -2790,7 +2794,7 @@ PP(pp_ftrread) PP(pp_ftrwrite) { I32 result; - djSP; + dSP; #if defined(HAS_ACCESS) && defined(W_OK) STRLEN n_a; if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) { @@ -2817,7 +2821,7 @@ PP(pp_ftrwrite) PP(pp_ftrexec) { I32 result; - djSP; + dSP; #if defined(HAS_ACCESS) && defined(X_OK) STRLEN n_a; if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) { @@ -2844,7 +2848,7 @@ PP(pp_ftrexec) PP(pp_fteread) { I32 result; - djSP; + dSP; #ifdef PERL_EFF_ACCESS_R_OK STRLEN n_a; if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) { @@ -2871,7 +2875,7 @@ PP(pp_fteread) PP(pp_ftewrite) { I32 result; - djSP; + dSP; #ifdef PERL_EFF_ACCESS_W_OK STRLEN n_a; if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) { @@ -2898,7 +2902,7 @@ PP(pp_ftewrite) PP(pp_fteexec) { I32 result; - djSP; + dSP; #ifdef PERL_EFF_ACCESS_X_OK STRLEN n_a; if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) { @@ -2925,7 +2929,7 @@ PP(pp_fteexec) PP(pp_ftis) { I32 result = my_stat(); - djSP; + dSP; if (result < 0) RETPUSHUNDEF; RETPUSHYES; @@ -2939,7 +2943,7 @@ PP(pp_fteowned) PP(pp_ftrowned) { I32 result = my_stat(); - djSP; + dSP; if (result < 0) RETPUSHUNDEF; if (PL_statcache.st_uid == (PL_op->op_type == OP_FTEOWNED ? @@ -2951,7 +2955,7 @@ PP(pp_ftrowned) PP(pp_ftzero) { I32 result = my_stat(); - djSP; + dSP; if (result < 0) RETPUSHUNDEF; if (PL_statcache.st_size == 0) @@ -2962,7 +2966,7 @@ PP(pp_ftzero) PP(pp_ftsize) { I32 result = my_stat(); - djSP; dTARGET; + dSP; dTARGET; if (result < 0) RETPUSHUNDEF; #if Off_t_size > IVSIZE @@ -2976,7 +2980,7 @@ PP(pp_ftsize) PP(pp_ftmtime) { I32 result = my_stat(); - djSP; dTARGET; + dSP; dTARGET; if (result < 0) RETPUSHUNDEF; PUSHn( (PL_basetime - PL_statcache.st_mtime) / 86400.0 ); @@ -2986,7 +2990,7 @@ PP(pp_ftmtime) PP(pp_ftatime) { I32 result = my_stat(); - djSP; dTARGET; + dSP; dTARGET; if (result < 0) RETPUSHUNDEF; PUSHn( (PL_basetime - PL_statcache.st_atime) / 86400.0 ); @@ -2996,7 +3000,7 @@ PP(pp_ftatime) PP(pp_ftctime) { I32 result = my_stat(); - djSP; dTARGET; + dSP; dTARGET; if (result < 0) RETPUSHUNDEF; PUSHn( (PL_basetime - PL_statcache.st_ctime) / 86400.0 ); @@ -3006,7 +3010,7 @@ PP(pp_ftctime) PP(pp_ftsock) { I32 result = my_stat(); - djSP; + dSP; if (result < 0) RETPUSHUNDEF; if (S_ISSOCK(PL_statcache.st_mode)) @@ -3017,7 +3021,7 @@ PP(pp_ftsock) PP(pp_ftchr) { I32 result = my_stat(); - djSP; + dSP; if (result < 0) RETPUSHUNDEF; if (S_ISCHR(PL_statcache.st_mode)) @@ -3028,7 +3032,7 @@ PP(pp_ftchr) PP(pp_ftblk) { I32 result = my_stat(); - djSP; + dSP; if (result < 0) RETPUSHUNDEF; if (S_ISBLK(PL_statcache.st_mode)) @@ -3039,7 +3043,7 @@ PP(pp_ftblk) PP(pp_ftfile) { I32 result = my_stat(); - djSP; + dSP; if (result < 0) RETPUSHUNDEF; if (S_ISREG(PL_statcache.st_mode)) @@ -3050,7 +3054,7 @@ PP(pp_ftfile) PP(pp_ftdir) { I32 result = my_stat(); - djSP; + dSP; if (result < 0) RETPUSHUNDEF; if (S_ISDIR(PL_statcache.st_mode)) @@ -3061,7 +3065,7 @@ PP(pp_ftdir) PP(pp_ftpipe) { I32 result = my_stat(); - djSP; + dSP; if (result < 0) RETPUSHUNDEF; if (S_ISFIFO(PL_statcache.st_mode)) @@ -3072,7 +3076,7 @@ PP(pp_ftpipe) PP(pp_ftlink) { I32 result = my_lstat(); - djSP; + dSP; if (result < 0) RETPUSHUNDEF; if (S_ISLNK(PL_statcache.st_mode)) @@ -3082,7 +3086,7 @@ PP(pp_ftlink) PP(pp_ftsuid) { - djSP; + dSP; #ifdef S_ISUID I32 result = my_stat(); SPAGAIN; @@ -3096,7 +3100,7 @@ PP(pp_ftsuid) PP(pp_ftsgid) { - djSP; + dSP; #ifdef S_ISGID I32 result = my_stat(); SPAGAIN; @@ -3110,7 +3114,7 @@ PP(pp_ftsgid) PP(pp_ftsvtx) { - djSP; + dSP; #ifdef S_ISVTX I32 result = my_stat(); SPAGAIN; @@ -3124,7 +3128,7 @@ PP(pp_ftsvtx) PP(pp_fttty) { - djSP; + dSP; int fd; GV *gv; char *tmps = Nullch; @@ -3160,7 +3164,7 @@ PP(pp_fttty) PP(pp_fttext) { - djSP; + dSP; I32 i; I32 len; I32 odd = 0; @@ -3321,7 +3325,7 @@ PP(pp_ftbinary) PP(pp_chdir) { - djSP; dTARGET; + dSP; dTARGET; char *tmps; SV **svp; STRLEN n_a; @@ -3359,7 +3363,7 @@ PP(pp_chdir) PP(pp_chown) { - djSP; dMARK; dTARGET; + dSP; dMARK; dTARGET; I32 value; #ifdef HAS_CHOWN value = (I32)apply(PL_op->op_type, MARK, SP); @@ -3373,7 +3377,7 @@ PP(pp_chown) PP(pp_chroot) { - djSP; dTARGET; + dSP; dTARGET; char *tmps; #ifdef HAS_CHROOT STRLEN n_a; @@ -3388,7 +3392,7 @@ PP(pp_chroot) PP(pp_unlink) { - djSP; dMARK; dTARGET; + dSP; dMARK; dTARGET; I32 value; value = (I32)apply(PL_op->op_type, MARK, SP); SP = MARK; @@ -3398,7 +3402,7 @@ PP(pp_unlink) PP(pp_chmod) { - djSP; dMARK; dTARGET; + dSP; dMARK; dTARGET; I32 value; value = (I32)apply(PL_op->op_type, MARK, SP); SP = MARK; @@ -3408,7 +3412,7 @@ PP(pp_chmod) PP(pp_utime) { - djSP; dMARK; dTARGET; + dSP; dMARK; dTARGET; I32 value; value = (I32)apply(PL_op->op_type, MARK, SP); SP = MARK; @@ -3418,7 +3422,7 @@ PP(pp_utime) PP(pp_rename) { - djSP; dTARGET; + dSP; dTARGET; int anum; STRLEN n_a; @@ -3445,7 +3449,7 @@ PP(pp_rename) PP(pp_link) { - djSP; dTARGET; + dSP; dTARGET; #ifdef HAS_LINK STRLEN n_a; char *tmps2 = POPpx; @@ -3460,7 +3464,7 @@ PP(pp_link) PP(pp_symlink) { - djSP; dTARGET; + dSP; dTARGET; #ifdef HAS_SYMLINK STRLEN n_a; char *tmps2 = POPpx; @@ -3475,7 +3479,7 @@ PP(pp_symlink) PP(pp_readlink) { - djSP; dTARGET; + dSP; dTARGET; #ifdef HAS_SYMLINK char *tmps; char buf[MAXPATHLEN]; @@ -3587,7 +3591,7 @@ S_dooneliner(pTHX_ char *cmd, char *filename) PP(pp_mkdir) { - djSP; dTARGET; + dSP; dTARGET; int mode; #ifndef HAS_MKDIR int oldumask; @@ -3634,7 +3638,7 @@ PP(pp_mkdir) PP(pp_rmdir) { - djSP; dTARGET; + dSP; dTARGET; char *tmps; STRLEN n_a; @@ -3652,7 +3656,7 @@ PP(pp_rmdir) PP(pp_open_dir) { - djSP; + dSP; #if defined(Direntry_t) && defined(HAS_READDIR) STRLEN n_a; char *dirname = POPpx; @@ -3679,7 +3683,7 @@ nope: PP(pp_readdir) { - djSP; + dSP; #if defined(Direntry_t) && defined(HAS_READDIR) #ifndef I_DIRENT Direntry_t *readdir (DIR *); @@ -3737,7 +3741,7 @@ nope: PP(pp_telldir) { - djSP; dTARGET; + dSP; dTARGET; #if defined(HAS_TELLDIR) || defined(telldir) /* XXX does _anyone_ need this? --AD 2/20/1998 */ /* XXX netbsd still seemed to. @@ -3765,7 +3769,7 @@ nope: PP(pp_seekdir) { - djSP; + dSP; #if defined(HAS_SEEKDIR) || defined(seekdir) long along = POPl; GV *gv = (GV*)POPs; @@ -3788,7 +3792,7 @@ nope: PP(pp_rewinddir) { - djSP; + dSP; #if defined(HAS_REWINDDIR) || defined(rewinddir) GV *gv = (GV*)POPs; register IO *io = GvIOn(gv); @@ -3809,7 +3813,7 @@ nope: PP(pp_closedir) { - djSP; + dSP; #if defined(Direntry_t) && defined(HAS_READDIR) GV *gv = (GV*)POPs; register IO *io = GvIOn(gv); @@ -3842,7 +3846,7 @@ nope: PP(pp_fork) { #ifdef HAS_FORK - djSP; dTARGET; + dSP; dTARGET; Pid_t childpid; GV *tmpgv; @@ -3861,7 +3865,7 @@ PP(pp_fork) RETURN; #else # if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS) - djSP; dTARGET; + dSP; dTARGET; Pid_t childpid; EXTEND(SP, 1); @@ -3880,7 +3884,7 @@ PP(pp_fork) PP(pp_wait) { #if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) - djSP; dTARGET; + dSP; dTARGET; Pid_t childpid; int argflags; @@ -3901,7 +3905,7 @@ PP(pp_wait) PP(pp_waitpid) { #if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) - djSP; dTARGET; + dSP; dTARGET; Pid_t childpid; int optype; int argflags; @@ -3924,7 +3928,7 @@ PP(pp_waitpid) PP(pp_system) { - djSP; dMARK; dORIGMARK; dTARGET; + dSP; dMARK; dORIGMARK; dTARGET; I32 value; Pid_t childpid; int result; @@ -4038,7 +4042,7 @@ PP(pp_system) PP(pp_exec) { - djSP; dMARK; dORIGMARK; dTARGET; + dSP; dMARK; dORIGMARK; dTARGET; I32 value; STRLEN n_a; @@ -4090,7 +4094,7 @@ PP(pp_exec) PP(pp_kill) { - djSP; dMARK; dTARGET; + dSP; dMARK; dTARGET; I32 value; #ifdef HAS_KILL value = (I32)apply(PL_op->op_type, MARK, SP); @@ -4105,7 +4109,7 @@ PP(pp_kill) PP(pp_getppid) { #ifdef HAS_GETPPID - djSP; dTARGET; + dSP; dTARGET; XPUSHi( getppid() ); RETURN; #else @@ -4116,7 +4120,7 @@ PP(pp_getppid) PP(pp_getpgrp) { #ifdef HAS_GETPGRP - djSP; dTARGET; + dSP; dTARGET; Pid_t pid; Pid_t pgrp; @@ -4141,7 +4145,7 @@ PP(pp_getpgrp) PP(pp_setpgrp) { #ifdef HAS_SETPGRP - djSP; dTARGET; + dSP; dTARGET; Pid_t pgrp; Pid_t pid; if (MAXARG < 2) { @@ -4172,7 +4176,7 @@ PP(pp_setpgrp) PP(pp_getpriority) { - djSP; dTARGET; + dSP; dTARGET; int which; int who; #ifdef HAS_GETPRIORITY @@ -4187,7 +4191,7 @@ PP(pp_getpriority) PP(pp_setpriority) { - djSP; dTARGET; + dSP; dTARGET; int which; int who; int niceval; @@ -4207,7 +4211,7 @@ PP(pp_setpriority) PP(pp_time) { - djSP; dTARGET; + dSP; dTARGET; #ifdef BIG_TIME XPUSHn( time(Null(Time_t*)) ); #else @@ -4234,7 +4238,7 @@ PP(pp_time) PP(pp_tms) { - djSP; + dSP; #ifndef HAS_TIMES DIE(aTHX_ "times not implemented"); @@ -4266,7 +4270,7 @@ PP(pp_localtime) PP(pp_gmtime) { - djSP; + dSP; Time_t when; struct tm *tmbuf; static char *dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"}; @@ -4319,7 +4323,7 @@ PP(pp_gmtime) PP(pp_alarm) { - djSP; dTARGET; + dSP; dTARGET; int anum; #ifdef HAS_ALARM anum = POPi; @@ -4336,7 +4340,7 @@ PP(pp_alarm) PP(pp_sleep) { - djSP; dTARGET; + dSP; dTARGET; I32 duration; Time_t lasttime; Time_t when; @@ -4373,7 +4377,7 @@ PP(pp_shmread) PP(pp_shmwrite) { #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) - djSP; dMARK; dTARGET; + dSP; dMARK; dTARGET; I32 value = (I32)(do_shmio(PL_op->op_type, MARK, SP) >= 0); SP = MARK; PUSHi(value); @@ -4398,7 +4402,7 @@ PP(pp_msgctl) PP(pp_msgsnd) { #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) - djSP; dMARK; dTARGET; + dSP; dMARK; dTARGET; I32 value = (I32)(do_msgsnd(MARK, SP) >= 0); SP = MARK; PUSHi(value); @@ -4411,7 +4415,7 @@ PP(pp_msgsnd) PP(pp_msgrcv) { #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) - djSP; dMARK; dTARGET; + dSP; dMARK; dTARGET; I32 value = (I32)(do_msgrcv(MARK, SP) >= 0); SP = MARK; PUSHi(value); @@ -4426,7 +4430,7 @@ PP(pp_msgrcv) PP(pp_semget) { #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) - djSP; dMARK; dTARGET; + dSP; dMARK; dTARGET; int anum = do_ipcget(PL_op->op_type, MARK, SP); SP = MARK; if (anum == -1) @@ -4441,7 +4445,7 @@ PP(pp_semget) PP(pp_semctl) { #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) - djSP; dMARK; dTARGET; + dSP; dMARK; dTARGET; int anum = do_ipcctl(PL_op->op_type, MARK, SP); SP = MARK; if (anum == -1) @@ -4461,7 +4465,7 @@ PP(pp_semctl) PP(pp_semop) { #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) - djSP; dMARK; dTARGET; + dSP; dMARK; dTARGET; I32 value = (I32)(do_semop(MARK, SP) >= 0); SP = MARK; PUSHi(value); @@ -4493,7 +4497,7 @@ PP(pp_ghbyaddr) PP(pp_ghostent) { - djSP; + dSP; #if defined(HAS_GETHOSTBYNAME) || defined(HAS_GETHOSTBYADDR) || defined(HAS_GETHOSTENT) I32 which = PL_op->op_type; register char **elem; @@ -4602,7 +4606,7 @@ PP(pp_gnbyaddr) PP(pp_gnetent) { - djSP; + dSP; #if defined(HAS_GETNETBYNAME) || defined(HAS_GETNETBYADDR) || defined(HAS_GETNETENT) I32 which = PL_op->op_type; register char **elem; @@ -4690,7 +4694,7 @@ PP(pp_gpbynumber) PP(pp_gprotoent) { - djSP; + dSP; #if defined(HAS_GETPROTOBYNAME) || defined(HAS_GETPROTOBYNUMBER) || defined(HAS_GETPROTOENT) I32 which = PL_op->op_type; register char **elem; @@ -4773,7 +4777,7 @@ PP(pp_gsbyport) PP(pp_gservent) { - djSP; + dSP; #if defined(HAS_GETSERVBYNAME) || defined(HAS_GETSERVBYPORT) || defined(HAS_GETSERVENT) I32 which = PL_op->op_type; register char **elem; @@ -4863,7 +4867,7 @@ PP(pp_gservent) PP(pp_shostent) { - djSP; + dSP; #ifdef HAS_SETHOSTENT PerlSock_sethostent(TOPi); RETSETYES; @@ -4874,7 +4878,7 @@ PP(pp_shostent) PP(pp_snetent) { - djSP; + dSP; #ifdef HAS_SETNETENT PerlSock_setnetent(TOPi); RETSETYES; @@ -4885,7 +4889,7 @@ PP(pp_snetent) PP(pp_sprotoent) { - djSP; + dSP; #ifdef HAS_SETPROTOENT PerlSock_setprotoent(TOPi); RETSETYES; @@ -4896,7 +4900,7 @@ PP(pp_sprotoent) PP(pp_sservent) { - djSP; + dSP; #ifdef HAS_SETSERVENT PerlSock_setservent(TOPi); RETSETYES; @@ -4907,7 +4911,7 @@ PP(pp_sservent) PP(pp_ehostent) { - djSP; + dSP; #ifdef HAS_ENDHOSTENT PerlSock_endhostent(); EXTEND(SP,1); @@ -4919,7 +4923,7 @@ PP(pp_ehostent) PP(pp_enetent) { - djSP; + dSP; #ifdef HAS_ENDNETENT PerlSock_endnetent(); EXTEND(SP,1); @@ -4931,7 +4935,7 @@ PP(pp_enetent) PP(pp_eprotoent) { - djSP; + dSP; #ifdef HAS_ENDPROTOENT PerlSock_endprotoent(); EXTEND(SP,1); @@ -4943,7 +4947,7 @@ PP(pp_eprotoent) PP(pp_eservent) { - djSP; + dSP; #ifdef HAS_ENDSERVENT PerlSock_endservent(); EXTEND(SP,1); @@ -4973,7 +4977,7 @@ PP(pp_gpwuid) PP(pp_gpwent) { - djSP; + dSP; #ifdef HAS_PASSWD I32 which = PL_op->op_type; register SV *sv; @@ -5187,7 +5191,7 @@ PP(pp_gpwent) PP(pp_spwent) { - djSP; + dSP; #if defined(HAS_PASSWD) && defined(HAS_SETPWENT) setpwent(); RETPUSHYES; @@ -5198,7 +5202,7 @@ PP(pp_spwent) PP(pp_epwent) { - djSP; + dSP; #if defined(HAS_PASSWD) && defined(HAS_ENDPWENT) endpwent(); RETPUSHYES; @@ -5227,7 +5231,7 @@ PP(pp_ggrgid) PP(pp_ggrent) { - djSP; + dSP; #ifdef HAS_GROUP I32 which = PL_op->op_type; register char **elem; @@ -5286,7 +5290,7 @@ PP(pp_ggrent) PP(pp_sgrent) { - djSP; + dSP; #if defined(HAS_GROUP) && defined(HAS_SETGRENT) setgrent(); RETPUSHYES; @@ -5297,7 +5301,7 @@ PP(pp_sgrent) PP(pp_egrent) { - djSP; + dSP; #if defined(HAS_GROUP) && defined(HAS_ENDGRENT) endgrent(); RETPUSHYES; @@ -5308,7 +5312,7 @@ PP(pp_egrent) PP(pp_getlogin) { - djSP; dTARGET; + dSP; dTARGET; #ifdef HAS_GETLOGIN char *tmps; EXTEND(SP, 1); @@ -5326,7 +5330,7 @@ PP(pp_getlogin) PP(pp_syscall) { #ifdef HAS_SYSCALL - djSP; dMARK; dORIGMARK; dTARGET; + dSP; dMARK; dORIGMARK; dTARGET; register I32 items = SP - MARK; unsigned long a[20]; register I32 i = 0; @@ -4369,7 +4369,7 @@ Perl_sv_clear(pTHX_ register SV *sv) if (SvOBJECT(sv)) { if (PL_defstash) { /* Still have a symbol table? */ - djSP; + dSP; CV* destructor; SV tmpref; @@ -30,7 +30,7 @@ if ($#ARGV == -1) { `echo base/*.t comp/*.t cmd/*.t run/*.t io/*.t; echo op/*.t pragma/*.t lib/*.t pod/*.t`); } -%infinite = ( 'comp/require.t', 1, 'op/bop.t', 1, 'lib/hostname.t', 1 ); +# %infinite = ( 'comp/require.t', 1, 'op/bop.t', 1, 'lib/hostname.t', 1 ); _testprogs('perl', @ARGV); _testprogs('compile', @ARGV) if (-e "../testcompile"); @@ -42,12 +42,12 @@ foreach (keys %datahandle) { Test::Harness::runtests @tests; exit(0) unless -e "../testcompile"; -%infinite = qw ( - op/bop.t 1 - lib/hostname.t 1 - op/lex_assign.t 1 - lib/ph.t 1 - ); +# %infinite = qw ( +# op/bop.t 1 +# lib/hostname.t 1 +# op/lex_assign.t 1 +# lib/ph.t 1 +# ); my $dhwrapper = <<'EOT'; open DATA,"<".__FILE__; diff --git a/t/op/each.t b/t/op/each.t index 397176a40d..2e80dcd009 100755 --- a/t/op/each.t +++ b/t/op/each.t @@ -163,7 +163,7 @@ print "ok 23\n"; print "#$u{$_}\n" for keys %u; # Used to core dump before change #8056. print "ok 24\n"; -$d = qu"\xe3\x81\x82"; +$d = pack("U*", 0xe3, 0x81, 0x82); %u = ($d => "downgrade"); for (keys %u) { use bytes; @@ -172,6 +172,6 @@ for (keys %u) { } { use bytes; - print "not " if length($d) ne 6 or $d ne qu"\xe3\x81\x82"; + print "not " if length($d) ne 6; print "ok 26\n"; } diff --git a/t/op/length.t b/t/op/length.t index 46f0c59698..df80fcd039 100644 --- a/t/op/length.t +++ b/t/op/length.t @@ -33,7 +33,7 @@ print "ok 3\n"; } { - my $a = qu"\x{80}"; # make "\x{80}" to produce UTF-8 + my $a = pack("U", 0x80); print "not " unless length($a) == 1; print "ok 6\n"; diff --git a/t/op/pack.t b/t/op/pack.t index 3483597fbe..67bd547c5b 100755 --- a/t/op/pack.t +++ b/t/op/pack.t @@ -6,7 +6,7 @@ BEGIN { require Config; import Config; } -print "1..163\n"; +print "1..159\n"; $format = "c2 x5 C C x s d i l a6"; # Need the expression in here to force ary[5] to be numeric. This avoids @@ -22,13 +22,7 @@ $out2=join(':',@ary2); # Using long double NVs may introduce greater accuracy than wanted. $out1 =~ s/:9\.87654321097999\d*:/:9.87654321098:/; $out2 =~ s/:9\.87654321097999\d*:/:9.87654321098:/; -if ($out1 eq $out2) { - print "ok 2\n"; -} else { - print "# out1: $out1\n"; - print "# out2: $out2\n"; - print "not ok 2\n"; -} +print ($out1 eq $out2? "ok 2\n" : "not ok 2\n"); print ($foo =~ /def/ ? "ok 3\n" : "not ok 3\n"); @@ -413,8 +407,6 @@ $z = pack <<EOP,'string','etc'; EOP print 'not ' unless $z eq "\000\006string\003etc"; print "ok $test\n"; $test++; -# 157..169: ??? - print 'not ' unless "1.20.300.4000" eq sprintf "%vd", pack("U*",1,20,300,4000); print "ok $test\n"; $test++; print 'not ' unless "1.20.300.4000" eq @@ -424,32 +416,3 @@ print 'not ' unless v1.20.300.4000 ne sprintf "%vd", pack("C0U*",1,20,300,4000); print "ok $test\n"; $test++; -# 160: unpack("C") and ord() equivalence for Unicode - -print "not " unless unpack("C", chr(0x100)) eq ord(chr(0x100)) && - ord(chr(0x100)) == 0x100; -print "ok $test\n"; $test++; - -# 161: use bytes + unpack C == UTF-8 unraveling - -{ - use bytes; - my @bytes = unpack("C*", pack("U", 0x100)); - print "not " unless "@bytes" eq "196 128"; - print "ok $test\n"; $test++; -} - -# 162: pack C > 255 - -print "not " unless ord(pack("C", 0x100)) == 0x100; -print "ok $test\n"; $test++; - -# 163: pack C > 255 + use bytes == wraparound - -{ - use bytes; - - print "not " unless ord(pack("C", 0x100 + 0xab)) == 0xab; - print "ok $test\n"; $test++; -} - diff --git a/t/op/qu.t b/t/op/qu.t deleted file mode 100644 index c24b507022..0000000000 --- a/t/op/qu.t +++ /dev/null @@ -1,36 +0,0 @@ -print "1..6\n"; - - -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} - -my $foo = "foo"; - -print "not " unless qu(abc$foo) eq "abcfoo"; -print "ok 1\n"; - -# qu is always Unicode, even in EBCDIC, so \x41 is 'A' and \x{61} is 'a'. - -print "not " unless qu(abc\x41) eq "abcA"; -print "ok 2\n"; - -print "not " unless qu(abc\x{61}$foo) eq "abcafoo"; -print "ok 3\n"; - -print "not " unless qu(\x{41}\x{100}\x61\x{200}) eq "A\x{100}a\x{200}"; -print "ok 4\n"; - -{ - -use bytes; - -print "not " unless join(" ", unpack("C*", qu(\x80))) eq "194 128"; -print "ok 5\n"; - -print "not " unless join(" ", unpack("C*", qu(\x{100}))) eq "196 128"; -print "ok 6\n"; - -} - @@ -387,6 +387,8 @@ Perl_lex_start(pTHX_ SV *line) SAVEPPTR(PL_bufend); SAVEPPTR(PL_oldbufptr); SAVEPPTR(PL_oldoldbufptr); + SAVEPPTR(PL_last_lop); + SAVEPPTR(PL_last_uni); SAVEPPTR(PL_linestart); SAVESPTR(PL_linestr); SAVEPPTR(PL_lex_brackstack); @@ -429,6 +431,7 @@ Perl_lex_start(pTHX_ SV *line) SvTEMP_off(PL_linestr); PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr); PL_bufend = PL_bufptr + SvCUR(PL_linestr); + PL_last_lop = PL_last_uni = Nullch; SvREFCNT_dec(PL_rs); PL_rs = newSVpvn("\n", 1); PL_rsfp = 0; @@ -574,6 +577,7 @@ S_skipspace(pTHX_ register char *s) PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart = SvPVX(PL_linestr); PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); + PL_last_lop = PL_last_uni = Nullch; /* Close the filehandle. Could be from -P preprocessor, * STDIN, or a regular file. If we were reading code from @@ -1031,6 +1035,8 @@ S_sublex_push(pTHX) SAVEPPTR(PL_bufptr); SAVEPPTR(PL_oldbufptr); SAVEPPTR(PL_oldoldbufptr); + SAVEPPTR(PL_last_lop); + SAVEPPTR(PL_last_uni); SAVEPPTR(PL_linestart); SAVESPTR(PL_linestr); SAVEPPTR(PL_lex_brackstack); @@ -1042,6 +1048,7 @@ S_sublex_push(pTHX) PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart = SvPVX(PL_linestr); PL_bufend += SvCUR(PL_linestr); + PL_last_lop = PL_last_uni = Nullch; SAVEFREESV(PL_linestr); PL_lex_dojoin = FALSE; @@ -1093,6 +1100,7 @@ S_sublex_done(pTHX) PL_lex_inpat = 0; PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart = SvPVX(PL_linestr); PL_bufend += SvCUR(PL_linestr); + PL_last_lop = PL_last_uni = Nullch; SAVEFREESV(PL_linestr); PL_lex_dojoin = FALSE; PL_lex_brackets = 0; @@ -2558,6 +2566,7 @@ Perl_yylex(pTHX) sv_catpv(PL_linestr, "\n"); PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr); PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); + PL_last_lop = PL_last_uni = Nullch; if (PERLDB_LINE && PL_curstash != PL_debstash) { SV *sv = NEWSV(85,0); @@ -2586,10 +2595,12 @@ Perl_yylex(pTHX) sv_catpv(PL_linestr,";}"); PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr); PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); + PL_last_lop = PL_last_uni = Nullch; PL_minus_n = PL_minus_p = 0; goto retry; } PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr); + PL_last_lop = PL_last_uni = Nullch; sv_setpv(PL_linestr,""); TOKEN(';'); /* not infinite loop because rsfp is NULL now */ } @@ -2632,6 +2643,7 @@ Perl_yylex(pTHX) sv_setpv(PL_linestr, ""); PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr); PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); + PL_last_lop = PL_last_uni = Nullch; PL_doextract = FALSE; } } @@ -2646,6 +2658,7 @@ Perl_yylex(pTHX) av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv); } PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); + PL_last_lop = PL_last_uni = Nullch; if (CopLINE(PL_curcop) == 1) { while (s < PL_bufend && isSPACE(*s)) s++; @@ -2789,6 +2802,7 @@ Perl_yylex(pTHX) sv_setpv(PL_linestr, ""); PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr); PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); + PL_last_lop = PL_last_uni = Nullch; PL_preambled = FALSE; if (PERLDB_LINE) (void)gv_fetchfile(PL_origfilename); @@ -3678,7 +3692,7 @@ Perl_yylex(pTHX) case '\'': s = scan_str(s,FALSE,FALSE); DEBUG_T( { PerlIO_printf(Perl_debug_log, - "### Saw string in '%s'\n", s); + "### Saw string before '%s'\n", s); } ) if (PL_expect == XOPERATOR) { if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) { @@ -3697,7 +3711,7 @@ Perl_yylex(pTHX) case '"': s = scan_str(s,FALSE,FALSE); DEBUG_T( { PerlIO_printf(Perl_debug_log, - "### Saw string in '%s'\n", s); + "### Saw string before '%s'\n", s); } ) if (PL_expect == XOPERATOR) { if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) { @@ -3722,7 +3736,7 @@ Perl_yylex(pTHX) case '`': s = scan_str(s,FALSE,FALSE); DEBUG_T( { PerlIO_printf(Perl_debug_log, - "### Saw backtick string in '%s'\n", s); + "### Saw backtick string before '%s'\n", s); } ) if (PL_expect == XOPERATOR) no_op("Backticks",s); @@ -4744,11 +4758,7 @@ Perl_yylex(pTHX) TOKEN('('); case KEY_qq: - case KEY_qu: s = scan_str(s,FALSE,FALSE); - if (tmp == KEY_qu && - is_utf8_string((U8*)SvPVX(PL_lex_stuff), SvCUR(PL_lex_stuff))) - SvUTF8_on(PL_lex_stuff); if (!s) missingterm((char*)0); yylval.ival = OP_STRINGIFY; @@ -5581,7 +5591,6 @@ Perl_keyword(pTHX_ register char *d, I32 len) if (strEQ(d,"q")) return KEY_q; if (strEQ(d,"qr")) return KEY_qr; if (strEQ(d,"qq")) return KEY_qq; - if (strEQ(d,"qu")) return KEY_qu; if (strEQ(d,"qw")) return KEY_qw; if (strEQ(d,"qx")) return KEY_qx; } @@ -6449,6 +6458,7 @@ S_scan_heredoc(pTHX_ register char *s) sv_setsv(PL_linestr,herewas); PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart = SvPVX(PL_linestr); PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); + PL_last_lop = PL_last_uni = Nullch; } else sv_setpvn(tmpstr,"",0); /* avoid "uninitialized" warning */ @@ -6460,6 +6470,7 @@ S_scan_heredoc(pTHX_ register char *s) } CopLINE_inc(PL_curcop); PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); + PL_last_lop = PL_last_uni = Nullch; #ifndef PERL_STRICT_CR if (PL_bufend - PL_linestart >= 2) { if ((PL_bufend[-2] == '\r' && PL_bufend[-1] == '\n') || @@ -6818,6 +6829,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) /* having changed the buffer, we must update PL_bufend */ PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); + PL_last_lop = PL_last_uni = Nullch; } /* at this point, we have successfully read the delimited string */ @@ -7334,6 +7346,7 @@ S_scan_formline(pTHX_ register char *s) s = filter_gets(PL_linestr, PL_rsfp, 0); PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr); PL_bufend = PL_bufptr + SvCUR(PL_linestr); + PL_last_lop = PL_last_uni = Nullch; if (!s) { s = PL_bufptr; yyerror("Format not terminated"); diff --git a/utils/Makefile b/utils/Makefile index 95d286efb8..ec26cd8fdc 100644 --- a/utils/Makefile +++ b/utils/Makefile @@ -7,12 +7,20 @@ REALPERL = ../perl pl = c2ph.PL h2ph.PL h2xs.PL perlbug.PL perldoc.PL pl2pm.PL splain.PL perlcc.PL dprofpp.PL plextract = c2ph h2ph h2xs perlbug perldoc pl2pm splain perlcc dprofpp -plextractexe = c2ph.exe h2ph.exe h2xs.exe perlbug.exe perldoc.exe pl2pm.exe splain.exe perlcc.exe dprofpp.exe +plextractexe = ./c2ph ./h2ph ./h2xs ./perlbug ./perldoc ./pl2pm ./splain ./perlcc ./dprofpp all: $(plextract) -compile: all - $(REALPERL) -I../lib perlcc -opt -regex 's/$$/.exe/' $(plextract) -prog -verbose dcf -log ../compilelog; +compile: all $(plextract) + $(REALPERL) -I../lib perlcc c2ph -o c2ph.exe -v 10 -log ../compilelog; + $(REALPERL) -I../lib perlcc h2ph -o h2ph.exe -v 10 -log ../compilelog; + $(REALPERL) -I../lib perlcc h2xs -o h2xs.exe -v 10 -log ../compilelog; + $(REALPERL) -I../lib perlcc perlbug -o perlbug.exe -v 10 -log ../compilelog; + $(REALPERL) -I../lib perlcc perldoc -o perldoc.exe -v 10 -log ../compilelog; + $(REALPERL) -I../lib perlcc pl2pm -o pl2pm.exe -v 10 -log ../compilelog; + $(REALPERL) -I../lib perlcc splain -o splain.exe -v 10 -log ../compilelog; + $(REALPERL) -I../lib perlcc perlcc -o perlcc.exe -v 10 -log ../compilelog; + $(REALPERL) -I../lib perlcc dprofpp -o dprofpp.exe -v 10 -log ../compilelog; $(plextract): $(PERL) -I../lib $@.PL diff --git a/utils/perlcc.PL b/utils/perlcc.PL index a9501305c8..63045559d8 100644 --- a/utils/perlcc.PL +++ b/utils/perlcc.PL @@ -41,18 +41,22 @@ print OUT <<'!NO!SUBS!'; # Version 2.0, Simon Cozens, Thu Mar 30 17:52:45 JST 2000 # Version 2.01, Tom Christiansen, Thu Mar 30 08:25:14 MST 2000 # Version 2.02, Simon Cozens, Sun Apr 16 01:53:36 JST 2000 +# Version 2.03, Edward Peschko, Mon Feb 26 12:04:17 PST 2001 use strict; use warnings; use v5.6.0; +use FileHandle; use Config; use Fcntl qw(:DEFAULT :flock); use File::Temp qw(tempfile); use Cwd; -our $VERSION = 2.02; +our $VERSION = 2.03; $| = 1; +$SIG{INT} = sub { exit(); }; # exit gracefully and clean up after ourselves. + use subs qw{ cc_harness check_read check_write checkopts_byte choose_backend compile_byte compile_cstyle compile_module generate_code @@ -62,18 +66,20 @@ sub opt(*); # imal quoting our ($Options, $BinPerl, $Backend); our ($Input => $Output); +our ($logfh); +our ($cfile); # eval { main(); 1 } or die; main(); -sub main { +sub main { parse_argv(); check_write($Output); choose_backend(); generate_code(); - die "XXX: Not reached?"; - exit(0); + run_code(); + _die("XXX: Not reached?"); } ####################################################################### @@ -108,7 +114,13 @@ sub generate_code { compile_cstyle(); } } + exit(0) if (!opt('r')); +} +sub run_code { + vprint 0, "Running code"; + run("$Output @ARGV"); + exit(0); } # usage: vprint [level] msg args @@ -124,13 +136,18 @@ sub vprint { } my $msg = "@_"; $msg .= "\n" unless substr($msg, -1) eq "\n"; - print "$0: $msg" if opt(v) > $level; -} + if (opt(v) > $level) + { + print "$0: $msg" if !opt('log'); + print $logfh "$0: $msg" if opt('log'); + } +} sub parse_argv { use Getopt::Long; - Getopt::Long::Configure("bundling"); +# Getopt::Long::Configure("bundling"); turned off. this is silly because +# it doesn't allow for long switches. Getopt::Long::Configure("no_ignore_case"); # no difference in exists and defined for %ENV; also, a "0" @@ -142,33 +159,38 @@ sub parse_argv { 'L:s', # lib directory 'I:s', # include directories (FOR C, NOT FOR PERL) 'o:s', # Output executable - 'v+', # Verbosity level + 'v:i', # Verbosity level 'e:s', # One-liner + 'r', # run resulting executable 'B', # Byte compiler backend 'O', # Optimised C backend 'c', # Compile only 'h', # Help me 'S', # Dump C files - 's:s', # Dirty hack to enable -shared/-static + 'r', # run the resulting executable + 'static', # Dirty hack to enable -shared/-static 'shared', # Create a shared library (--shared for compat.) + 'log:s' # where to log compilation process information ); # This is an attempt to make perlcc's arg. handling look like cc. - if ( opt('s') ) { # must quote: looks like s)foo)bar)! - if (opt('s') eq 'hared') { - $Options->{shared}++; - } elsif (opt('s') eq 'tatic') { - $Options->{static}++; - } else { - warn "$0: Unknown option -s", opt('s'); - } - } + # if ( opt('s') ) { # must quote: looks like s)foo)bar)! + # if (opt('s') eq 'hared') { + # $Options->{shared}++; + # } elsif (opt('s') eq 'tatic') { + # $Options->{static}++; + # } else { + # warn "$0: Unknown option -s", opt('s'); + # } + # } $Options->{v} += 0; helpme() if opt(h); # And exit $Output = opt(o) || 'a.out'; + $Output = relativize($Output); + $logfh = new FileHandle(">> " . opt('log')) if (opt('log')); if (opt(e)) { warn "$0: using -e 'code' as input file, ignoring @ARGV\n" if @ARGV; @@ -177,7 +199,7 @@ sub parse_argv { $Input = "-e '".opt(e)."'"; # Quotes eaten by shell } else { $Input = shift @ARGV; # XXX: more files? - die "$0: No input file specified\n" unless $Input; + _usage_and_die("$0: No input file specified\n") unless $Input; # DWIM modules. This is bad but necessary. $Options->{shared}++ if $Input =~ /\.pm\z/; warn "$0: using $Input as input file, ignoring @ARGV\n" if @ARGV; @@ -234,18 +256,18 @@ EOF my ($output_r, $error_r) = spawnit($command); if (@$error_r && $? != 0) { - die "$0: $Input did not compile, which can't happen:\n@$error_r\n"; + _die("$0: $Input did not compile, which can't happen:\n@$error_r\n"); } else { my @error = grep { !/^$Input syntax OK$/o } @$error_r; warn "$0: Unexpected compiler output:\n@error" if @error; } # Write it and leave. - print OUT @$output_r or die "can't write $Output: $!"; - close OUT or die "can't close $Output: $!"; + print OUT @$output_r or _die("can't write $Output: $!"); + close OUT or _die("can't close $Output: $!"); # wait, how could it be anything but what you see next? - chmod 0777 & ~umask, $Output or die "can't chmod $Output: $!"; + chmod 0777 & ~umask, $Output or _die("can't chmod $Output: $!"); exit 0; } @@ -253,8 +275,9 @@ sub compile_cstyle { my $stash = grab_stash(); # What are we going to call our output C file? - my ($cfile,$cfh); my $lose = 0; + my ($cfh); + if (opt(S) || opt(c)) { # We need to keep it. if (opt(e)) { @@ -292,16 +315,15 @@ sub compile_cstyle { my @error = @$error_r; if (@error && $? != 0) { - die "$0: $Input did not compile, which can't happen:\n@error\n"; + _die("$0: $Input did not compile, which can't happen:\n@error\n"); } cc_harness($cfile,$stash) unless opt(c); if ($lose) { vprint 2, "unlinking $cfile"; - unlink $cfile or die "can't unlink $cfile: $!" if $lose; + unlink $cfile or _die("can't unlink $cfile: $!"); } - exit(0); } sub cc_harness { @@ -312,8 +334,8 @@ sub cc_harness { $command .= " -L".$_ for split /\s+/, opt(L); my @mods = split /-?u /, $stash; $command .= " ".ExtUtils::Embed::ldopts("-std", \@mods); - vprint 3, "running cc $command"; - system("cc $command"); + vprint 3, "running $Config{cc} $command"; + system("$Config{cc} $command"); } # Where Perl is, and which include path to give it. @@ -351,7 +373,7 @@ sub yclept { my @error = @$error_r; if (@error && $? != 0) { - die "$0: $Input did not compile:\n@error\n"; + _die("$0: $Input did not compile:\n@error\n"); } $stash[0] =~ s/,-u\<none\>//; @@ -366,7 +388,7 @@ sub yclept { # To wit, (-B|-O) ==> no -shared, no -S, no -c sub checkopts_byte { - die "$0: Please choose one of either -B and -O.\n" if opt(O); + _die("$0: Please choose one of either -B and -O.\n") if opt(O); if (opt(shared)) { warn "$0: Will not create a shared library for bytecode\n"; @@ -387,8 +409,8 @@ sub checkopts_byte { sub sanity_check { if ($Input eq $Output) { if ($Input eq 'a.out') { - warn "$0: Compiling a.out is probably not what you want to do.\n"; - # You fully deserve what you get now. + _die("$0: Compiling a.out is probably not what you want to do.\n"); + # You fully deserve what you get now. No you *don't*. typos happen. } else { warn "$0: Will not write output on top of input file, ", "compiling to a.out instead\n"; @@ -400,11 +422,11 @@ sub sanity_check { sub check_read { my $file = shift; unless (-r $file) { - die "$0: Input file $file is a directory, not a file\n" if -d _; + _die("$0: Input file $file is a directory, not a file\n") if -d _; unless (-e _) { - die "$0: Input file $file was not found\n"; + _die("$0: Input file $file was not found\n"); } else { - die "$0: Cannot read input file $file: $!\n"; + _die("$0: Cannot read input file $file: $!\n"); } } unless (-f _) { @@ -416,13 +438,13 @@ sub check_read { sub check_write { my $file = shift; if (-d $file) { - die "$0: Cannot write on $file, is a directory\n"; + _die("$0: Cannot write on $file, is a directory\n"); } if (-e _) { - die "$0: Cannot write on $file: $!\n" unless -w _; + _die("$0: Cannot write on $file: $!\n") unless -w _; } unless (-w cwd()) { - die "$0: Cannot write in this directory: $!\n" + _die("$0: Cannot write in this directory: $!\n"); } } @@ -432,13 +454,13 @@ sub check_perl { warn "$0: Binary `$file' sure doesn't smell like perl source!\n"; print "Checking file type... "; system("file", $file); - die "Please try a perlier file!\n"; + _die("Please try a perlier file!\n"); } - open(my $handle, "<", $file) or die "XXX: can't open $file: $!"; + open(my $handle, "<", $file) or _die("XXX: can't open $file: $!"); local $_ = <$handle>; if (/^#!/ && !/perl/) { - die "$0: $file is a ", /^#!\s*(\S+)/, " script, not perl\n"; + _die("$0: $file is a ", /^#!\s*(\S+)/, " script, not perl\n"); } } @@ -451,14 +473,14 @@ sub spawnit { (undef, $errname) = tempfile("pccXXXXX"); { open (S_OUT, "$command 2>$errname |") - or die "$0: Couldn't spawn the compiler.\n"; + or _die("$0: Couldn't spawn the compiler.\n"); @output = <S_OUT>; } - open (S_ERROR, $errname) or die "$0: Couldn't read the error file.\n"; + open (S_ERROR, $errname) or _die("$0: Couldn't read the error file.\n"); @error = <S_ERROR>; close S_ERROR; close S_OUT; - unlink $errname or die "$0: Can't unlink error file $errname"; + unlink $errname or _die("$0: Can't unlink error file $errname"); return (\@output, \@error); } @@ -471,6 +493,72 @@ sub helpme { } } +sub relativize { + my ($args) = @_; + + return() if ($args =~ m"^[/\\]"); + return("./$args"); +} + +sub _die { + $logfh->print(@_) if opt('log'); + print STDERR @_; + exit(); # should die eventually. However, needed so that a 'make compile' + # can compile all the way through to the end for standard dist. +} + +sub _usage_and_die { + _die(<<EOU); +$0: Usage: +$0 [-o executable] [-r] [-O|-B|-c|-S] [-log log] [source[.pl] | -e oneliner] +EOU +} + +sub run { + my (@commands) = @_; + + print interruptrun(@commands) if (!opt('log')); + $logfh->print(interruptrun(@commands)) if (opt('log')); +} + +sub interruptrun +{ + my (@commands) = @_; + + my $command = join('', @commands); + local(*FD); + my $pid = open(FD, "$command |"); + my $text; + + local($SIG{HUP}) = sub { kill 9, $pid; exit }; + local($SIG{INT}) = sub { kill 9, $pid; exit }; + + my $needalarm = + ($ENV{PERLCC_TIMEOUT} && + $Config{'osname'} ne 'MSWin32' && + $command =~ m"(^|\s)perlcc\s"); + + eval + { + local($SIG{ALRM}) = sub { die "INFINITE LOOP"; }; + alarm($ENV{PERLCC_TIMEOUT}) if ($needalarm); + $text = join('', <FD>); + alarm(0) if ($needalarm); + }; + + if ($@) + { + eval { kill 'HUP', $pid }; + vprint 0, "SYSTEM TIMEOUT (infinite loop?)\n"; + } + + close(FD); + return($text); +} + +END { + unlink $cfile if ($cfile && !opt(S) && !opt(c)); +} __END__ @@ -493,7 +581,15 @@ perlcc - generate executables from Perl programs $ perlcc -e 'print q//' # Compiles a one-liner into 'a.out' $ perlcc -c -e 'print q//' # Creates a C file 'a.out.c' - + + $ perlcc -r hello # compiles 'hello' into 'a.out', runs 'a.out'. + + $ perlcc -r hello a b c # compiles 'hello' into 'a.out', runs 'a.out'. + # with arguments 'a b c' + + $ perlcc hello -log c # compiles 'hello' into 'a.out' logs compile + # log into 'c'. + =head1 DESCRIPTION F<perlcc> creates standalone executables from Perl programs, using the @@ -551,6 +647,14 @@ compile in finite time and memory, or indeed, at all. Increase verbosity of output; can be repeated for more verbose output. +=item -r + +Run the resulting compiled script after compiling it. + +=item -log + +Log the output of compiling to a file rather than to stdout. + =back =cut diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template index 35f66762ef..aabbe226c1 100644 --- a/vms/descrip_mms.template +++ b/vms/descrip_mms.template @@ -353,7 +353,7 @@ all : base extras x2p archcorefiles preplibrary perlpods .endif base : miniperl perl @ $(NOOP) -extras : dynext libmods utils podxform +extras : dynext libmods utils podxform extra.pods @ $(NOOP) libmods : $(LIBPREREQ) @ $(NOOP) @@ -363,6 +363,8 @@ podxform : [.lib.pod]pod2text.com [.lib.pod]pod2html.com [.lib.pod]pod2latex.com @ $(NOOP) x2p : [.x2p]a2p$(E) [.x2p]s2p.com [.x2p]find2perl.com @ $(NOOP) +extra.pods : miniperl + @ @extra_pods.com pod0 = [.lib.pod]perl.pod [.lib.pod]perl5004delta.pod [.lib.pod]perl5005delta.pod pod1 = [.lib.pod]perlapi.pod [.lib.pod]perlapio.pod [.lib.pod]perlbook.pod @@ -1276,6 +1278,7 @@ clean : tidy cleantest - If F$Search("[.VMS.Ext...]*.C").nes."" Then Delete/NoConfirm/Log [.VMS.Ext...]*.C;* - If F$Search("[.VMS.Ext...]*$(O)").nes."" Then Delete/NoConfirm/Log [.VMS.Ext...]*$(O);* - If F$Search("[.pod]*.com").nes."" Then Delete/NoConfirm/Log [.pod]*.com;* + - @extra_pods CLEAN realclean : clean - @make_ext "$(dynamic_ext)" "$(MINIPERL_EXE)" "$(MMS)" realclean @@ -1286,6 +1289,7 @@ realclean : clean - $(MINIPERL) -e "use File::Path; rmtree(\@ARGV,1,0);" config - If F$Search("Descrip.MMS").nes."" Then Delete/NoConfirm/Log Descrip.MMS;* - If F$Search("make_ext.Com").nes."" Then Delete/NoConfirm/Log make_ext.Com;* + - If F$Search("extra_pods.Com").nes."" Then Delete/NoConfirm/Log extra_pods.Com;* - $(MINIPERL) -e "use File::Path; rmtree(['lib/auto','lib/VMS','lib/$(ARCH)'],1,0);" - If F$Search("*.TS").nes."" Then Delete/NoConfirm/Log *.TS;* - If F$Search("[.Lib]DynaLoader.pm").nes."" Then Delete/NoConfirm/Log [.Lib]DynaLoader.pm;* diff --git a/vms/ext/DCLsym/DCLsym.pm b/vms/ext/DCLsym/DCLsym.pm index 99adb94522..9f88c91db2 100644 --- a/vms/ext/DCLsym/DCLsym.pm +++ b/vms/ext/DCLsym/DCLsym.pm @@ -201,7 +201,7 @@ can also call methods directly to manipulate individual symbols. In some cases, this allows you finer control than using a tied hash aggregate. The following methods are supported: -=over +=over 4 =item new @@ -254,6 +254,8 @@ This method is a stopgap until we can incorporate code into this extension to traverse the process' symbol table directly, so it may disappear in a future version of this package. +=back + =head1 AUTHOR Charles Bailey bailey@newman.upenn.edu diff --git a/vms/ext/Stdio/Stdio.pm b/vms/ext/Stdio/Stdio.pm index 446b0785e1..e36a3ec15b 100644 --- a/vms/ext/Stdio/Stdio.pm +++ b/vms/ext/Stdio/Stdio.pm @@ -146,7 +146,7 @@ VMS::Stdio function. This compatibility interface will be removed in a future release of this extension, so please update your code to use the new routines. -=over +=over 4 =item binmode @@ -240,9 +240,7 @@ as a normal Perl file handle only. When the scalar containing a VMS::Stdio file handle is overwritten, C<undef>d, or goes out of scope, the associated file is closed automatically. -=over 4 - -=head2 File characteristic options +File characteristic options: =over 2 @@ -605,8 +603,6 @@ I/O timeout value =back -=back - =item vmssysopen This function bears the same relationship to the CORE function @@ -634,6 +630,8 @@ subprocess through a pipe opened for writing without closing the pipe. It returns a true value if successful, and C<undef> if it encounters an error. +=back + =head1 REVISION This document was last revised on 13-Oct-1998, for Perl 5.004, 5.005, and diff --git a/warnings.pl b/warnings.pl index 3a5037d40d..138b1db5af 100644 --- a/warnings.pl +++ b/warnings.pl @@ -172,8 +172,8 @@ if (@ARGV && $ARGV[0] eq "tree") exit ; } -#unlink "warnings.h"; -#unlink "lib/warnings.pm"; +unlink "warnings.h"; +unlink "lib/warnings.pm"; open(WARN, ">warnings.h") || die "Can't create warnings.h: $!\n"; open(PM, ">lib/warnings.pm") || die "Can't create lib/warnings.pm: $!\n"; diff --git a/win32/perlhost.h b/win32/perlhost.h index a260d0895d..7fcd5340b4 100644 --- a/win32/perlhost.h +++ b/win32/perlhost.h @@ -1683,7 +1683,7 @@ win32_start_child(LPVOID arg) /* push a zero on the stack (we are the child) */ { - djSP; + dSP; dTARGET; PUSHi(0); PUTBACK; diff --git a/win32/pod.mak b/win32/pod.mak index b1a1b9c56a..cd00eea249 100644 --- a/win32/pod.mak +++ b/win32/pod.mak @@ -323,6 +323,7 @@ podselect: podselect.PL ../lib/Config.pm $(PERL) -I ../lib podselect.PL compile: all - $(REALPERL) -I../lib ../utils/perlcc -regex 's/$$/.exe/' pod2latex pod2man pod2text checkpods -prog -verbose dcf -log ../compilelog; - - + $(REALPERL) -I../lib ../utils/perlcc pod2latex -o pod2latex.exe -v 10 -log ../compilelog + $(REALPERL) -I../lib ../utils/perlcc pod2man -o pod2man.exe -v 10 -log ../compilelog + $(REALPERL) -I../lib ../utils/perlcc pod2text -o pod2text.exe -v 10 -log ../compilelog + $(REALPERL) -I../lib ../utils/perlcc checkpods -o checkpods.exe -v 10 -log ../compilelog diff --git a/x2p/a2p.pod b/x2p/a2p.pod index f6395a4625..0506e2d827 100644 --- a/x2p/a2p.pod +++ b/x2p/a2p.pod @@ -47,12 +47,12 @@ tells a2p to use old awk behavior. The only current differences are: =over 5 -=item +=item * Old awk always has a line loop, even if there are no line actions, whereas new awk does not. -=item +=item * In old awk, sprintf is extremely greedy about its arguments. For example, given the statement @@ -64,6 +64,8 @@ considers them arguments to C<print>. =back +=back + =head2 "Considerations" A2p cannot do as good a job translating as a human would, but it |