This patch describes the changes made in ActivePerl build 802 over the official Perl v5.8.0 sources from CPAN. Summary of changes in build 802: * Make "perl -V" output reflect ActiveState build. * Add Win32::BuildNumber() for compatibility. * Add resources to perl.exe and perl58.dll. Detailed logs are at the end of this file. The ActivePerl Release Notes contain an informal summary of these changes. These can be viewed at: http://www.ActiveState.com/ActivePerl/docs/CHANGES.html The included patch may be applied to Perl v5.8.0 sources using the GNU patch utility. e.g: % cd perl-5.8.0 % patch -lNp1 < this_file --------------------------------------------------------------------------- diff -ruN perl-5.8.0/BuildInfo.h AP802_source/BuildInfo.h --- perl-5.8.0/BuildInfo.h Wed Dec 31 16:00:00 1969 +++ AP802_source/BuildInfo.h Thu Nov 7 17:44:38 2002 @@ -0,0 +1,25 @@ +/* BuildInfo.h + * + * Copyright (c) 1998-2002 ActiveState Corp. All rights reserved. + * + */ + +#ifndef ___BuildInfo__h___ +#define ___BuildInfo__h___ + +#define PRODUCT_BUILD_NUMBER "802" +#define PERLFILEVERSION "5,8,0,802\0" +#define PERLRC_VERSION 5,8,0,802 +#define ACTIVEPERL_CHANGELIST "" +#define PERLPRODUCTVERSION "Build " PRODUCT_BUILD_NUMBER ACTIVEPERL_CHANGELIST "\0" +#define PERLPRODUCTNAME "ActivePerl\0" + +#define PERL_VENDORLIB_NAME "ActiveState" + +#define ACTIVEPERL_VERSION "Built " __TIME__ " " __DATE__ "\n" +#define ACTIVEPERL_LOCAL_PATCHES_ENTRY "ActivePerl Build " PRODUCT_BUILD_NUMBER ACTIVEPERL_CHANGELIST +#define BINARY_BUILD_NOTICE printf("\n\ +Binary build " PRODUCT_BUILD_NUMBER ACTIVEPERL_CHANGELIST " provided by ActiveState Corp. http://www.ActiveState.com\n\ +" ACTIVEPERL_VERSION "\n"); + +#endif /* ___BuildInfo__h___ */ diff -ruN perl-5.8.0/Configure AP802_source/Configure --- perl-5.8.0/Configure Fri Jul 19 09:35:18 2002 +++ AP802_source/Configure Thu Jul 18 22:15:13 2002 @@ -9378,6 +9378,8 @@ eval $inlibc : Look for GNU-cc style attribute checking +case "$d_attribut" in +'') echo " " echo "Checking whether your compiler can handle __attribute__ ..." >&4 $cat >attrib.c <<'EOCP' @@ -9396,6 +9398,9 @@ echo "Your C compiler doesn't seem to understand __attribute__ at all." val="$undef" fi +;; +*) val="$d_attribut" ;; +esac set d_attribut eval $setvar $rm -f attrib* diff -ruN perl-5.8.0/INSTALL AP802_source/INSTALL --- perl-5.8.0/INSTALL Fri Jul 19 09:35:21 2002 +++ AP802_source/INSTALL Thu Nov 7 17:44:38 2002 @@ -1550,10 +1550,22 @@ installed. It installs a /usr/local/include/arpa/inet.h that refers to these symbols. Versions of BIND later than 8.1 do not install inet.h in that location and avoid the errors. You should probably update to a -newer version of BIND. If you can't, you can either link with the -updated resolver library provided with BIND 8.1 or rename -/usr/local/bin/arpa/inet.h during the Perl build and test process to -avoid the problem. +newer version of BIND (and remove the files the old one left behind). +If you can't, you can either link with the updated resolver library provided +with BIND 8.1 or rename /usr/local/bin/arpa/inet.h during the Perl build and +test process to avoid the problem. + +=item *_r() prototype NOT found + +On a related note, if you see a bunch of complaints like the above about +reentrant functions - specifically networking-related ones - being present +but without prototypes available, check to see if BIND 8.1 (or possibly +other BIND 8 versions) is (or has been) installed. They install +header files such as netdb.h into places such as /usr/local/include (or into +another directory as specified at build/install time), at least optionally. +Remove them or put them in someplace that isn't in the C preprocessor's +header file include search path (determined by -I options plus defaults, +normally /usr/include). =item #error "No DATAMODEL_NATIVE specified" diff -ruN perl-5.8.0/MANIFEST AP802_source/MANIFEST --- perl-5.8.0/MANIFEST Fri Jul 19 09:35:22 2002 +++ AP802_source/MANIFEST Thu Nov 7 17:44:38 2002 @@ -569,6 +569,7 @@ ext/re/re.xs re extension external subroutines ext/Safe/safe1.t See if Safe works ext/Safe/safe2.t See if Safe works +ext/Safe/safe3.t See if Safe works ext/SDBM_File/Makefile.PL SDBM extension makefile writer ext/SDBM_File/sdbm.t See if SDBM_File works ext/SDBM_File/sdbm/biblio SDBM kit @@ -2545,12 +2546,14 @@ t/op/reverse.t See if reverse operator works t/op/re_tests Regular expressions for regexp.t t/op/runlevel.t See if die() works from perl_call_*() +t/op/sig.t See if signals work t/op/sleep.t See if sleep works t/op/sort.t See if sort works t/op/splice.t See if splice works t/op/split.t See if split works t/op/sprintf.t See if sprintf works t/op/srand.t See if srand works +t/op/stash.t See if %:: stashes work t/op/stat.t See if stat works t/op/study.t See if study works t/op/subst.t See if substitution works diff -ruN perl-5.8.0/README.aix AP802_source/README.aix --- perl-5.8.0/README.aix Fri Jul 19 09:35:24 2002 +++ AP802_source/README.aix Thu Nov 7 17:44:38 2002 @@ -170,6 +170,10 @@ Follow the messages ... and you're done. +If you like a more web-like approach, a good start point can be +http://www14.software.ibm.com/webapp/download/downloadaz.jsp and click +"C for AIX", and follow the instructions. + =head2 Using GNU's gcc for building perl Using gcc-3.0 (tested with 3.0.4) now works out of the box, as do diff -ruN perl-5.8.0/README.hpux AP802_source/README.hpux --- perl-5.8.0/README.hpux Fri Jul 19 09:35:24 2002 +++ AP802_source/README.hpux Thu Nov 7 17:44:38 2002 @@ -38,6 +38,24 @@ If you perform a new installation, then Perl will be installed automatically. +=head2 Using perl from HP's porting centre + +HP porting centre tries very hard to keep up with customer demand and +release updates from the Open Source community. Having precompiled +Perl binaries available is obvious. + +The HP porting centres are limited in what systems they are allowed +to port to and they usually choose the two most recent OS versions +available. This means that at the moment of writing, there are only +HPUX-11.00 and 11-20/22 (IA64) ports available on the porting centres. + +HP has asked the porting centre to move Open Source binaries +from /opt to /usr/local, so binaries produced since the start +of July 2002 are located in /usr/local. + +One of HP porting centres URL's is http://hpux.connect.org.uk/ +The port currently available is built with GNU gcc. + =head2 Compiling Perl 5 on HP-UX When compiling Perl, you must use an ANSI C compiler. The C compiler @@ -64,6 +82,17 @@ The most recent version of PA-RISC at the time of this document's last update is 2.0. +A complete list of models at the time the OS was built is in the file +/usr/sam/lib/mo/sched.models. The first column corresponds to the last +part of the output of the "model" command. The second column is the +PA-RISC version and the third column is the exact chip type used. +(Start browsing at the bottom to prevent confusion ;-) + + # model + 9000/800/L1000-44 + # grep L1000-44 /usr/sam/lib/mo/sched.models + L1000-44 2.0 PA8500 + =head2 PA-RISC 1.0 The original version of PA-RISC, HP no longer sells any system with this chip. @@ -105,9 +134,18 @@ D280, D370, D380, D390, D650, J220, J2240, J280, J282, J400, J410, J5000, J5500XM, J5600, J7000, J7600, K250, K260, K260-EG, K270, K360, K370, K380, K450, K460, K460-EG, K460-XP, K470, K570, K580, L1000, - L2000, L3000, N4000, R380, R390, RP2400, RP2430, RP2450, RP2470, - RP5400, RP5430, RP5450, RP5470, RP7400, RP7410, RP8400, SD16000, - SD32000, SD64000, T540, T600, V2000, V2200, V2250, V2500, V2600 + L2000, L3000, N4000, R380, R390, RP2400, RP2405, RP2430, RP2450, + RP2470, RP5400, RP5405, RP5430, RP5450, RP5470, RP7400, RP7405, + RP7410, RP8400, SD16000, SD32000, SD64000, T540, T600, V2000, V2200, + V2250, V2500, V2600 + +Just before HP took over Compaq, some systems were renamed. Visit +http://www.hp.com/products1/servers/server_names.html to see what +the changes are, or will be. + + HP 9000 A-Class servers, now renamed HP Server rp2400 series. + HP 9000 L-Class servers, now renamed HP Server rp5400 series. + HP 9000 N-Class servers, now renamed HP Server rp7400. =head2 Itanium @@ -115,13 +153,7 @@ date of this document's last update, the following systems contain Itanium chips (this is very likely to be out of date): - RX4610, RX9610 - -A complete list of models at the time the OS was built is in the file -/opt/langtools/lib/sched.models. The first column corresponds to the -output of the "uname -m" command (without the leading "9000/"). The -second column is the PA-RISC version and the third column is the exact -chip type used. (Start browsing at the bottom to prevent confusion ;-) + RX2600, RX4610, RX5670, RX9610 =head2 Portability Between PA-RISC Versions @@ -266,6 +298,12 @@ find the GNU binutils package. (Browse through the list, because there are often multiple versions of the same package available). +Above mentioned distributions are depots. H.Merijn Brand has made prebuilt +gcc binaries available on https://www.beepz.com/personal/merijn/ for +HP-UX 10.20 and HP-UX 11.00 in both 32- and 64-bit versions. These are +bzipped tar archives that also include recent GNU binutils and GNU gdb. +Read the instructions on that page to rebuild gcc using itself. + Building a 64bit capable gcc from source is possible only when you have the HP C-ANSI C compiler available, which you should use anyway when building perl. @@ -457,8 +495,8 @@ #0 0xc004216c in () from /usr/lib/libc.2 #1 0xc00d7550 in __nss_src_state_destr () from /usr/lib/libc.2 #2 0xc00d7768 in __nss_src_state_destr () from /usr/lib/libc.2 - #3 0xc00d78a8 in nss_delete () from /usr/lib/libc.2 - #4 0xc01126d8 in endpwent () from /usr/lib/libc.2 + #3 0xc00d78a8 in nss_delete () from /usr/lib/libc.2 + #4 0xc01126d8 in endpwent () from /usr/lib/libc.2 #5 0xd1950 in Perl_pp_epwent () from ./perl #6 0x94d3c in Perl_runops_standard () from ./perl #7 0x23728 in S_run_body () from ./perl @@ -469,7 +507,7 @@ bug seems to be to create add to the file F (at least) the following lines - group: files + group: files passwd: files Whether you are using NIS does not matter. Amazingly enough, @@ -484,6 +522,6 @@ =head1 DATE -Version 0.6.6: 2002-05-30 +Version 0.6.7: 2002-09-05 =cut diff -ruN perl-5.8.0/README.win32 AP802_source/README.win32 --- perl-5.8.0/README.win32 Fri Jul 19 09:35:24 2002 +++ AP802_source/README.win32 Thu Nov 7 17:44:38 2002 @@ -138,15 +138,26 @@ Perl. Make sure you are building within one of the "Build Environment" shells available after you install the Platform SDK from the Start Menu. -=item Mingw32 with GCC +=item MinGW32 with gcc -GCC-2.95.2 binaries can be downloaded from: +The latest release of MinGW (at the time of writing) is 2.0.0, which comes +with gcc-3.2, and can be downloaded here: - ftp://ftp.xraylith.wisc.edu/pub/khan/gnu-win32/mingw32/ + http://sourceforge.net/projects/mingw + +Perl compiles with earlier releases of gcc (2.95 and up) that can be +downloaded from the same place. If you use gcc-3.2, comment out the +line: + + USE_GCC_V3_2 *= define + +in win32\makefile.mk You also need dmake. See L above on how to get it. -The GCC-2.95.2 bundle comes with Mingw32 libraries and headers. +=item MinGW release 1 + +The MinGW-1.1 bundle comes with gcc-2.95.3. Make sure you install the binaries that work with MSVCRT.DLL as indicated in the README for the GCC bundle. You may need to set up a few environment diff -ruN perl-5.8.0/XSUB.h AP802_source/XSUB.h --- perl-5.8.0/XSUB.h Fri Jul 19 09:35:25 2002 +++ AP802_source/XSUB.h Thu Nov 7 17:44:38 2002 @@ -339,9 +339,9 @@ # define putenv PerlEnv_putenv # define getenv PerlEnv_getenv # define uname PerlEnv_uname -# define stdin PerlSIO_stdin() -# define stdout PerlSIO_stdout() -# define stderr PerlSIO_stderr() +# define stdin PerlSIO_stdin +# define stdout PerlSIO_stdout +# define stderr PerlSIO_stderr # define fopen PerlIO_open # define fclose PerlIO_close # define feof PerlIO_eof @@ -360,8 +360,8 @@ # define setbuf PerlSIO_setbuf # define setvbuf PerlSIO_setvbuf # define setlinebuf PerlSIO_setlinebuf -# define stdoutf PerlIO_stdoutf -# define vfprintf PerlIO_vprintf +# define stdoutf PerlSIO_stdoutf +# define vfprintf PerlSIO_vprintf # define ftell PerlIO_tell # define fseek PerlIO_seek # define fgetpos PerlIO_getpos diff -ruN perl-5.8.0/doio.c AP802_source/doio.c --- perl-5.8.0/doio.c Fri Jul 19 09:35:19 2002 +++ AP802_source/doio.c Thu Nov 7 17:44:38 2002 @@ -325,6 +325,7 @@ } if (num_svs && (SvIOK(*svp) || (SvPOK(*svp) && looks_like_number(*svp)))) { fd = SvUV(*svp); + num_svs = 0; } else if (isDIGIT(*type)) { /*SUPPRESS 530*/ @@ -920,8 +921,8 @@ if (PerlProc_pipe(fd) < 0) goto badexit; - IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"); - IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"); + IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"PIPESOCK_MODE); + IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"PIPESOCK_MODE); IoOFP(rstio) = IoIFP(rstio); IoIFP(wstio) = IoOFP(wstio); IoTYPE(rstio) = IoTYPE_RDONLY; @@ -1519,7 +1520,7 @@ while (*t && isSPACE(*t)) ++t; - if (!*t && (dup2(1,2) != -1)) { + if (!*t && (PerlLIO_dup2(1,2) != -1)) { s[-2] = '\0'; break; } diff -ruN perl-5.8.0/dump.c AP802_source/dump.c --- perl-5.8.0/dump.c Fri Jul 19 09:35:19 2002 +++ AP802_source/dump.c Thu Nov 7 17:44:38 2002 @@ -843,13 +843,15 @@ if (mg->mg_flags) { Perl_dump_indent(aTHX_ level, file, " MG_FLAGS = 0x%02X\n", mg->mg_flags); - if (mg->mg_flags & MGf_TAINTEDDIR) + if (mg->mg_type == PERL_MAGIC_envelem && + mg->mg_flags & MGf_TAINTEDDIR) Perl_dump_indent(aTHX_ level, file, " TAINTEDDIR\n"); if (mg->mg_flags & MGf_REFCOUNTED) Perl_dump_indent(aTHX_ level, file, " REFCOUNTED\n"); if (mg->mg_flags & MGf_GSKIP) Perl_dump_indent(aTHX_ level, file, " GSKIP\n"); - if (mg->mg_flags & MGf_MINMATCH) + if (mg->mg_type == PERL_MAGIC_regex_global && + mg->mg_flags & MGf_MINMATCH) Perl_dump_indent(aTHX_ level, file, " MINMATCH\n"); } if (mg->mg_obj) { diff -ruN perl-5.8.0/ext/B/B.pm AP802_source/ext/B/B.pm --- perl-5.8.0/ext/B/B.pm Fri Jul 19 09:35:19 2002 +++ AP802_source/ext/B/B.pm Thu Nov 7 17:44:38 2002 @@ -236,7 +236,7 @@ package B::Section; my $output_fh; my %sections; - + sub new { my ($class, $section, $symtable, $default) = @_; $output_fh ||= FileHandle->new_tmpfile; @@ -244,7 +244,7 @@ $sections{$section} = $obj; return $obj; } - + sub get { my ($class, $section) = @_; return $sections{$section}; @@ -272,12 +272,12 @@ my $section = shift; return $section->[2]; } - + sub default { my $section = shift; return $section->[3]; } - + sub output { my ($section, $fh, $format) = @_; my $name = $section->name; @@ -324,6 +324,186 @@ things as SVs, OPs and the internal symbol table and syntax tree of a program. +=head1 OVERVIEW + +The C module contains a set of utility functions for querying the +current state of the Perl interpreter; typically these functions +return objects from the B::SV and B::OP classes, or their derived +classes. These classes in turn define methods for querying the +resulting objects about their own internal state. + +=head1 Utility Functions + +The C module exports a variety of functions: some are simple +utility functions, others provide a Perl program with a way to +get an initial "handle" on an internal object. + +=head2 Functions Returning C, C, C, and C objects + +For descriptions of the class hierachy of these objects and the +methods that can be called on them, see below, L<"OVERVIEW OF +CLASSES"> and L<"SV-RELATED CLASSES">. + +=over 4 + +=item sv_undef + +Returns the SV object corresponding to the C variable C. + +=item sv_yes + +Returns the SV object corresponding to the C variable C. + +=item sv_no + +Returns the SV object corresponding to the C variable C. + +=item svref_2object(SVREF) + +Takes a reference to any Perl value, and turns the referred-to value +into an object in the appropriate B::OP-derived or B::SV-derived +class. Apart from functions such as C, this is the primary +way to get an initial "handle" on an internal perl data structure +which can then be followed with the other access methods. + +=item amagic_generation + +Returns the SV object corresponding to the C variable C. + +=item C + +Returns the AV object (i.e. in class B::AV) representing INIT blocks. + +=item begin_av + +Returns the AV object (i.e. in class B::AV) representing BEGIN blocks. + +=item end_av + +Returns the AV object (i.e. in class B::AV) representing END blocks. + +=item comppadlist + +Returns the AV object (i.e. in class B::AV) of the global comppadlist. + +=item regex_padav + +Only when perl was compiled with ithreads. + +=item C + +Return the (faked) CV corresponding to the main part of the Perl +program. + +=back + +=head2 Functions for Examining the Symbol Table + +=over 4 + +=item walksymtable(SYMREF, METHOD, RECURSE, PREFIX) + +Walk the symbol table starting at SYMREF and call METHOD on each +symbol (a B::GV object) visited. When the walk reaches package +symbols (such as "Foo::") it invokes RECURSE, passing in the symbol +name, and only recurses into the package if that sub returns true. + +PREFIX is the name of the SYMREF you're walking. + +For example: + + # Walk CGI's symbol table calling print_subs on each symbol. + # Recurse only into CGI::Util:: + walksymtable(\%CGI::, 'print_subs', sub { $_[0] eq 'CGI::Util::' }, + 'CGI::'); + +print_subs() is a B::GV method you have declared. Also see L<"B::GV +Methods">, below. + +=back + +=head2 Functions Returning C objects or for walking op trees + +For descriptions of the class hierachy of these objects and the +methods that can be called on them, see below, L<"OVERVIEW OF +CLASSES"> and L<"OP-RELATED CLASSES">. + +=over 4 + +=item main_root + +Returns the root op (i.e. an object in the appropriate B::OP-derived +class) of the main part of the Perl program. + +=item main_start + +Returns the starting op of the main part of the Perl program. + +=item walkoptree(OP, METHOD) + +Does a tree-walk of the syntax tree based at OP and calls METHOD on +each op it visits. Each node is visited before its children. If +C (see below) has been called to turn debugging on then +the method C is called on each op before METHOD is +called. + +=item walkoptree_debug(DEBUG) + +Returns the current debugging flag for C. If the optional +DEBUG argument is non-zero, it sets the debugging flag to that. See +the description of C above for what the debugging flag +does. + +=back + +=head2 Miscellaneous Utility Functions + +=over 4 + +=item ppname(OPNUM) + +Return the PP function name (e.g. "pp_add") of op number OPNUM. + +=item hash(STR) + +Returns a string in the form "0x..." representing the value of the +internal hash function used by perl on string STR. + +=item cast_I32(I) + +Casts I to the internal I32 type used by that perl. + +=item minus_c + +Does the equivalent of the C<-c> command-line option. Obviously, this +is only useful in a BEGIN block or else the flag is set too late. + +=item cstring(STR) + +Returns a double-quote-surrounded escaped version of STR which can +be used as a string in C source code. + +=item perlstring(STR) + +Returns a double-quote-surrounded escaped version of STR which can +be used as a string in Perl source code. + +=item class(OBJ) + +Returns the class of an object without the part of the classname +preceding the first C<"::">. This is used to turn C<"B::UNOP"> into +C<"UNOP"> for example. + +=item threadsv_names + +In a perl compiled for threads, this returns a list of the special +per-thread threadsv variables. + +=back + + + + =head1 OVERVIEW OF CLASSES The C structures used by Perl's internals to hold SV and OP @@ -331,9 +511,12 @@ class hierarchy and the C module gives access to them via a true object hierarchy. Structure fields which point to other objects (whether types of SV or types of OP) are represented by the C -module as Perl objects of the appropriate class. The bulk of the C -module is the methods for accessing fields of these structures. Note -that all access is read-only: you cannot modify the internals by +module as Perl objects of the appropriate class. + +The bulk of the C module is the methods for accessing fields of +these structures. + +Note that all access is read-only. You cannot modify the internals by using this module. =head2 SV-RELATED CLASSES @@ -341,15 +524,40 @@ B::IV, B::NV, B::RV, B::PV, B::PVIV, B::PVNV, B::PVMG, B::BM, B::PVLV, B::AV, B::HV, B::CV, B::GV, B::FM, B::IO. These classes correspond in the obvious way to the underlying C structures of similar names. The -inheritance hierarchy mimics the underlying C "inheritance". Access -methods correspond to the underlying C macros for field access, +inheritance hierarchy mimics the underlying C "inheritance": + + B::SV + | + +--------------+----------------------+ + | | | + B::PV B::IV B::RV + | \ / \ + | \ / \ + | B::PVIV B::NV + \ / + \____ __/ + \ / + B::PVNV + | + | + B::PVMG + | + +------+-----+----+------+-----+-----+ + | | | | | | | + B::PVLV B::BM B::AV B::GV B::HV B::CV B::IO + | + | + B::FM + + +Access methods correspond to the underlying C macros for field access, usually with the leading "class indication" prefix removed (Sv, Av, Hv, ...). The leading prefix is only left in cases where its removal would cause a clash in method name. For example, C stays as-is since its abbreviation would clash with the "superclass" method C (corresponding to the C function C). -=head2 B::SV METHODS +=head2 B::SV Methods =over 4 @@ -359,7 +567,7 @@ =back -=head2 B::IV METHODS +=head2 B::IV Methods =over 4 @@ -387,7 +595,7 @@ =back -=head2 B::NV METHODS +=head2 B::NV Methods =over 4 @@ -397,7 +605,7 @@ =back -=head2 B::RV METHODS +=head2 B::RV Methods =over 4 @@ -405,7 +613,7 @@ =back -=head2 B::PV METHODS +=head2 B::PV Methods =over 4 @@ -434,7 +642,7 @@ =back -=head2 B::PVMG METHODS +=head2 B::PVMG Methods =over 4 @@ -444,7 +652,7 @@ =back -=head2 B::MAGIC METHODS +=head2 B::MAGIC Methods =over 4 @@ -473,7 +681,7 @@ =back -=head2 B::PVLV METHODS +=head2 B::PVLV Methods =over 4 @@ -487,7 +695,7 @@ =back -=head2 B::BM METHODS +=head2 B::BM Methods =over 4 @@ -501,7 +709,7 @@ =back -=head2 B::GV METHODS +=head2 B::GV Methods =over 4 @@ -556,7 +764,7 @@ =back -=head2 B::IO METHODS +=head2 B::IO Methods =over 4 @@ -595,7 +803,7 @@ =back -=head2 B::AV METHODS +=head2 B::AV Methods =over 4 @@ -611,7 +819,7 @@ =back -=head2 B::CV METHODS +=head2 B::CV Methods =over 4 @@ -643,7 +851,7 @@ =back -=head2 B::HV METHODS +=head2 B::HV Methods =over 4 @@ -665,15 +873,32 @@ =head2 OP-RELATED CLASSES -B::OP, B::UNOP, B::BINOP, B::LOGOP, B::LISTOP, B::PMOP, -B::SVOP, B::PADOP, B::PVOP, B::CVOP, B::LOOP, B::COP. -These classes correspond in -the obvious way to the underlying C structures of similar names. The -inheritance hierarchy mimics the underlying C "inheritance". Access -methods correspond to the underlying C structre field names, with the -leading "class indication" prefix removed (op_). +C, C, C, C, C, C, +C, C, C, C, C, C. -=head2 B::OP METHODS +These classes correspond in the obvious way to the underlying C +structures of similar names. The inheritance hierarchy mimics the +underlying C "inheritance": + + B::OP + | + +---------------+--------+--------+------+ + | | | | | + B::UNOP B::SVOP B::PADOP B::CVOP B::COP + ,' `-. + / `--. + B::BINOP B::LOGOP + | + | + B::LISTOP + ,' `. + / \ + B::LOOP B::PMOP + +Access methods correspond to the underlying C structre field names, +with the leading "class indication" prefix (C<"op_">) removed. + +=head2 B::OP Methods =over 4 @@ -739,7 +964,7 @@ =back -=head2 B::PMOP METHODS +=head2 B::PMOP Methods =over 4 @@ -791,7 +1016,7 @@ =back -=head2 B::LOOP METHODS +=head2 B::LOOP Methods =over 4 @@ -803,7 +1028,7 @@ =back -=head2 B::COP METHODS +=head2 B::COP Methods =over 4 @@ -821,148 +1046,6 @@ =back -=head1 FUNCTIONS EXPORTED BY C - -The C module exports a variety of functions: some are simple -utility functions, others provide a Perl program with a way to -get an initial "handle" on an internal object. - -=over 4 - -=item main_cv - -Return the (faked) CV corresponding to the main part of the Perl -program. - -=item init_av - -Returns the AV object (i.e. in class B::AV) representing INIT blocks. - -=item begin_av - -Returns the AV object (i.e. in class B::AV) representing BEGIN blocks. - -=item end_av - -Returns the AV object (i.e. in class B::AV) representing END blocks. - -=item main_root - -Returns the root op (i.e. an object in the appropriate B::OP-derived -class) of the main part of the Perl program. - -=item main_start - -Returns the starting op of the main part of the Perl program. - -=item comppadlist - -Returns the AV object (i.e. in class B::AV) of the global comppadlist. - -=item regex_padav - -Only when perl was compiled with ithreads. - -=item sv_undef - -Returns the SV object corresponding to the C variable C. - -=item sv_yes - -Returns the SV object corresponding to the C variable C. - -=item sv_no - -Returns the SV object corresponding to the C variable C. - -=item amagic_generation - -Returns the SV object corresponding to the C variable C. - -=item walkoptree(OP, METHOD) - -Does a tree-walk of the syntax tree based at OP and calls METHOD on -each op it visits. Each node is visited before its children. If -C (q.v.) has been called to turn debugging on then -the method C is called on each op before METHOD is -called. - -=item walkoptree_debug(DEBUG) - -Returns the current debugging flag for C. If the optional -DEBUG argument is non-zero, it sets the debugging flag to that. See -the description of C above for what the debugging flag -does. - -=item walksymtable(SYMREF, METHOD, RECURSE, PREFIX) - -Walk the symbol table starting at SYMREF and call METHOD on each -symbol (a B::GV object) visited. When the walk reaches package -symbols (such as "Foo::") it invokes RECURSE, passing in the symbol -name, and only recurses into the package if that sub returns true. - -PREFIX is the name of the SYMREF you're walking. - -For example... - - # Walk CGI's symbol table calling print_subs on each symbol. - # Only recurse into CGI::Util:: - walksymtable(\%CGI::, 'print_subs', sub { $_[0] eq 'CGI::Util::' }, - 'CGI::'); - -print_subs() is a B::GV method you have declared. - - -=item svref_2object(SV) - -Takes any Perl variable and turns it into an object in the -appropriate B::OP-derived or B::SV-derived class. Apart from functions -such as C, this is the primary way to get an initial -"handle" on an internal perl data structure which can then be followed -with the other access methods. - -=item ppname(OPNUM) - -Return the PP function name (e.g. "pp_add") of op number OPNUM. - -=item hash(STR) - -Returns a string in the form "0x..." representing the value of the -internal hash function used by perl on string STR. - -=item cast_I32(I) - -Casts I to the internal I32 type used by that perl. - - -=item minus_c - -Does the equivalent of the C<-c> command-line option. Obviously, this -is only useful in a BEGIN block or else the flag is set too late. - - -=item cstring(STR) - -Returns a double-quote-surrounded escaped version of STR which can -be used as a string in C source code. - -=item perlstring(STR) - -Returns a double-quote-surrounded escaped version of STR which can -be used as a string in Perl source code. - -=item class(OBJ) - -Returns the class of an object without the part of the classname -preceding the first "::". This is used to turn "B::UNOP" into -"UNOP" for example. - -=item threadsv_names - -In a perl compiled for threads, this returns a list of the special -per-thread threadsv variables. - -=back =head1 AUTHOR diff -ruN perl-5.8.0/ext/Devel/DProf/DProf.xs AP802_source/ext/Devel/DProf/DProf.xs --- perl-5.8.0/ext/Devel/DProf/DProf.xs Fri Jul 19 09:35:19 2002 +++ AP802_source/ext/Devel/DProf/DProf.xs Thu Nov 7 17:44:38 2002 @@ -84,7 +84,7 @@ U32 dprof_ticks; char* out_file_name; /* output file (defaults to tmon.out) */ PerlIO* fp; /* pointer to tmon.out file */ - long TIMES_LOCATION; /* Where in the file to store the time totals */ + Off_t TIMES_LOCATION; /* Where in the file to store the time totals */ int SAVE_STACK; /* How much data to buffer until end of run */ int prof_pid; /* pid of profiled process */ struct tms prof_start; diff -ruN perl-5.8.0/ext/Devel/PPPort/PPPort.pm AP802_source/ext/Devel/PPPort/PPPort.pm --- perl-5.8.0/ext/Devel/PPPort/PPPort.pm Fri Jul 19 09:35:19 2002 +++ AP802_source/ext/Devel/PPPort/PPPort.pm Thu Nov 7 17:44:38 2002 @@ -434,6 +434,15 @@ # define aTHX_ #endif +/* IV could also be a quad (say, a long long), but Perls + * capable of those should have IVSIZE already. */ +#if !defined(IVSIZE) && defined(LONGSIZE) +# define IVSIZE LONGSIZE +#endif +#ifndef IVSIZE +# define IVSIZE 4 /* A bold guess, but the best we can make. */ +#endif + #ifndef UVSIZE # define UVSIZE IVSIZE #endif @@ -649,7 +658,6 @@ #else /* single interpreter */ - #define START_MY_CXT static my_cxt_t my_cxt; #define dMY_CXT_SV dNOOP #define dMY_CXT dNOOP @@ -718,6 +726,18 @@ # endif #else # define SvPVbyte SvPV +#endif + +#ifndef SvPV_nolen +# define SvPV_nolen(sv) \ + ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + ? SvPVX(sv) : sv_2pv_nolen(sv)) + static char * + sv_2pv_nolen(pTHX_ register SV *sv) + { + STRLEN n_a; + return sv_2pv(sv, &n_a); + } #endif #endif /* _P_P_PORTABILITY_H_ */ diff -ruN perl-5.8.0/ext/IPC/SysV/Semaphore.pm AP802_source/ext/IPC/SysV/Semaphore.pm --- perl-5.8.0/ext/IPC/SysV/Semaphore.pm Fri Jul 19 09:35:20 2002 +++ AP802_source/ext/IPC/SysV/Semaphore.pm Thu Nov 7 17:44:38 2002 @@ -111,7 +111,7 @@ else { croak 'Bad arg count' if @_ % 2; my %arg = @_; - my $ds = $self->stat + $ds = $self->stat or return undef; my($key,$val); $ds->$key($val) diff -ruN perl-5.8.0/ext/Opcode/Safe.pm AP802_source/ext/Opcode/Safe.pm --- perl-5.8.0/ext/Opcode/Safe.pm Fri Jul 19 09:35:20 2002 +++ AP802_source/ext/Opcode/Safe.pm Thu Nov 7 17:44:38 2002 @@ -3,7 +3,7 @@ use 5.003_11; use strict; -our $VERSION = "2.07"; +our $VERSION = "2.08"; use Carp; @@ -155,7 +155,7 @@ my $no_record = shift || 0; my $root = $obj->root(); croak("vars not an array ref") unless ref $vars eq 'ARRAY'; - no strict 'refs'; + no strict 'refs'; # Check that 'from' package actually exists croak("Package \"$pkg\" does not exist") unless keys %{"$pkg\::"}; @@ -190,7 +190,7 @@ sub share_redo { my $obj = shift; my $shares = \%{$obj->{Shares} ||= {}}; - my($var, $pkg); + my($var, $pkg); while(($var, $pkg) = each %$shares) { # warn "share_redo $pkg\:: $var"; $obj->share_from($pkg, [ $var ], 1); @@ -214,11 +214,11 @@ # Create anon sub ref in root of compartment. # Uses a closure (on $expr) to pass in the code to be executed. # (eval on one line to keep line numbers as expected by caller) - my $evalcode = sprintf('package %s; sub { eval $expr; }', $root); + my $evalcode = sprintf('package %s; sub { @_ = (); eval $expr; }', $root); my $evalsub; - if ($strict) { use strict; $evalsub = eval $evalcode; } - else { no strict; $evalsub = eval $evalcode; } + if ($strict) { use strict; $evalsub = eval $evalcode; } + else { no strict; $evalsub = eval $evalcode; } return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub); } @@ -228,7 +228,7 @@ my $root = $obj->{Root}; my $evalsub = eval - sprintf('package %s; sub { do $file }', $root); + sprintf('package %s; sub { @_ = (); do $file }', $root); return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub); } diff -ruN perl-5.8.0/ext/POSIX/POSIX.xs AP802_source/ext/POSIX/POSIX.xs --- perl-5.8.0/ext/POSIX/POSIX.xs Fri Jul 19 09:35:20 2002 +++ AP802_source/ext/POSIX/POSIX.xs Thu Nov 7 17:44:38 2002 @@ -843,7 +843,7 @@ unsigned char * charstring CODE: unsigned char *s = charstring; - unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */ + unsigned char *e = s + SvCUR(ST(0)); for (RETVAL = 1; RETVAL && s < e; s++) if (!isalnum(*s)) RETVAL = 0; @@ -855,7 +855,7 @@ unsigned char * charstring CODE: unsigned char *s = charstring; - unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */ + unsigned char *e = s + SvCUR(ST(0)); for (RETVAL = 1; RETVAL && s < e; s++) if (!isalpha(*s)) RETVAL = 0; @@ -867,7 +867,7 @@ unsigned char * charstring CODE: unsigned char *s = charstring; - unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */ + unsigned char *e = s + SvCUR(ST(0)); for (RETVAL = 1; RETVAL && s < e; s++) if (!iscntrl(*s)) RETVAL = 0; @@ -879,7 +879,7 @@ unsigned char * charstring CODE: unsigned char *s = charstring; - unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */ + unsigned char *e = s + SvCUR(ST(0)); for (RETVAL = 1; RETVAL && s < e; s++) if (!isdigit(*s)) RETVAL = 0; @@ -891,7 +891,7 @@ unsigned char * charstring CODE: unsigned char *s = charstring; - unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */ + unsigned char *e = s + SvCUR(ST(0)); for (RETVAL = 1; RETVAL && s < e; s++) if (!isgraph(*s)) RETVAL = 0; @@ -903,7 +903,7 @@ unsigned char * charstring CODE: unsigned char *s = charstring; - unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */ + unsigned char *e = s + SvCUR(ST(0)); for (RETVAL = 1; RETVAL && s < e; s++) if (!islower(*s)) RETVAL = 0; @@ -915,7 +915,7 @@ unsigned char * charstring CODE: unsigned char *s = charstring; - unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */ + unsigned char *e = s + SvCUR(ST(0)); for (RETVAL = 1; RETVAL && s < e; s++) if (!isprint(*s)) RETVAL = 0; @@ -927,7 +927,7 @@ unsigned char * charstring CODE: unsigned char *s = charstring; - unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */ + unsigned char *e = s + SvCUR(ST(0)); for (RETVAL = 1; RETVAL && s < e; s++) if (!ispunct(*s)) RETVAL = 0; @@ -939,7 +939,7 @@ unsigned char * charstring CODE: unsigned char *s = charstring; - unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */ + unsigned char *e = s + SvCUR(ST(0)); for (RETVAL = 1; RETVAL && s < e; s++) if (!isspace(*s)) RETVAL = 0; @@ -951,7 +951,7 @@ unsigned char * charstring CODE: unsigned char *s = charstring; - unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */ + unsigned char *e = s + SvCUR(ST(0)); for (RETVAL = 1; RETVAL && s < e; s++) if (!isupper(*s)) RETVAL = 0; @@ -963,7 +963,7 @@ unsigned char * charstring CODE: unsigned char *s = charstring; - unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */ + unsigned char *e = s + SvCUR(ST(0)); for (RETVAL = 1; RETVAL && s < e; s++) if (!isxdigit(*s)) RETVAL = 0; @@ -1374,11 +1374,17 @@ int fd1 int fd2 -SysRetLong +SV * lseek(fd, offset, whence) int fd Off_t offset int whence + CODE: + Off_t pos = PerlLIO_lseek(fd, offset, whence); + RETVAL = sizeof(Off_t) > sizeof(IV) + ? newSVnv((NV)pos) : newSViv((IV)pos); + OUTPUT: + RETVAL SysRet nice(incr) diff -ruN perl-5.8.0/ext/POSIX/t/posix.t AP802_source/ext/POSIX/t/posix.t --- perl-5.8.0/ext/POSIX/t/posix.t Fri Jul 19 09:35:20 2002 +++ AP802_source/ext/POSIX/t/posix.t Thu Nov 7 17:44:38 2002 @@ -11,7 +11,7 @@ } require "./test.pl"; -plan(tests => 39); +plan(tests => 61); use POSIX qw(fcntl_h signal_h limits_h _exit getcwd open read strftime write @@ -223,6 +223,30 @@ like ($@, qr/^Use method IO::Handle::gets\(\) instead/, "check its redef message"); +# Simplistic tests for the isXXX() functions (bug #16799) +ok( POSIX::isalnum('1'), 'isalnum' ); +ok(!POSIX::isalnum('*'), 'isalnum' ); +ok( POSIX::isalpha('f'), 'isalpha' ); +ok(!POSIX::isalpha('7'), 'isalpha' ); +ok( POSIX::iscntrl("\cA"),'iscntrl' ); +ok(!POSIX::iscntrl("A"), 'iscntrl' ); +ok( POSIX::isdigit('1'), 'isdigit' ); +ok(!POSIX::isdigit('z'), 'isdigit' ); +ok( POSIX::isgraph('@'), 'isgraph' ); +ok(!POSIX::isgraph(' '), 'isgraph' ); +ok( POSIX::islower('l'), 'islower' ); +ok(!POSIX::islower('L'), 'islower' ); +ok( POSIX::isupper('U'), 'isupper' ); +ok(!POSIX::isupper('u'), 'isupper' ); +ok( POSIX::isprint('$'), 'isprint' ); +ok(!POSIX::isprint("\n"), 'isprint' ); +ok( POSIX::ispunct('%'), 'ispunct' ); +ok(!POSIX::ispunct('u'), 'ispunct' ); +ok( POSIX::isspace("\t"), 'isspace' ); +ok(!POSIX::isspace('_'), 'isspace' ); +ok( POSIX::isxdigit('f'), 'isxdigit' ); +ok(!POSIX::isxdigit('g'), 'isxdigit' ); + # Check that output is not flushed by _exit. This test should be last # in the file, and is not counted in the total number of tests. if ($^O eq 'vos') { diff -ruN perl-5.8.0/ext/PerlIO/scalar/scalar.xs AP802_source/ext/PerlIO/scalar/scalar.xs --- perl-5.8.0/ext/PerlIO/scalar/scalar.xs Fri Jul 19 09:35:20 2002 +++ AP802_source/ext/PerlIO/scalar/scalar.xs Thu Nov 7 17:44:38 2002 @@ -103,10 +103,10 @@ PerlIOScalar_unread(pTHX_ PerlIO * f, const void *vbuf, Size_t count) { PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar); - char *dst = SvGROW(s->var, s->posn + count); + char *dst = SvGROW(s->var, (STRLEN)s->posn + count); Move(vbuf, dst + s->posn, count, char); s->posn += count; - SvCUR_set(s->var, s->posn); + SvCUR_set(s->var, (STRLEN)s->posn); SvPOK_on(s->var); return count; } @@ -126,7 +126,7 @@ } else { if ((s->posn + count) > SvCUR(sv)) - dst = SvGROW(sv, s->posn + count); + dst = SvGROW(sv, (STRLEN)s->posn + count); else dst = SvPV_nolen(sv); offset = s->posn; @@ -134,7 +134,7 @@ } Move(vbuf, dst + offset, count, char); if ((STRLEN) s->posn > SvCUR(sv)) - SvCUR_set(sv, s->posn); + SvCUR_set(sv, (STRLEN)s->posn); SvPOK_on(s->var); return count; } @@ -180,7 +180,7 @@ if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) { PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar); if (SvCUR(s->var) > (STRLEN) s->posn) - return SvCUR(s->var) - s->posn; + return SvCUR(s->var) - (STRLEN)s->posn; else return 0; } diff -ruN perl-5.8.0/ext/PerlIO/t/via.t AP802_source/ext/PerlIO/t/via.t --- perl-5.8.0/ext/PerlIO/t/via.t Fri Jul 19 09:35:20 2002 +++ AP802_source/ext/PerlIO/t/via.t Thu Nov 7 17:44:38 2002 @@ -14,7 +14,7 @@ my $tmp = "via$$"; -use Test::More tests => 16; +use Test::More tests => 18; my $fh; my $a = join("", map { chr } 0..255) x 10; @@ -58,7 +58,14 @@ close($fh); +{ +package Incomplete::Module; +} + $warnings = ''; + no warnings 'layer'; + ok( ! open($fh,">via(Incomplete::Module)", $tmp), 'open via Incomplete::Module will fail'); + is( $warnings, "", "don't warn about unknown package" ); $warnings = ''; no warnings 'layer'; diff -ruN perl-5.8.0/ext/PerlIO/via/via.xs AP802_source/ext/PerlIO/via/via.xs --- perl-5.8.0/ext/PerlIO/via/via.xs Fri Jul 19 09:35:20 2002 +++ AP802_source/ext/PerlIO/via/via.xs Thu Nov 7 17:44:38 2002 @@ -143,11 +143,15 @@ s->stash = gv_stashpvn(SvPVX(s->obj), pkglen + 13, FALSE); } if (s->stash) { - SV *modesv = - (mode) ? sv_2mortal(newSVpvn(mode, strlen(mode))) : - Nullsv; - SV *result = - PerlIOVia_method(aTHX_ f, MYMethod(PUSHED), G_SCALAR, + char lmode[8]; + SV *modesv; + SV *result; + if (!mode) { + /* binmode() passes NULL - so find out what mode is */ + mode = PerlIO_modestr(f,lmode); + } + modesv = sv_2mortal(newSVpvn(mode, strlen(mode))); + result = PerlIOVia_method(aTHX_ f, MYMethod(PUSHED), G_SCALAR, modesv, Nullsv); if (result) { if (sv_isobject(result)) { @@ -157,6 +161,9 @@ else if (SvIV(result) != 0) return SvIV(result); } + else { + goto push_failed; + } if (PerlIOVia_fetchmethod(aTHX_ s, MYMethod(FILL)) == (CV *) - 1) PerlIOBase(f)->flags &= ~PERLIO_F_FASTGETS; @@ -168,6 +175,7 @@ Perl_warner(aTHX_ packWARN(WARN_LAYER), "Cannot find package '%.*s'", (int) pkglen, pkg); +push_failed: #ifdef ENOSYS errno = ENOSYS; #else @@ -342,7 +350,8 @@ PerlIOVia_seek(pTHX_ PerlIO * f, Off_t offset, int whence) { PerlIOVia *s = PerlIOSelf(f, PerlIOVia); - SV *offsv = sv_2mortal(newSViv(offset)); + SV *offsv = sv_2mortal(sizeof(Off_t) > sizeof(IV) + ? newSVnv((NV)offset) : newSViv((IV)offset)); SV *whsv = sv_2mortal(newSViv(whence)); SV *result = PerlIOVia_method(aTHX_ f, MYMethod(SEEK), G_SCALAR, offsv, whsv, @@ -356,7 +365,9 @@ PerlIOVia *s = PerlIOSelf(f, PerlIOVia); SV *result = PerlIOVia_method(aTHX_ f, MYMethod(TELL), G_SCALAR, Nullsv); - return (result) ? (Off_t) SvIV(result) : (Off_t) - 1; + return (result) + ? (SvNOK(result) ? (Off_t)SvNV(result) : (Off_t)SvIV(result)) + : (Off_t) - 1; } SSize_t diff -ruN perl-5.8.0/ext/Safe/safe3.t AP802_source/ext/Safe/safe3.t --- perl-5.8.0/ext/Safe/safe3.t Wed Dec 31 16:00:00 1969 +++ AP802_source/ext/Safe/safe3.t Thu Nov 7 17:44:38 2002 @@ -0,0 +1,48 @@ +#!perl + +BEGIN { + if ($ENV{PERL_CORE}) { + chdir 't' if -d 't'; + @INC = '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bOpcode\b/ + && $Config{'extensions'} !~ /\bPOSIX\b/ + && $Config{'osname'} ne 'VMS') + { + print "1..0\n"; + exit 0; + } + } +} + +use strict; +use warnings; +use POSIX qw(ceil); +use Test::More tests => 2; +use Safe; + +my $safe = new Safe; +$safe->deny('add'); + +my $masksize = ceil( Opcode::opcodes / 8 ); +# Attempt to change the opmask from within the safe compartment +$safe->reval( qq{\$_[1] = qq/\0/ x } . $masksize ); + +# Check that it didn't work +$safe->reval( q{$x + $y} ); +like( $@, qr/^'?addition \(\+\)'? trapped by operation mask/, + 'opmask still in place with reval' ); + +my $safe2 = new Safe; +$safe2->deny('add'); + +open my $fh, '>nasty.pl' or die "Can't write nasty.pl: $!\n"; +print $fh <rdo('nasty.pl'); +$safe2->reval( q{$x + $y} ); +like( $@, qr/^'?addition \(\+\)'? trapped by operation mask/, + 'opmask still in place with rdo' ); +END { unlink 'nasty.pl' } diff -ruN perl-5.8.0/ext/Sys/Syslog/syslog.t AP802_source/ext/Sys/Syslog/syslog.t --- perl-5.8.0/ext/Sys/Syslog/syslog.t Fri Jul 19 09:35:20 2002 +++ AP802_source/ext/Sys/Syslog/syslog.t Thu Nov 7 17:44:38 2002 @@ -47,11 +47,21 @@ if (Sys::Syslog::_PATH_LOG()) { if (-e Sys::Syslog::_PATH_LOG()) { - print defined(eval { setlogsock('unix') }) ? "ok 1\n" : "not ok 1 # $!\n"; - print defined(eval { openlog('perl', 'ndelay', 'local0') }) ? "ok 2\n" : "not ok 2 # $!\n"; - print defined(eval { syslog('info', $test_string ) }) ? "ok 3\n" : "not ok 3 # $!\n"; - } - else { + print defined(eval { setlogsock('unix') }) + ? "ok 1\n" : "not ok 1 # $!\n"; + if (defined(eval { openlog('perl', 'ndelay', 'local0') })) { + print "ok 2\n"; + print defined(eval { syslog('info', $test_string ) }) + ? "ok 3\n" : "not ok 3 # $!\n"; + } else { + if ($@ =~ /no connection to syslog available/) { + print "ok 2 # Skip: syslogd not running\n"; + } else { + print "not ok 2 # $@\n"; + } + print "ok 3 # Skip: openlog failed\n"; + } + } else { for (1..3) { print "ok $_ # Skip: file ", diff -ruN perl-5.8.0/ext/util/make_ext AP802_source/ext/util/make_ext --- perl-5.8.0/ext/util/make_ext Fri Jul 19 09:35:21 2002 +++ AP802_source/ext/util/make_ext Thu Jul 18 22:07:25 2002 @@ -92,7 +92,12 @@ dynamic) makeargs="LINKTYPE=dynamic"; target=all ;; -static) makeargs="LINKTYPE=static CCCDLFLAGS=" +static) case "$mname" in + # For Apache, DynaLoader needs the CCCDLFLAGS variable + # (+z/+Z/-fpic/-fPIC) to stick around + *DynaLoader*) makeargs="LINKTYPE=static" ;; + *) makeargs="LINKTYPE=static CCCDLFLAGS=" ;; + esac target=all ;; static_pic) makeargs="LINKTYPE=static" diff -ruN perl-5.8.0/gv.c AP802_source/gv.c --- perl-5.8.0/gv.c Fri Jul 19 09:35:21 2002 +++ AP802_source/gv.c Thu Nov 7 17:44:38 2002 @@ -401,6 +401,10 @@ register const char *nend; const char *nsplit = 0; GV* gv; + HV* ostash = stash; + + if (stash && SvTYPE(stash) < SVt_PVHV) + stash = Nullhv; for (nend = name; *nend; nend++) { if (*nend == '\'') @@ -433,6 +437,7 @@ gv_stashpvn(origname, nsplit - origname - 7, FALSE)) stash = gv_stashpvn(origname, nsplit - origname, TRUE); } + ostash = stash; } gv = gv_fetchmeth(stash, name, nend - name, 0); @@ -440,7 +445,7 @@ if (strEQ(name,"import") || strEQ(name,"unimport")) gv = (GV*)&PL_sv_yes; else if (autoload) - gv = gv_autoload4(stash, name, nend - name, TRUE); + gv = gv_autoload4(ostash, name, nend - name, TRUE); } else if (autoload) { CV* cv = GvCV(gv); @@ -475,11 +480,19 @@ HV* varstash; GV* vargv; SV* varsv; + char *packname = ""; - if (!stash) - return Nullgv; /* UNIVERSAL::AUTOLOAD could cause trouble */ if (len == autolen && strnEQ(name, autoload, autolen)) return Nullgv; + if (stash) { + if (SvTYPE(stash) < SVt_PVHV) { + packname = SvPV_nolen((SV*)stash); + stash = Nullhv; + } + else { + packname = HvNAME(stash); + } + } if (!(gv = gv_fetchmeth(stash, autoload, autolen, FALSE))) return Nullgv; cv = GvCV(gv); @@ -494,7 +507,7 @@ (GvCVGEN(gv) || GvSTASH(gv) != stash)) Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated", - HvNAME(stash), (int)len, name); + packname, (int)len, name); #ifndef USE_5005THREADS if (CvXSUB(cv)) { @@ -530,7 +543,7 @@ #ifdef USE_5005THREADS sv_lock(varsv); #endif - sv_setpv(varsv, HvNAME(stash)); + sv_setpv(varsv, packname); sv_catpvn(varsv, "::", 2); sv_catpvn(varsv, name, len); SvTAINTED_off(varsv); diff -ruN perl-5.8.0/hints/README.hints AP802_source/hints/README.hints --- perl-5.8.0/hints/README.hints Fri Jul 19 09:35:21 2002 +++ AP802_source/hints/README.hints Thu Nov 7 17:44:38 2002 @@ -297,7 +297,11 @@ file can tuck this information away into a file UU/cc.cbu. Then, after Configure prompts the user for the C compiler, it will load in and run the UU/cc.cbu "call-back" unit. See hints/solaris_2.sh for an -example. +example. Some callbacks exist for other variables than cc, such as for +uselongdouble. At the present time, these callbacks are only called if the +variable in question is defined; however, this may change, so the scheme in +hints/solaris_2.sh of checking to see if uselongdouble is defined is a good +idea. =item Future status diff -ruN perl-5.8.0/hints/aix.sh AP802_source/hints/aix.sh --- perl-5.8.0/hints/aix.sh Fri Jul 19 09:35:21 2002 +++ AP802_source/hints/aix.sh Thu Nov 7 17:44:38 2002 @@ -51,7 +51,8 @@ # Intuiting the existence of system calls under AIX is difficult, # at best; the safest technique is to find them empirically. -# AIX 4.3.* and above default to using nm for symbol extraction +# AIX 4.3.* and above default to letting Configure test if nm +# extraction will work. case "$osvers" in 3.*|4.1.*|4.2.*) case "$usenm" in @@ -62,9 +63,6 @@ esac ;; *) - case "$usenm" in - '') usenm='true' - esac case "$usenativedlopen" in '') usenativedlopen='true' esac @@ -210,6 +208,28 @@ esac # the required -bE:$installarchlib/CORE/perl.exp is added by # libperl.U (Configure) later. + +case "$cc" in +*gcc*) ;; +cc*|xlc*) # cc should've been set by line 116 or so if empty. + if test ! -x /usr/bin/$cc -a -x /usr/vac/bin/$cc; then + case ":$PATH:" in + *:/usr/vac/bin:*) ;; + *) cat <= 10.x @@ -30,14 +31,15 @@ archname=`getcontext | tr ' ' '\012' | grep -v '[a-z]' | grep -v MC688 | sed -e 's/HP-//' -e 1q`; selecttype='int *' - fi +fi +fi # For some strange reason, the u32align test from Configure hangs in # HP-UX 10.20 since the December 2001 patches. So hint it to avoid # the test. if [ "$xxOsRevMajor" -le 10 ]; then d_u32align=$define - fi +fi echo "Archname is $archname" @@ -97,7 +99,7 @@ PA-RISC*) case "$ccflags" in *-mpa-risc*) ;; - *) ccflags="$ccflags -mpa-risc-2-0" ;; +# *) ccflags="$ccflags -mpa-risc-2-0" ;; esac ;; esac @@ -151,7 +153,11 @@ esac # When HP-UX runs a script with "#!", it sets argv[0] to the script name. +case "$toke_cflags" in +'') toke_cflags='ccflags="$ccflags -DARG_ZERO_IS_SCRIPT"' + ;; +esac ### 64 BITNESS @@ -278,7 +284,10 @@ libc='/lib/libc.sl' ;; IA64*) loclibpth="$loclibpth /usr/lib/hpux32" - libc='/usr/lib/hpux32/libc.so' ;; + libc='/usr/lib/hpux32/libc.so' + # no odbm libs + i_dbm=$undef + ;; esac ;; esac @@ -338,7 +347,7 @@ $define|true|[Yy]) case "$optimize" in - "") optimize="-g -O" ;; + "") optimize="-O" ;; *O[3456789]*) optimize=`echo "$optimize" | sed -e 's/O[3-9]/O2/'` ;; esac #ld="$cc" @@ -396,6 +405,25 @@ ;; esac +# -lc should be at the end, if present (cc wrappers always add it). +# If $ld is the same as $cc, we remove libc from $libswanted, as cc +# will normally add it to the end of the libs list. If that isn't +# the case, we need to move libc to the end of $libswanted. +case "$ld" in +"$cc") + set `echo " $libswanted " | sed -e 's@ c @ @'` + libswanted="$*" + ;; +*) + case " $libswanted " in + *" c "*) + set `echo " $libswanted " | sed -e 's@ c @ @'` + libswanted="$* c " + ;; + esac + ;; +esac + ## LARGEFILES #case "$uselargefiles-$ccisgcc" in @@ -410,6 +438,58 @@ # ;; # esac +# Once we have the compiler flags defined, Configure will +# execute the following call-back script. See hints/README.hints +# for details. +cat > UU/cc.cbu <<'EOCBU' +# This script UU/cc.cbu will get 'called-back' by Configure after it +# has prompted the user for the C compiler to use. + +# Compile and run the a test case to see if a certain gcc bug is +# present. If so, lower the optimization level when compiling +# pp_pack.c. This works around a bug in unpack. + +if test -z "$ccisgcc" -a -z "$gccversion"; then + : no tests needed for HPc +else + echo " " + echo "Testing for a certain gcc bug is fixed in your compiler..." + + # Try compiling the test case. + if $cc -o t001 -O $ccflags $ldflags -lm ../hints/t001.c; then + gccbug=`$run ./t001` + case "$gccbug" in + *fails*) + cat >&4 <> config.sh ;; + *) echo "You specified pp_pack_cflags yourself, so we'll go with your value." >&4 ;; + esac + ;; + *) echo "Your compiler is ok." >&4 + ;; + esac + else + echo " " + echo "*** WHOA THERE!!! ***" >&4 + echo " Your C compiler \"$cc\" doesn't seem to be working!" >&4 + case "$knowitall" in + '') echo " You'd better start hunting for one and let me know about it." >&4 + exit 1 + ;; + esac + fi + + rm -f t001$_o t001$_exe + fi +EOCBU + cat >UU/uselargefiles.cbu <<'EOCBU' # This script UU/uselargefiles.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use large files. @@ -543,9 +623,17 @@ else # 12 may want upping the _POSIX_C_SOURCE datestamp... ccflags=" -D_POSIX_C_SOURCE=199506L -D_REENTRANT $ccflags" - set `echo X "$libswanted "| sed -e 's/ c / pthread c /'` - shift - libswanted="$*" + case "$libswanted " in + *" pthread "*) ;; + *" c "*) + set `echo X "$libswanted "| sed -e 's/ c / pthread c /'` + shift + libswanted="$*" + ;; + *) + libswanted="$libswanted pthread " + ;; + esac fi ;; @@ -555,7 +643,7 @@ # The mysterious io_xs memory corruption in 11.00 32bit seems to get # fixed by not using Perl's malloc. Flip side is performance loss. # So we want mymalloc for all situations possible -usemymalloc='y' +usemymalloc='n' case "$usethreads" in $define|true|[yY]*) usemymalloc='n' ;; *) case "$ccisgcc" in @@ -575,7 +663,7 @@ usemymalloc='n' case "$useperlio" in - $undef|false|[nN]*) usemymalloc='y' ;; + $undef|false|[nN]*) usemymalloc='n' ;; esac # fpclassify() is a macro, the library call is Fpclassify diff -ruN perl-5.8.0/hints/irix_6.sh AP802_source/hints/irix_6.sh --- perl-5.8.0/hints/irix_6.sh Fri Jul 19 09:35:21 2002 +++ AP802_source/hints/irix_6.sh Thu Nov 7 17:44:38 2002 @@ -37,7 +37,43 @@ # If that fails, or you didn't use that, then try adjusting other # optimization options (-LNO, -INLINE, -O3 to -O2, etcetera). # The compiler bug has been reported to SGI. -# -- Allen Smith +# -- Allen Smith + +case "$use64bitall" in +$define|true|[yY]*) + case "`uname -s`" in + IRIX) + cat <&2 +You have asked for use64bitall but you aren't running on 64-bit IRIX. +I'll try changing it to use64bitint. +END + use64bitall="$undef" + + case "`uname -r`" in + [1-5]*|6.[01]) + cat <&2 +Sorry, can't do use64bitint either. Try upgrading to IRIX 6.2 or later. +END + use64bitint="$undef" + ;; + *) use64bitint="$define" + ;; + esac + ;; + esac + ;; +esac + +# Until we figure out what to be probed for in Configure (ditto for hpux.sh) +case "$usemorebits" in # Need to expand this now, then. +$define|true|[yY]*) + case "`uname -r`" in + [1-5]*|6.[01]) + uselongdouble="$define" + ;; + *) use64bitint="$define" uselongdouble="$define" ;; + esac +esac # Let's assume we want to use 'cc -n32' by default, unless the # necessary libm is missing (which has happened at least twice) @@ -48,51 +84,38 @@ esac esac +case "$use64bitint" in + "$define"|true|[yY]*) ;; + *) d_casti32="$undef" ;; +esac + cc=${cc:-cc} +cat=${cat:-cat} + +$cat > UU/cc.cbu <<'EOCCBU' +# This script UU/cc.cbu will get 'called-back' by Configure after it +# has prompted the user for the C compiler to use. case "$cc" in *gcc*) ;; *) ccversion=`cc -version 2>&1` ;; esac -case "$use64bitint" in -$define|true|[yY]*) - case "`uname -r`" in - [1-5]*|6.[01]) - cat >&4 <&4 < + + # In other words, you no longer have to worry regarding having old + # library paths (/usr/lib) in the searchpath for -n32 or -64; thank + # you very much, Albert! Now if we could just get more module authors + # to use something like this... - Allen + libscheck='case "$xxx" in *.a) /bin/ar p $xxx `/bin/ar t $xxx | sed q` >$$.o; case "`/usr/bin/file $$.o`" in @@ -106,37 +129,49 @@ esac' # NOTE: -L/usr/lib32 -L/lib32 are automatically selected by the linker - ldflags=' -L/usr/local/lib32 -L/usr/local/lib' + test -z "$ldflags" && ldflags=' -L/usr/local/lib32 -L/usr/local/lib' cccdlflags=' ' # From: David Billinghurst # If you get complaints about so_locations then change the following # line to something like: # lddlflags="-n32 -shared -check_registry /usr/lib32/so_locations" - lddlflags="-n32 -shared" - libc='/usr/lib32/libc.so' - plibpth='/usr/lib32 /lib32 /usr/ccs/lib' + test -z "$lddlflags" && lddlflags="-n32 -shared" + test -z "$libc" && libc='/usr/lib32/libc.so' + test -z "$plibpth" && plibpth='/usr/lib32 /lib32 /usr/ccs/lib' ;; *"cc -64"*) - + case "`uname -s`" in + IRIX) + $cat >&4 < # If you get complaints about so_locations then change the following # line to something like: # lddlflags="-64 -shared -check_registry /usr/lib64/so_locations" - lddlflags="-64 -shared" - libc='/usr/lib64/libc.so' - plibpth='/usr/lib64 /lib64 /usr/ccs/lib' + test -z lddlflags="-64 -shared" + test -z "$libc" && libc='/usr/lib64/libc.so' + test -z "$plibpth" && plibpth='/usr/lib64 /lib64 /usr/ccs/lib' ;; *gcc*) ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -D_POSIX_C_SOURCE" - optimize="-O3" + test -z "$optimize" && optimize="-O3" usenm='undef' case "`uname -s`" in # Without the -mabi=64 gcc in 64-bit IRIX has problems passing @@ -162,7 +197,7 @@ # Settings common to both native compiler modes. case "$cc" in *"cc -n32"*|*"cc -64"*) - ld=$cc + test -z "$ld" && ld=$cc # perl's malloc can return improperly aligned buffer # which (under 5.6.0RC1) leads into really bizarre bus errors @@ -175,10 +210,12 @@ # miniperl, as was Scott Henry with snapshots from just before # the RC1. --jhi usemymalloc='undef' -#malloc_cflags='ccflags="-DSTRICT_ALIGNMENT $ccflags"' - nm_opt='-p' - nm_so_opt='-p' + # Was at the first of the line - Allen + #malloc_cflags='ccflags="-DSTRICT_ALIGNMENT $ccflags"' + + nm_opt="$nm_opt -p" + nm_so_opt="$nm_so_opt -p" # Warnings to turn off because the source code hasn't # been cleaned up enough yet to satisfy the IRIX cc. @@ -197,24 +234,45 @@ optimize='none' ;; *7.1*|*7.2|*7.20) # Mongoose 7.1+ - ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff $woff -OPT:Olimit=0" - optimize='-O3' -# This is a temporary fix for 5.005. -# Leave pp_ctl_cflags line at left margin for Configure. See -# hints/README.hints, especially the section -# =head2 Propagating variables to config.sh -pp_ctl_cflags='optimize=-O' + ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff $woff" + case "$optimize" in + '') optimize='-O3 -OPT:Olimit=0' ;; + '-O') optimize='-O3 -OPT:Olimit=0' ;; + *) ;; + esac + + # This is a temporary fix for 5.005+. + # See hints/README.hints, especially the section + # =head2 Propagating variables to config.sh + + # Note the part about case statements not working without + # weirdness like the below echo statement... and, since + # we're in a callback unit, it's to config.sh, not UU/config.sh + # - Allen + + + pp_ctl_cflags="$pp_ctl_flags optimize=\"$optimize -O1\"" + echo "pp_ctl_cflags=\"$pp_ctl_flags optimize=\\\"\$optimize -O1\\\"\"" >> config.sh ;; + + + +# XXX What is space=ON doing in here? Could someone ask Scott Henry? - Allen + *7.*) # Mongoose 7.2.1+ - ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff $woff -OPT:Olimit=0:space=ON" - optimize='-O3' + ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff $woff" + case "$optimize" in + '') optimize='-O3 -OPT:Olimit=0:space=ON' ;; + '-O') optimize='-O3 -OPT:Olimit=0:space=ON' ;; + *) ;; + esac ;; *6.2*) # Ragnarok 6.2 ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff $woff" optimize='none' ;; *) # Be safe and not optimize - ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff $woff -OPT:Olimit=0" + ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff $woff" optimize='none' ;; esac @@ -242,15 +300,29 @@ ;; esac -# Don't groan about unused libraries. -ldflags="$ldflags -Wl,-woff,84" - # workaround for an optimizer bug +# Made to work via UU/config.sh thing (or, rather, config.sh, since we're in +# a callback) from README.hints, plus further stuff; doesn't handle -g still, +# unfortunately - Allen case "`$cc -version 2>&1`" in -*7.2.*) op_cflags='optimize=-O1'; opmini_cflags='optimize=-O1' ;; -*7.3.1.*) op_cflags='optimize=-O2'; opmini_cflags='optimize=-O2' ;; +*7.2.*) + test -z "$op_cflags" && echo "op_cflags=\"optimize=\\\"\$optimize -O1\\\"\"" >> config.sh + test -z "$op_cflags" && op_cflags="optimize=\"\$optimize -O1\"" + test -z "$opmini_cflags" && echo "opmini_cflags=\"optimize=\\\"\$optimize -O1\\\"\"" >> config.sh + test -z "$opmini_cflags" && opmini_cflags="optimize=\"\$optimize -O1\"" + ;; +*7.3.1.*) + test -z "$op_cflags" && echo "op_cflags=\"optimize=\\\"\$optimize -O2\\\"\"" >> config.sh + test -z "$op_cflags" && op_cflags="$op_cflags optimize=\"\$optimize -O2\"" + test -z "$opmini_cflags" && echo "opmini_cflags=\"optimize=\\\"\$optimize -O2\\\"\"" >> config.sh + test -z "$opmini_cflags" && opmini_cflags="optimize=\"\$optimize -O2\"" + ;; esac +EOCCBU + +# End of cc.cbu callback unit. - Allen + # We don't want these libraries. # Socket networking is in libc, these are not installed by default, # and just slow perl down. (scotth@sgi.com) @@ -258,15 +330,10 @@ shift libswanted="$*" -# Irix 6.5.6 seems to have a broken header -# don't include that (it doesn't contain S_IFMT, S_IFREG, et al) - -i_sysmode="$undef" - # I have conflicting reports about the sun, crypt, bsd, and PW # libraries on Irix 6.2. # -# One user rerports: +# One user reports: # Don't need sun crypt bsd PW under 6.2. You *may* need to link # with these if you want to run perl built under 6.2 on a 5.3 machine # (I haven't checked) @@ -287,7 +354,33 @@ shift libswanted="$*" -cat > UU/usethreads.cbu <<'EOCBU' +# libbind.{so|a} would be from a BIND/named installation - IRIX 6.5.* has +# pretty much everything that would be useful in libbind in libc, including +# accessing a local caching server (nsd) that will also look in /etc/hosts, +# NIS (yuck!), etcetera. libbind also doesn't have the _r (thread-safe +# reentrant) functions. +# - Allen + +case "`uname -r`" in +6.5) + set `echo X "$libswanted "|sed -e 's/ bind / /'` + shift + libswanted="$*" + ;; +esac + +# Don't groan about unused libraries. +case "$ldflags" in + *-Wl,-woff,84*) ;; + *) ldflags="$ldflags -Wl,-woff,84" ;; +esac + +# Irix 6.5.6 seems to have a broken header +# don't include that (it doesn't contain S_IFMT, S_IFREG, et al) + +i_sysmode="$undef" + +$cat > UU/usethreads.cbu <<'EOCBU' # This script UU/usethreads.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use threads. case "$usethreads" in @@ -328,7 +421,6 @@ exit 1 fi set `echo X "$libswanted "| sed -e 's/ c / pthread /'` - ld="${cc:-cc}" shift libswanted="$*" @@ -337,24 +429,185 @@ # These are hidden behind a _POSIX1C ifdef that would # require including for the Configure hasproto # to see these. - d_asctime_r_proto="$define" - d_ctime_r_proto="$define" - d_gmtime_r_proto="$define" - d_localtime_r_proto="$define" + +# d_asctime_r_proto="$define" +# d_ctime_r_proto="$define" +# d_gmtime_r_proto="$define" +# d_localtime_r_proto="$define" + + # Safer just to go ahead and include it, for other ifdefs like them + # (there are a lot, such as in netdb.h). - Allen + ccflags="$ccflags -DPTHREAD_H_FIRST" + + pthread_h_first="$define" + echo "pthread_h_first='define'" >> config.sh + ;; + esac 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 +$cat > UU/use64bitint.cbu <<'EOCBU' +# This script UU/use64bitint.cbu will get 'called-back' by Configure +# after it has prompted the user for whether to use 64 bit integers. + case "$use64bitint" in -$define|true|[yY]*) ;; -*) d_casti32='undef' ;; +$define|true|[yY]*) + case "`uname -r`" in + [1-5]*|6.[01]) + cat >&4 < UU/use64bitall.cbu <<'EOCBU' +# This script UU/use64bitall.cbu will get 'called-back' by Configure +# after it has prompted the user for whether to be maximally 64 bitty. + +case "$use64bitall" in +$define|true|[yY]*) + case "$cc" in + *-n32*|*-32*) + cat >&4 < UU/uselongdouble.cbu <<'EOCBU' +# This script UU/uselongdouble.cbu will get 'called-back' by Configure +# after it has prompted the user for whether to use long doubles. + +# This script is designed to test IRIX (and other machines, once it's put into +# Configure) for a bug in which they fail to round correctly when using +# sprintf/printf/etcetera on a long double with precision specified (%.0Lf or +# whatever). Sometimes, this only happens when the number in question is +# between 1 and -1, weirdly enough. - Allen + +case "$uselongdouble" in +$define|true|[yY]*) + +case "$d_PRIfldbl" in +$define|true|[yY]*) + + echo " " >try.c + $cat >>try.c < + +#define sPRIfldbl $sPRIfldbl + +#define I_STDLIB $i_stdlib +#ifdef I_STDLIB +#include +#endif + +int main() +{ + char buf1[64]; + char buf2[64]; + buf1[63] = '\0'; + buf2[63] = '\0'; + + (void)sprintf(buf1,"%.0"sPRIfldbl,(long double)0.6L); + (void)sprintf(buf2,"%.0f",(double)0.6); + if (strcmp(buf1,buf2)) { + exit(1); + } + (void)sprintf(buf1,"%.0"sPRIfldbl,(long double)-0.6L); + (void)sprintf(buf2,"%.0f",(double)-0.6); + if (strcmp(buf1,buf2)) { + exit(1); + } else { + exit(0); + } +} + +EOP + + set try + if eval $compile && $run ./try; then + rm -f try try.* >/dev/null + else + rm -f try try.* core a.out >/dev/null + ccflags="$ccflags -DHAS_LDBL_SPRINTF_BUG" + cppflags="$cppflags -DHAS_LDBL_SPRINTF_BUG" + + echo " " >try.c + $cat >>try.c < + +#define sPRIfldbl $sPRIfldbl + +#define I_STDLIB $i_stdlib +#ifdef I_STDLIB +#include +#endif + +int main() +{ + char buf1[64]; + char buf2[64]; + buf1[63] = '\0'; + buf2[63] = '\0'; + + (void)sprintf(buf1,"%.0"sPRIfldbl,(long double)1.6L); + (void)sprintf(buf2,"%.0f",(double)1.6); + if (strcmp(buf1,buf2)) { + exit(1); + } + (void)sprintf(buf1,"%.0"sPRIfldbl,(long double)-1.6L); + (void)sprintf(buf2,"%.0f",(double)-1.6); + if (strcmp(buf1,buf2)) { + exit(1); + } else { + exit(0); + } +} + +EOP + + set try + if eval $compile && $run ./try; then + rm -f try try.c >/dev/null + ccflags="$ccflags -DHAS_LDBL_SPRINTF_BUG_LESS1" + cppflags="$cppflags -DHAS_LDBL_SPRINTF_BUG_LESS1" + else + rm -f try try.c core try.o a.out >/dev/null + fi + fi +;; +*) # Can't tell! + ccflags="$ccflags -DHAS_LDBL_SPRINTF_BUG" + cppflags="$cppflags -DHAS_LDBL_SPRINTF_BUG" + ;; +esac + +# end of case statement for how to print ldbl with 'f' +;; +*) ;; +esac + +# end of case statement for whether to do long doubles + +EOCBU # Helmut Jarausch reports that Perl's malloc is rather unusable # with IRIX, and SGI confirms the problem. diff -ruN perl-5.8.0/hints/solaris_2.sh AP802_source/hints/solaris_2.sh --- perl-5.8.0/hints/solaris_2.sh Fri Jul 19 09:35:21 2002 +++ AP802_source/hints/solaris_2.sh Thu Jul 18 22:07:25 2002 @@ -363,7 +363,9 @@ # after it has prompted the user for whether to use threads. case "$usethreads" in $define|true|[yY]*) - ccflags="-D_REENTRANT $ccflags" + # -D_POSIX_C_SOURCE=199506L doesn't compile with gcc 2.95.2 :-( + #ccflags="-D_POSIX_C_SOURCE=199506L -D_REENTRANT $ccflags" + ccflags="-D_POSIX_PTHREAD_SEMANTICS -D_REENTRANT $ccflags" # sched_yield is in -lposix4 up to Solaris 2.6, in -lrt starting with Solaris 2.7 case `uname -r` in diff -ruN perl-5.8.0/iperlsys.h AP802_source/iperlsys.h --- perl-5.8.0/iperlsys.h Fri Jul 19 09:35:21 2002 +++ AP802_source/iperlsys.h Thu Nov 7 17:44:38 2002 @@ -598,7 +598,7 @@ typedef int (*LPLIOChmod)(struct IPerlLIO*, const char*, int); typedef int (*LPLIOChown)(struct IPerlLIO*, const char*, uid_t, gid_t); -typedef int (*LPLIOChsize)(struct IPerlLIO*, int, long); +typedef int (*LPLIOChsize)(struct IPerlLIO*, int, Off_t); typedef int (*LPLIOClose)(struct IPerlLIO*, int); typedef int (*LPLIODup)(struct IPerlLIO*, int); typedef int (*LPLIODup2)(struct IPerlLIO*, int, int); diff -ruN perl-5.8.0/lib/Benchmark.pm AP802_source/lib/Benchmark.pm --- perl-5.8.0/lib/Benchmark.pm Fri Jul 19 09:35:21 2002 +++ AP802_source/lib/Benchmark.pm Thu Nov 7 17:44:38 2002 @@ -196,7 +196,7 @@ Clear all cached times. -=item cmpthese ( COUT, CODEHASHREF, [ STYLE ] ) +=item cmpthese ( COUNT, CODEHASHREF, [ STYLE ] ) =item cmpthese ( RESULTSHASHREF, [ STYLE ] ) @@ -412,7 +412,7 @@ clearcache clearallcache disablecache enablecache); %EXPORT_TAGS=( all => [ @EXPORT, @EXPORT_OK ] ) ; -$VERSION = 1.04; +$VERSION = 1.05; &init; @@ -713,7 +713,9 @@ } sub cmpthese{ - my ($results, $style) = ref $_[0] ? @_ : ( timethese( @_[0,1,2] ), $_[2] ) ; + my ($results, $style) = + ref $_ [0] ? @_ + : (timethese (@_ [0, 1], @_ > 2 ? $_ [2] : "none"), $_ [2]); $style = "" unless defined $style; diff -ruN perl-5.8.0/lib/Benchmark.t AP802_source/lib/Benchmark.t --- perl-5.8.0/lib/Benchmark.t Fri Jul 19 09:35:21 2002 +++ AP802_source/lib/Benchmark.t Thu Nov 7 17:44:38 2002 @@ -8,7 +8,7 @@ use warnings; use strict; use vars qw($foo $bar $baz $ballast); -use Test::More tests => 159; +use Test::More tests => 173; use Benchmark qw(:all); @@ -346,7 +346,7 @@ { select(OUT); my $start = times; - my $chart = cmpthese( -0.1, { a => "++\$i", b => "\$i = sqrt(\$i++)" } ) ; + my $chart = cmpthese( -0.1, { a => "++\$i", b => "\$i = sqrt(\$i++)" }, "auto" ) ; my $end = times; select(STDOUT); ok (($end - $start) > 0.05, "benchmarked code ran for over 0.05 seconds"); @@ -360,6 +360,28 @@ # Remove the title $got =~ s/.*\.\.\.//s; like ($got, $default_pattern, 'should find default format somewhere'); + like ($got, $graph_dissassembly, "Should find the output graph somewhere"); + check_graph_vs_output ($chart, $got); +} + +# Not giving auto should suppress timethese results. +{ + select(OUT); + my $start = times; + my $chart = cmpthese( -0.1, { a => "++\$i", b => "\$i = sqrt(\$i++)" } ) ; + my $end = times; + select(STDOUT); + ok (($end - $start) > 0.05, "benchmarked code ran for over 0.05 seconds"); + + $got = $out->read(); + # Remove any warnings about having too few iterations. + $got =~ s/\(warning:[^\)]+\)//gs; + + unlike ($got, qr/running\W+a\W+b.*?for at least 0\.1 CPU second/s, + 'should not have title'); + # Remove the title + $got =~ s/.*\.\.\.//s; + unlike ($got, $default_pattern, 'should not find default format somewhere'); like ($got, $graph_dissassembly, "Should find the output graph somewhere"); check_graph_vs_output ($chart, $got); } diff -ruN perl-5.8.0/lib/CGI/Carp.pm AP802_source/lib/CGI/Carp.pm --- perl-5.8.0/lib/CGI/Carp.pm Fri Jul 19 09:35:21 2002 +++ AP802_source/lib/CGI/Carp.pm Thu Jul 18 22:07:25 2002 @@ -297,11 +297,15 @@ sub ineval { $^S || _longmess() =~ /eval [\{\']/m } # The mod_perl package Apache::Registry loads CGI programs by calling -# eval. These evals don't count when looking at the stack backtrace. +# eval, as does PerlEx. These evals don't count when looking at the +# stack backtrace. sub _longmess { my $message = Carp::longmess(); my $mod_perl = exists $ENV{MOD_PERL}; - $message =~ s,eval[^\n]+Apache/Registry\.pm.*,,s if $mod_perl; + my $plex = exists($ENV{'GATEWAY_INTERFACE'}) + && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-PerlEx/; + $message =~ s,eval[^\n]+(Apache/Registry\.pm|\s*PerlEx::Precompiler).*,,s + if $mod_perl or $plex; return $message; } @@ -360,8 +364,11 @@ END ; my $mod_perl = exists $ENV{MOD_PERL}; + my $plex = exists($ENV{'GATEWAY_INTERFACE'}) + && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-PerlEx/; + print STDOUT "Content-type: text/html\n\n" - unless $mod_perl; + unless $mod_perl || $plex; warningsToBrowser(1); # emit warnings before dying diff -ruN perl-5.8.0/lib/ExtUtils/MM_Unix.pm AP802_source/lib/ExtUtils/MM_Unix.pm --- perl-5.8.0/lib/ExtUtils/MM_Unix.pm Fri Jul 19 09:35:21 2002 +++ AP802_source/lib/ExtUtils/MM_Unix.pm Thu Nov 7 17:44:38 2002 @@ -1426,7 +1426,7 @@ my($ispod)=0; if (open(FH,"<$name")) { while () { - if (/^=head1\s+\w+/) { + if (/^=\w/) { $ispod=1; last; } @@ -1455,7 +1455,7 @@ my($ispod)=0; if (open(FH,"<$name")) { while () { - if (/^=head1\s+\w+/) { + if (/^=\w/) { $ispod=1; last; } diff -ruN perl-5.8.0/lib/ExtUtils/t/Installed.t AP802_source/lib/ExtUtils/t/Installed.t --- perl-5.8.0/lib/ExtUtils/t/Installed.t Fri Jul 19 09:35:21 2002 +++ AP802_source/lib/ExtUtils/t/Installed.t Thu Nov 7 17:44:38 2002 @@ -80,11 +80,9 @@ ok( $ei->_is_under('baz', @under), '... should find file under dir' ); -my $wrotelist; - rmtree 'auto/FakeMod'; ok( mkpath('auto/FakeMod') ); -END { rmtree 'auto/FakeMod' } +END { rmtree 'auto' } ok(open(PACKLIST, '>auto/FakeMod/.packlist')); print PACKLIST 'list'; @@ -230,14 +228,6 @@ is( $ei->version('yesmod'), 101, 'version() should report installed mod version' ); -END { - if ($wrotelist) { - for my $file (qw( .packlist FakePak.pm )) { - 1 while unlink $file; - } - File::Path::rmtree('auto') or warn "Couldn't rmtree auto: $!"; - } -} package Fakepak; diff -ruN perl-5.8.0/lib/Locale/Codes/t/languages.t AP802_source/lib/Locale/Codes/t/languages.t --- perl-5.8.0/lib/Locale/Codes/t/languages.t Fri Jul 19 09:35:21 2002 +++ AP802_source/lib/Locale/Codes/t/languages.t Thu Nov 7 17:44:38 2002 @@ -47,7 +47,7 @@ 'code2language("nd") eq "Ndebele, North"', 'code2language("ng") eq "Ndonga"', 'code2language("nn") eq "Norwegian Nynorsk"', - 'code2language("nb") eq "Norwegian Bokmål"', + 'code2language("nb") eq "Norwegian Bokmal"', 'code2language("ny") eq "Chichewa; Nyanja"', 'code2language("oc") eq "Occitan (post 1500)"', 'code2language("os") eq "Ossetian; Ossetic"', diff -ruN perl-5.8.0/lib/Locale/Country.pm AP802_source/lib/Locale/Country.pm --- perl-5.8.0/lib/Locale/Country.pm Fri Jul 19 09:35:21 2002 +++ AP802_source/lib/Locale/Country.pm Thu Nov 7 17:44:38 2002 @@ -267,6 +267,7 @@ my ($alpha2, $alpha3, $numeric); my ($country, @countries); + local $_; while () { diff -ruN perl-5.8.0/lib/Locale/Currency.pm AP802_source/lib/Locale/Currency.pm --- perl-5.8.0/lib/Locale/Currency.pm Fri Jul 19 09:35:21 2002 +++ AP802_source/lib/Locale/Currency.pm Thu Nov 7 17:44:38 2002 @@ -108,6 +108,7 @@ my $code; my $currency; + local $_; while () { diff -ruN perl-5.8.0/lib/Locale/Language.pm AP802_source/lib/Locale/Language.pm --- perl-5.8.0/lib/Locale/Language.pm Fri Jul 19 09:35:21 2002 +++ AP802_source/lib/Locale/Language.pm Thu Nov 7 17:44:38 2002 @@ -107,6 +107,7 @@ my $code; my $language; + local $_; while () { @@ -231,7 +232,7 @@ my:Burmese na:Nauru -nb:Norwegian Bokmål +nb:Norwegian Bokmal nd:Ndebele, North ne:Nepali ng:Ndonga @@ -300,7 +301,7 @@ uz:Uzbek vi:Vietnamese -vo:Volapük +vo:Volapuk wo:Wolof diff -ruN perl-5.8.0/lib/Locale/Script.pm AP802_source/lib/Locale/Script.pm --- perl-5.8.0/lib/Locale/Script.pm Fri Jul 19 09:35:21 2002 +++ AP802_source/lib/Locale/Script.pm Thu Nov 7 17:44:38 2002 @@ -160,6 +160,7 @@ my ($alpha2, $alpha3, $numeric); my $script; + local $_; while () { diff -ruN perl-5.8.0/lib/Pod/Html.pm AP802_source/lib/Pod/Html.pm --- perl-5.8.0/lib/Pod/Html.pm Fri Jul 19 09:35:21 2002 +++ AP802_source/lib/Pod/Html.pm Thu Nov 7 17:44:38 2002 @@ -1336,23 +1336,25 @@ my $any = "${ltrs}${gunk}${punc}"; $rest =~ s{ - \b # start at word boundary - ( # begin $1 { - $urls : # need resource and a colon - (?!:) # Ignore File::, among others. - [$any] +? # followed by one or more of any valid - # character, but be conservative and - # take only what you need to.... - ) # end $1 } - (?= # look-ahead non-consumptive assertion - [$punc]* # either 0 or more punctuation - (?: # followed - [^$any] # by a non-url char - | # or - $ # end of the string - ) # - | # or else - $ # then end of the string + \b # start at word boundary + ( # begin $1 { + $urls : # need resource and a colon + (?!:) # Ignore File::, among others. + [$any] +? # followed by one or more of any valid + # character, but be conservative and + # take only what you need to.... + ) # end $1 } + (?= + " > # maybe pre-quoted '' + | # or: + [$punc]* # 0 or more punctuation + (?: # followed + [^$any] # by a non-url char + | # or + $ # end of the string + ) # + | # or else + $ # then end of the string ) }{$1}igox; diff -ruN perl-5.8.0/lib/Pod/t/htmlview.pod AP802_source/lib/Pod/t/htmlview.pod --- perl-5.8.0/lib/Pod/t/htmlview.pod Fri Jul 19 09:35:22 2002 +++ AP802_source/lib/Pod/t/htmlview.pod Thu Nov 7 17:44:38 2002 @@ -135,6 +135,8 @@ This is an email link: mailto:foo@bar.com + This is a link in a verbatim block Perl + =head1 SEE ALSO See also L, the L and L diff -ruN perl-5.8.0/lib/Pod/t/htmlview.t AP802_source/lib/Pod/t/htmlview.t --- perl-5.8.0/lib/Pod/t/htmlview.t Fri Jul 19 09:35:22 2002 +++ AP802_source/lib/Pod/t/htmlview.t Thu Nov 7 17:44:38 2002 @@ -163,6 +163,8 @@

This is an href link1: http://example.com

This is an href link2: http://example.com/foo/bar.html

This is an email link: mailto:foo@bar.com

+
+    This is a link in a verbatim block <a href="http://perl.org"> Perl </a>

diff -ruN perl-5.8.0/lib/Term/Cap.pm AP802_source/lib/Term/Cap.pm --- perl-5.8.0/lib/Term/Cap.pm Fri Jul 19 09:35:22 2002 +++ AP802_source/lib/Term/Cap.pm Thu Nov 7 17:44:38 2002 @@ -6,7 +6,7 @@ use vars qw($VERSION $VMS_TERMCAP); use vars qw($termpat $state $first $entry); -$VERSION = '1.07'; +$VERSION = '1.08'; # Version undef: Thu Dec 14 20:02:42 CST 1995 by sanders@bsdi.com # Version 1.00: Thu Nov 30 23:34:29 EST 2000 by schwern@pobox.com @@ -29,6 +29,8 @@ # Version 1.07: Wed Jan 2 21:35:09 GMT 2002 # Sanity check on infocmp output from Norton Allen # Repaired INSTALLDIRS thanks to Michael Schwern +# Version 1.08: Fri Aug 30 14:15:55 CEST 2002 +# Cope with comments lines from 'infocmp' from Brendan O'Dea # TODO: # support Berkeley DB termcaps @@ -217,9 +219,9 @@ } else { if ( grep { -x "$_/infocmp" } split /:/, $ENV{PATH} ) { - eval - { + eval { my $tmp = `infocmp -C 2>/dev/null`; + $tmp =~ s/^#.*\n//gm; # remove comments if (( $tmp !~ m%^/%s ) && ( $tmp =~ /(^|\|)${termpat}[:|]/s)) { $entry = $tmp; diff -ruN perl-5.8.0/lib/Text/TabsWrap/t/wrap.t AP802_source/lib/Text/TabsWrap/t/wrap.t --- perl-5.8.0/lib/Text/TabsWrap/t/wrap.t Fri Jul 19 09:35:22 2002 +++ AP802_source/lib/Text/TabsWrap/t/wrap.t Thu Nov 7 17:44:38 2002 @@ -122,7 +122,7 @@ $| = 1; -print "1..", 1 +@tests, "\n"; +print "1..", 2 +@tests, "\n"; use Text::Wrap; @@ -207,3 +207,9 @@ print (($w eq "zzz$tw") ? "ok $tn\n" : "not ok $tn"); $tn++; +{ + local $Text::Wrap::columns = 10; + local $Text::Wrap::huge = "wrap"; + print ((wrap("verylongindent", "", "foo") eq "verylongindent\nfoo") ? "ok $tn\n" : "not ok $tn"); + $tn++; +} diff -ruN perl-5.8.0/lib/Text/Wrap.pm AP802_source/lib/Text/Wrap.pm --- perl-5.8.0/lib/Text/Wrap.pm Fri Jul 19 09:35:22 2002 +++ AP802_source/lib/Text/Wrap.pm Thu Nov 7 17:44:38 2002 @@ -34,6 +34,7 @@ my $t = expand(join("", (map { /\s+\z/ ? ( $_ ) : ($_, ' ') } @t), $tail)); my $lead = $ip; my $ll = $columns - length(expand($ip)) - 1; + $ll = 0 if $ll < 0; my $nll = $columns - length(expand($xp)) - 1; my $nl = ""; my $remainder = ""; @@ -144,7 +145,7 @@ C is a very simple paragraph formatter. It formats a single paragraph at a time by breaking lines at word boundries. Indentation is controlled for the first line (C<$initial_tab>) and -all subsquent lines (C<$subsequent_tab>) independently. Please note: +all subsequent lines (C<$subsequent_tab>) independently. Please note: C<$initial_tab> and C<$subsequent_tab> are the literal strings that will be used: it is unlikley you would want to pass in a number. diff -ruN perl-5.8.0/lib/Win32.pod AP802_source/lib/Win32.pod --- perl-5.8.0/lib/Win32.pod Fri Jul 19 09:35:22 2002 +++ AP802_source/lib/Win32.pod Thu Nov 7 17:44:38 2002 @@ -112,6 +112,63 @@ does not return a UNC path, since the functionality required for such a feature is not available under Windows 95. +=item Win32::GetFolderPath(FOLDER [, CREATE]) + +[EXT] Returns the full pathname of one of the Windows special folders. +The folder will be created if it doesn't exist and the optional CREATE +argument is true. The following FOLDER constants are defined by the +Win32 module, but only exported on demand: + + CSIDL_ADMINTOOLS + CSIDL_APPDATA + CSIDL_CDBURN_AREA + CSIDL_COMMON_ADMINTOOLS + CSIDL_COMMON_APPDATA + CSIDL_COMMON_DESKTOPDIRECTORY + CSIDL_COMMON_DOCUMENTS + CSIDL_COMMON_FAVORITES + CSIDL_COMMON_MUSIC + CSIDL_COMMON_PICTURES + CSIDL_COMMON_PROGRAMS + CSIDL_COMMON_STARTMENU + CSIDL_COMMON_STARTUP + CSIDL_COMMON_TEMPLATES + CSIDL_COMMON_VIDEO + CSIDL_COOKIES + CSIDL_DESKTOP + CSIDL_DESKTOPDIRECTORY + CSIDL_FAVORITES + CSIDL_FONTS + CSIDL_HISTORY + CSIDL_INTERNET_CACHE + CSIDL_LOCAL_APPDATA + CSIDL_MYMUSIC + CSIDL_MYPICTURES + CSIDL_MYVIDEO + CSIDL_NETHOOD + CSIDL_PERSONAL + CSIDL_PRINTHOOD + CSIDL_PROFILE + CSIDL_PROGRAMS + CSIDL_PROGRAM_FILES + CSIDL_PROGRAM_FILES_COMMON + CSIDL_RECENT + CSIDL_RESOURCES + CSIDL_RESOURCES_LOCALIZED + CSIDL_SENDTO + CSIDL_STARTMENU + CSIDL_STARTUP + CSIDL_SYSTEM + CSIDL_TEMPLATES + CSIDL_WINDOWS + +Note that not all folders are defined on all versions of Windows. + +Please refer to the MSDN documentation of the CSIDL constants, +currently available at: + +http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/enums/csidl.asp + =item Win32::GetFullPathName(FILENAME) [CORE] GetFullPathName combines the FILENAME with the current drive diff -ruN perl-5.8.0/lib/if.pm AP802_source/lib/if.pm --- perl-5.8.0/lib/if.pm Fri Jul 19 09:35:21 2002 +++ AP802_source/lib/if.pm Thu Nov 7 17:44:38 2002 @@ -1,13 +1,16 @@ package if; -our $VERSION = '0.01'; +our $VERSION = '0.02'; sub work { my $method = shift() ? 'import' : 'unimport'; return unless shift; # CONDITION - my $p = shift; # PACKAGE + + my $p = $_[0]; # PACKAGE eval "require $p" or die; # Adds .pm etc if needed - $p->$method(@_) if $p->can($method); + + my $m = $p->can($method); + goto &$m if $m; } sub import { shift; unshift @_, 1; goto &work } diff -ruN perl-5.8.0/lib/if.t AP802_source/lib/if.t --- perl-5.8.0/lib/if.t Fri Jul 19 09:35:21 2002 +++ AP802_source/lib/if.t Thu Nov 7 17:44:38 2002 @@ -5,7 +5,7 @@ @INC = '../lib'; } -use Test::More tests => 4; +use Test::More tests => 5; my $v_plus = $] + 1; my $v_minus = $] - 1; @@ -23,4 +23,7 @@ ok( (not defined eval "use if ($v_plus > \$]), strict => 'refs'; \${'f'} = 12" and $@ =~ /while "strict refs" in use/), '"use if" with a true condition and a pragma'); + +ok( eval "use if 1, Cwd; cwd() || 1;", + '"use if" with a true condition, module, no arguments, exports'); diff -ruN perl-5.8.0/lib/lib.t AP802_source/lib/lib.t --- perl-5.8.0/lib/lib.t Fri Jul 19 09:35:21 2002 +++ AP802_source/lib/lib.t Thu Nov 7 17:44:38 2002 @@ -6,7 +6,7 @@ @OrigINC = @INC; } -use Test::More tests => 12; +use Test::More tests => 13; use Config; use File::Spec; use File::Path; @@ -80,6 +80,9 @@ } no lib $Lib_Dir; + +unlike( do { eval 'use lib $Config{installsitelib};'; $@ || '' }, + qr/::Config is read-only/, 'lib handles readonly stuff' ); BEGIN { is( grep(/stuff/, @INC), 0, 'no lib' ); diff -ruN perl-5.8.0/lib/lib_pm.PL AP802_source/lib/lib_pm.PL --- perl-5.8.0/lib/lib_pm.PL Fri Jul 19 09:35:21 2002 +++ AP802_source/lib/lib_pm.PL Thu Nov 7 17:44:38 2002 @@ -71,30 +71,31 @@ my %names; foreach (reverse @_) { - if ($_ eq '') { + my $path = $_; # we'll be modifying it, so break the alias + if ($path eq '') { require Carp; Carp::carp("Empty compile time value given to use lib"); } - local $_ = _nativize($_); + $path = _nativize($path); - if (-e && ! -d _) { + if (-e $path && ! -d _) { require Carp; Carp::carp("Parameter to use lib must be directory, not file"); } - unshift(@INC, $_); + unshift(@INC, $path); # Add any previous version directories we found at configure time foreach my $incver (@inc_version_list) { my $dir = $Is_MacOS - ? File::Spec->catdir( $_, $incver ) - : "$_/$incver"; + ? File::Spec->catdir( $path, $incver ) + : "$path/$incver"; unshift(@INC, $dir) if -d $dir; } - # Put a corresponding archlib directory in front of $_ if it - # looks like $_ has an archlib directory below it. + # Put a corresponding archlib directory in front of $path if it + # looks like $path has an archlib directory below it. my($arch_auto_dir, $arch_dir, $version_dir, $version_arch_dir) - = _get_dirs($_); + = _get_dirs($path); unshift(@INC, $arch_dir) if -d $arch_auto_dir; unshift(@INC, $version_dir) if -d $version_dir; unshift(@INC, $version_arch_dir) if -d $version_arch_dir; diff -ruN perl-5.8.0/lib/overload.t AP802_source/lib/overload.t --- perl-5.8.0/lib/overload.t Fri Jul 19 09:35:21 2002 +++ AP802_source/lib/overload.t Thu Nov 7 17:44:38 2002 @@ -41,7 +41,7 @@ package main; -$test = 0; +our $test = 0; $| = 1; print "1..",&last,"\n"; @@ -1064,9 +1064,10 @@ my $utfvar = new utf8_o 200.2.1; -test("$utfvar" eq 200.2.1); # 223 +test("$utfvar" eq 200.2.1); # 223 - stringify +test("a$utfvar" eq "a".200.2.1); # 224 - overload via sv_2pv_flags -# 224..226 -- more %{} tests. Hangs in 5.6.0, okay in later releases. +# 225..227 -- more %{} tests. Hangs in 5.6.0, okay in later releases. # Basically this example implements strong encapsulation: if Hderef::import() # were to eval the overload code in the caller's namespace, the privatisation # would be quite transparent. @@ -1080,9 +1081,9 @@ package main; my $a = Foo->new; $a->xet('b', 42); -print $a->xet('b') == 42 ? "ok 224\n" : "not ok 224\n"; -print defined eval { $a->{b} } ? "not ok 225\n" : "ok 225\n"; -print $@ =~ /zap/ ? "ok 226\n" : "not ok 226\n"; +print $a->xet('b') == 42 ? "ok 225\n" : "not ok 225\n"; +print defined eval { $a->{b} } ? "not ok 226\n" : "ok 226\n"; +print $@ =~ /zap/ ? "ok 227\n" : "not ok 227\n"; # Last test is: -sub last {226} +sub last {227} diff -ruN perl-5.8.0/lib/utf8_heavy.pl AP802_source/lib/utf8_heavy.pl --- perl-5.8.0/lib/utf8_heavy.pl Fri Jul 19 09:35:22 2002 +++ AP802_source/lib/utf8_heavy.pl Thu Nov 7 17:44:38 2002 @@ -28,7 +28,7 @@ ## ranges. ## ## To make the parsing of $type clear, this code takes the a rather - ## unorthadox approach of last'ing out of the block once we have the + ## unorthodox approach of last'ing out of the block once we have the ## info we need. Were this to be a subroutine, the 'last' would just ## be a 'return'. ## @@ -50,7 +50,9 @@ ## ## 'Block=' is replaced by 'In'. ## - $type =~ s/^Is(?:\s+|[-_])?//i + my $wasIs; + + ($wasIs = $type =~ s/^Is(?:\s+|[-_])?//i) or $type =~ s/^Category\s*=\s*//i or @@ -85,20 +87,17 @@ ## It could be a user-defined property. ## - if ($type =~ /^I[ns](\w+)$/) { - my @caller = caller(1); - - if (defined $caller[0]) { - my $prop = $caller[0] . "::" . $type; - - if (exists &{$prop}) { - no strict 'refs'; + my $caller = caller(1); - $list = &{$prop}; - last GETFILE; - } - } - } + if (defined $caller && $type =~ /^(?:\w+)$/) { + my $prop = $caller . "::" . ( $wasIs ? "Is" : "" ) . $type; + if (exists &{$prop}) { + no strict 'refs'; + + $list = &{$prop}; + last GETFILE; + } + } ## ## Last attempt -- see if it's a "To" name (e.g. "ToLower") @@ -150,8 +149,10 @@ no warnings; $extras = join '', grep /^[^0-9a-fA-F]/, @tmp; $list = join '', - sort { hex $a <=> hex $b } - grep {/^([0-9a-fA-F]+)/ and not $seen{$1}++} @tmp; # XXX doesn't do ranges right + map { $_->[1] } + sort { $a->[0] <=> $b->[0] } + map { /^([0-9a-fA-F]+)/; [ hex($1), $_ ] } + grep { /^([0-9a-fA-F]+)/ and not $seen{$1}++ } @tmp; # XXX doesn't do ranges right } if ($none) { diff -ruN perl-5.8.0/mg.h AP802_source/mg.h --- perl-5.8.0/mg.h Fri Jul 19 09:35:22 2002 +++ AP802_source/mg.h Thu Nov 7 17:44:38 2002 @@ -33,13 +33,12 @@ I32 mg_len; }; -#define MGf_TAINTEDDIR 1 +#define MGf_TAINTEDDIR 1 /* PERL_MAGIC_envelem only */ +#define MGf_MINMATCH 1 /* PERL_MAGIC_regex_global only */ #define MGf_REFCOUNTED 2 #define MGf_GSKIP 4 #define MGf_COPY 8 #define MGf_DUP 16 - -#define MGf_MINMATCH 1 #define MgTAINTEDDIR(mg) (mg->mg_flags & MGf_TAINTEDDIR) #define MgTAINTEDDIR_on(mg) (mg->mg_flags |= MGf_TAINTEDDIR) diff -ruN perl-5.8.0/numeric.c AP802_source/numeric.c --- perl-5.8.0/numeric.c Fri Jul 19 09:35:23 2002 +++ AP802_source/numeric.c Thu Nov 7 17:44:38 2002 @@ -727,6 +727,8 @@ if (exponent == 0) return value; + if (value == 0) + return 0; /* On OpenVMS VAX we by default use the D_FLOAT double format, * and that format does not have *easy* capabilities [1] for @@ -811,27 +813,43 @@ char* Perl_my_atof2(pTHX_ const char* orig, NV* value) { - NV result = 0.0; + NV result[3] = {0.0, 0.0, 0.0}; char* s = (char*)orig; #ifdef USE_PERL_ATOF + UV accumulator[2] = {0,0}; /* before/after dp */ bool negative = 0; char* send = s + strlen(orig) - 1; - bool seendigit = 0; - I32 expextra = 0; + bool seen_digit = 0; + I32 exp_adjust[2] = {0,0}; + I32 exp_acc[2] = {-1, -1}; + /* the current exponent adjust for the accumulators */ I32 exponent = 0; - I32 i; -/* this is arbitrary */ -#define PARTLIM 6 -/* we want the largest integers we can usefully use */ -#if defined(HAS_QUAD) && defined(USE_64_BIT_INT) -# define PARTSIZE ((int)TYPE_DIGITS(U64)-1) - U64 part[PARTLIM]; -#else -# define PARTSIZE ((int)TYPE_DIGITS(U32)-1) - U32 part[PARTLIM]; -#endif - I32 ipart = 0; /* index into part[] */ - I32 offcount; /* number of digits in least significant part */ + I32 seen_dp = 0; + I32 digit = 0; + I32 old_digit = 0; + I32 sig_digits = 0; /* noof significant digits seen so far */ + +/* There is no point in processing more significant digits + * than the NV can hold. Note that NV_DIG is a lower-bound value, + * while we need an upper-bound value. We add 2 to account for this; + * since it will have been conservative on both the first and last digit. + * For example a 32-bit mantissa with an exponent of 4 would have + * exact values in the set + * 4 + * 8 + * .. + * 17179869172 + * 17179869176 + * 17179869180 + * + * where for the purposes of calculating NV_DIG we would have to discount + * both the first and last digit, since neither can hold all values from + * 0..9; but for calculating the value we must examine those two digits. + */ +#define MAX_SIG_DIGITS (NV_DIG+2) + +/* the max number we can accumulate in a UV, and still safely do 10*N+9 */ +#define MAX_ACCUMULATE ( (UV) ((UV_MAX - 9)/10)) /* leading whitespace */ while (isSPACE(*s)) @@ -846,74 +864,79 @@ ++s; } - part[0] = offcount = 0; - if (isDIGIT(*s)) { - seendigit = 1; /* get this over with */ + /* we accumulate digits into an integer; when this becomes too + * large, we add the total to NV and start again */ - /* skip leading zeros */ - while (*s == '0') - ++s; - } + while (1) { + if (isDIGIT(*s)) { + seen_digit = 1; + old_digit = digit; + digit = *s++ - '0'; + if (seen_dp) + exp_adjust[1]++; + + /* don't start counting until we see the first significant + * digit, eg the 5 in 0.00005... */ + if (!sig_digits && digit == 0) + continue; - /* integer digits */ - while (isDIGIT(*s)) { - if (++offcount > PARTSIZE) { - if (++ipart < PARTLIM) { - part[ipart] = 0; - offcount = 1; /* ++0 */ - } - else { + if (++sig_digits > MAX_SIG_DIGITS) { /* limits of precision reached */ - --ipart; - --offcount; - if (*s >= '5') - ++part[ipart]; + if (digit > 5) { + ++accumulator[seen_dp]; + } else if (digit == 5) { + if (old_digit % 2) { /* round to even - Allen */ + ++accumulator[seen_dp]; + } + } + if (seen_dp) { + exp_adjust[1]--; + } else { + exp_adjust[0]++; + } + /* skip remaining digits */ while (isDIGIT(*s)) { - ++expextra; ++s; + if (! seen_dp) { + exp_adjust[0]++; + } } /* warn of loss of precision? */ - break; } - } - part[ipart] = part[ipart] * 10 + (*s++ - '0'); - } - - /* decimal point */ - if (GROK_NUMERIC_RADIX((const char **)&s, send)) { - if (isDIGIT(*s)) - seendigit = 1; /* get this over with */ - - /* decimal digits */ - while (isDIGIT(*s)) { - if (++offcount > PARTSIZE) { - if (++ipart < PARTLIM) { - part[ipart] = 0; - offcount = 1; /* ++0 */ + else { + if (accumulator[seen_dp] > MAX_ACCUMULATE) { + /* add accumulator to result and start again */ + result[seen_dp] = S_mulexp10(result[seen_dp], + exp_acc[seen_dp]) + + (NV)accumulator[seen_dp]; + accumulator[seen_dp] = 0; + exp_acc[seen_dp] = 0; } - else { - /* limits of precision reached */ - --ipart; - --offcount; - if (*s >= '5') - ++part[ipart]; - while (isDIGIT(*s)) - ++s; - /* warn of loss of precision? */ - break; + accumulator[seen_dp] = accumulator[seen_dp] * 10 + digit; + ++exp_acc[seen_dp]; + } + } + else if (!seen_dp && GROK_NUMERIC_RADIX((const char **)&s, send)) { + seen_dp = 1; + if (sig_digits > MAX_SIG_DIGITS) { + ++s; + while (isDIGIT(*s)) { + ++s; } + break; } - --expextra; - part[ipart] = part[ipart] * 10 + (*s++ - '0'); + } + else { + break; } } - /* combine components of mantissa */ - for (i = 0; i <= ipart; ++i) - result += S_mulexp10((NV)part[ipart - i], - i ? offcount + (i - 1) * PARTSIZE : 0); + result[0] = S_mulexp10(result[0], exp_acc[0]) + (NV)accumulator[0]; + if (seen_dp) { + result[1] = S_mulexp10(result[1], exp_acc[1]) + (NV)accumulator[1]; + } - if (seendigit && (*s == 'e' || *s == 'E')) { + if (seen_digit && (*s == 'e' || *s == 'E')) { bool expnegative = 0; ++s; @@ -930,15 +953,22 @@ exponent = -exponent; } + + /* now apply the exponent */ - exponent += expextra; - result = S_mulexp10(result, exponent); + + if (seen_dp) { + result[2] = S_mulexp10(result[0],exponent+exp_adjust[0]) + + S_mulexp10(result[1],exponent-exp_adjust[1]); + } else { + result[2] = S_mulexp10(result[0],exponent+exp_adjust[0]); + } /* now apply the sign */ if (negative) - result = -result; + result[2] = -result[2]; #endif /* USE_PERL_ATOF */ - *value = result; + *value = result[2]; return s; } diff -ruN perl-5.8.0/op.c AP802_source/op.c --- perl-5.8.0/op.c Fri Jul 19 09:35:23 2002 +++ AP802_source/op.c Thu Nov 7 17:44:38 2002 @@ -1612,7 +1612,6 @@ case OP_AASSIGN: case OP_NEXTSTATE: case OP_DBSTATE: - case OP_CHOMP: PL_modcount = RETURN_UNLIMITED_NUMBER; break; case OP_RV2SV: @@ -2088,19 +2087,19 @@ } else if (type == OP_RV2SV || /* "our" declaration */ type == OP_RV2AV || type == OP_RV2HV) { /* XXX does this let anything illegal in? */ - if (cUNOPo->op_first->op_type != OP_GV) { /* MJD 20011224 */ - yyerror(Perl_form(aTHX_ "Can't declare %s in my", OP_DESC(o))); - } - if (attrs) { - GV *gv = cGVOPx_gv(cUNOPo->op_first); - PL_in_my = FALSE; - PL_in_my_stash = Nullhv; - apply_attrs(GvSTASH(gv), - (type == OP_RV2SV ? GvSV(gv) : - type == OP_RV2AV ? (SV*)GvAV(gv) : - type == OP_RV2HV ? (SV*)GvHV(gv) : (SV*)gv), - attrs, FALSE); - } + if (cUNOPo->op_first->op_type != OP_GV) { /* MJD 20011224 */ + yyerror(Perl_form(aTHX_ "Can't declare %s in %s", + OP_DESC(o), PL_in_my == KEY_our ? "our" : "my")); + } else if (attrs) { + GV *gv = cGVOPx_gv(cUNOPo->op_first); + PL_in_my = FALSE; + PL_in_my_stash = Nullhv; + apply_attrs(GvSTASH(gv), + (type == OP_RV2SV ? GvSV(gv) : + type == OP_RV2AV ? (SV*)GvAV(gv) : + type == OP_RV2HV ? (SV*)GvHV(gv) : (SV*)gv), + attrs, FALSE); + } o->op_private |= OPpOUR_INTRO; return o; } @@ -3886,8 +3885,12 @@ } } if (first->op_type == OP_CONST) { - if (ckWARN(WARN_BAREWORD) && (first->op_private & OPpCONST_BARE)) - Perl_warner(aTHX_ packWARN(WARN_BAREWORD), "Bareword found in conditional"); + if (ckWARN(WARN_BAREWORD) && (first->op_private & OPpCONST_BARE)) { + if (first->op_private & OPpCONST_STRICT) + no_bareword_allowed(first); + else + Perl_warner(aTHX_ packWARN(WARN_BAREWORD), "Bareword found in conditional"); + } if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) { op_free(first); *firstp = Nullop; diff -ruN perl-5.8.0/patchlevel.h AP802_source/patchlevel.h --- perl-5.8.0/patchlevel.h Fri Jul 19 09:35:23 2002 +++ AP802_source/patchlevel.h Thu Jul 18 22:07:25 2002 @@ -9,6 +9,8 @@ #ifndef __PATCHLEVEL_H_INCLUDED__ +#include "BuildInfo.h" + /* do not adjust the whitespace! Configure expects the numbers to be * exactly on the third column */ @@ -79,6 +81,7 @@ #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT) static char *local_patches[] = { NULL + ,ACTIVEPERL_LOCAL_PATCHES_ENTRY ,NULL }; diff -ruN perl-5.8.0/perl.h AP802_source/perl.h --- perl-5.8.0/perl.h Fri Jul 19 09:35:23 2002 +++ AP802_source/perl.h Thu Nov 7 17:44:38 2002 @@ -1130,8 +1130,10 @@ # define DBL_DIG OVR_DBL_DIG #else /* The following is all to get DBL_DIG, in order to pick a nice - default value for printing floating point numbers in Gconvert. - (see config.h) + default value for printing floating point numbers in Gconvert + (see config.h). (It also has other uses, such as figuring out if + a given precision of printing can be done with a double instead of + a long double - Allen). */ #ifdef I_LIMITS #include @@ -1186,6 +1188,29 @@ # endif #endif +/* + * This is for making sure we have a good DBL_MAX value, if possible, + * either for usage as NV_MAX or for usage in figuring out if we can + * fit a given long double into a double, if bug-fixing makes it + * necessary to do so. - Allen + */ + +#ifdef I_LIMITS +# include +#endif + +#ifdef I_VALUES +# if !(defined(DBL_MIN) && defined(DBL_MAX) && defined(I_LIMITS)) +# include +# if defined(MAXDOUBLE) && !defined(DBL_MAX) +# define DBL_MAX MAXDOUBLE +# endif +# if defined(MINDOUBLE) && !defined(DBL_MIN) +# define DBL_MIN MINDOUBLE +# endif +# endif +#endif /* defined(I_VALUES) */ + typedef NVTYPE NV; #ifdef I_IEEEFP @@ -1217,7 +1242,7 @@ # endif # ifdef LDBL_MAX # define NV_MAX LDBL_MAX -# define NV_MIN LDBL_MIN +/* Having LDBL_MAX doesn't necessarily mean that we have LDBL_MIN... -Allen */ # else # ifdef HUGE_VALL # define NV_MAX HUGE_VALL @@ -1279,7 +1304,7 @@ # ifdef DBL_EPSILON # define NV_EPSILON DBL_EPSILON # endif -# ifdef DBL_MAX +# ifdef DBL_MAX /* XXX Does DBL_MAX imply having DBL_MIN? */ # define NV_MAX DBL_MAX # define NV_MIN DBL_MIN # else @@ -1302,6 +1327,13 @@ /* rumor has it that Win32 has _fpclass() */ +/* SGI has fpclassl... but not with the same result values, + * and it's via a typedef (not via #define), so will need to redo Configure + * to use. Not worth the trouble, IMO, at least until the below is used + * more places. Also has fp_class_l, BTW, via fp_class.h. Feel free to check + * with me for the SGI manpages, SGI testing, etcetera, if you want to + * try getting this to work with IRIX. - Allen */ + #if !defined(Perl_fp_class) && (defined(HAS_FPCLASS)||defined(HAS_FPCLASSL)) # ifdef I_IEEFP # include @@ -1443,7 +1475,8 @@ * it is however best to use the native implementation of atof. * You can experiment with using your native one by -DUSE_PERL_ATOF=0. * Some good tests to try out with either setting are t/base/num.t, - * t/op/numconvert.t, and t/op/pack.t. */ + * t/op/numconvert.t, and t/op/pack.t. Note that if using long doubles + * you may need to be using a different function than atof! */ #ifndef USE_PERL_ATOF # ifndef _UNICOS @@ -1476,11 +1509,9 @@ #ifdef I_LIMITS /* Needed for cast_xxx() functions below. */ # include -#else -#ifdef I_VALUES -# include -#endif #endif +/* Included values.h above if necessary; still including limits.h down here, + * despite doing above, because math.h might have overriden... XXX - Allen */ /* * Try to figure out max and min values for the integral types. THE CORRECT @@ -2396,6 +2427,7 @@ #ifndef Perl_error_log # define Perl_error_log (PL_stderrgv \ + && isGV(PL_stderrgv) \ && GvIOp(PL_stderrgv) \ && IoOFP(GvIOp(PL_stderrgv)) \ ? IoOFP(GvIOp(PL_stderrgv)) \ @@ -4178,6 +4210,10 @@ #define UNICODE_PARA_SEPA_0 0xE2 #define UNICODE_PARA_SEPA_1 0x80 #define UNICODE_PARA_SEPA_2 0xA9 + +#ifndef PIPESOCK_MODE +# define PIPESOCK_MODE +#endif /* and finally... */ #define PERL_PATCHLEVEL_H_IMPLICIT diff -ruN perl-5.8.0/perlio.c AP802_source/perlio.c --- perl-5.8.0/perlio.c Fri Jul 19 09:35:23 2002 +++ AP802_source/perlio.c Thu Nov 7 17:44:38 2002 @@ -3839,13 +3839,16 @@ b->ptr++; /* say we have read it as far as * flush() is concerned */ b->buf++; /* Leave space in front of buffer */ + /* Note as we have moved buf up flush's + posn += ptr-buf + will naturally make posn point at CR + */ b->bufsiz--; /* Buffer is thus smaller */ code = PerlIO_fill(f); /* Fetch some more */ b->bufsiz++; /* Restore size for next time */ b->buf--; /* Point at space */ b->ptr = nl = b->buf; /* Which is what we hand * off */ - b->posn--; /* Buffer starts here */ *nl = 0xd; /* Fill in the CR */ if (code == 0) goto test; /* fill() call worked */ diff -ruN perl-5.8.0/pod/perl.pod AP802_source/pod/perl.pod --- perl-5.8.0/pod/perl.pod Fri Jul 19 09:35:23 2002 +++ AP802_source/pod/perl.pod Thu Nov 7 17:44:38 2002 @@ -262,7 +262,8 @@ =item * -roll-your-own magic variables (including multiple simultaneous DBM implementations) +roll-your-own magic variables (including multiple simultaneous DBM +implementations) Described in L and L. @@ -287,21 +288,15 @@ =item * -compilability into C code or Perl bytecode - -Described in L and L. - -=item * - support for light-weight processes (threads) -Described in L and L. +Described in L and L. =item * -support for internationalization, localization, and Unicode +support for Unicode, internationalization, and localization -Described in L and L. +Described in L, L and L. =item * diff -ruN perl-5.8.0/pod/perldelta.pod AP802_source/pod/perldelta.pod --- perl-5.8.0/pod/perldelta.pod Fri Jul 19 09:35:23 2002 +++ AP802_source/pod/perldelta.pod Thu Nov 7 17:44:38 2002 @@ -1012,10 +1012,11 @@ use MIME::QuotedPrint; - $encoded = encode_qp("Smiley in Unicode: \x{263a}"); + $encoded = encode_qp("\xDE\xAD\xBE\xEF"); $decoded = decode_qp($encoded); - print $encoded, "\n"; # "Smiley in Unicode: =263A" + print $encoded, "\n"; # "=DE=AD=BE=EF\n" + print $decoded, "\n"; # "\xDE\xAD\xBE\xEF\n" See also L. diff -ruN perl-5.8.0/pod/perlembed.pod AP802_source/pod/perlembed.pod --- perl-5.8.0/pod/perlembed.pod Fri Jul 19 09:35:23 2002 +++ AP802_source/pod/perlembed.pod Thu Nov 7 17:44:38 2002 @@ -386,6 +386,8 @@ #include #include + static PerlInterpreter *my_perl; + /** my_eval_sv(code, error_check) ** kinda like eval_sv(), ** but we pop the return value off the stack @@ -481,17 +483,18 @@ main (int argc, char **argv, char **env) { - PerlInterpreter *my_perl = perl_alloc(); char *embedding[] = { "", "-e", "0" }; AV *match_list; I32 num_matches, i; - SV *text = NEWSV(1099,0); + SV *text; STRLEN n_a; + my_perl = perl_alloc(); perl_construct(my_perl); perl_parse(my_perl, NULL, 3, embedding, NULL); PL_exit_flags |= PERL_EXIT_DESTRUCT_END; + text = NEWSV(1099,0); sv_setpv(text, "When he is at a convenience store and the bill comes to some amount like 76 cents, Maynard is aware that there is something he *should* do, something that will enable him to get back a quarter, but he has no idea *what*. He fumbles through his red squeezey changepurse and gives the boy three extra pennies with his dollar, hoping that he might luck into the correct amount. The boy gives him back two of his own pennies and then the big shiny quarter that is his prize. -RICHH"); if (match(text, "m/quarter/")) /** Does text contain 'quarter'? **/ @@ -747,7 +750,7 @@ #define DO_CLEAN 0 #endif - static PerlInterpreter *perl = NULL; + static PerlInterpreter *my_perl = NULL; int main(int argc, char **argv, char **env) @@ -758,16 +761,16 @@ int exitstatus = 0; STRLEN n_a; - if((perl = perl_alloc()) == NULL) { + if((my_perl = perl_alloc()) == NULL) { fprintf(stderr, "no memory!"); exit(1); } - perl_construct(perl); + perl_construct(my_perl); - exitstatus = perl_parse(perl, NULL, 2, embedding, NULL); + exitstatus = perl_parse(my_perl, NULL, 2, embedding, NULL); PL_exit_flags |= PERL_EXIT_DESTRUCT_END; if(!exitstatus) { - exitstatus = perl_run(perl); + exitstatus = perl_run(my_perl); while(printf("Enter file name: ") && gets(filename)) { @@ -783,8 +786,8 @@ } PL_perl_destruct_level = 0; - perl_destruct(perl); - perl_free(perl); + perl_destruct(my_perl); + perl_free(my_perl); exit(exitstatus); } diff -ruN perl-5.8.0/pod/perlfaq1.pod AP802_source/pod/perlfaq1.pod --- perl-5.8.0/pod/perlfaq1.pod Fri Jul 19 09:35:23 2002 +++ AP802_source/pod/perlfaq1.pod Thu Nov 7 17:44:38 2002 @@ -59,14 +59,15 @@ You should definitely use version 5. Version 4 is old, limited, and no longer maintained; its last patch (4.036) was in 1992, long ago and far away. Sure, it's stable, but so is anything that's dead; in fact, -perl4 had been called a dead, flea-bitten camel carcass. The most recent -production release is 5.6 (although 5.005_03 is still supported). -The most cutting-edge development release is 5.7. Further references -to the Perl language in this document refer to the production release -unless otherwise specified. There may be one or more official bug fixes -by the time you read this, and also perhaps some experimental versions -on the way to the next release. All releases prior to 5.004 were subject -to buffer overruns, a grave security issue. +perl4 had been called a dead, flea-bitten camel carcass. The most +recent production release is 5.8.0 (although 5.005_03 and 5.6.1 are +still supported). The most cutting-edge development release is 5.9. +Further references to the Perl language in this document refer to the +production release unless otherwise specified. There may be one or +more official bug fixes by the time you read this, and also perhaps +some experimental versions on the way to the next release. +All releases prior to 5.004 were subject to buffer overruns, a grave +security issue. =head2 What are perl4 and perl5? @@ -296,11 +297,12 @@ (Well, OK, maybe it's not quite that distinct, but you get the idea.) If you want support and a reasonable guarantee that what you're developing will continue to work in the future, then you have to run -the supported version. As of January 2002 that probably means -running either of the releases 5.6.1 (released in April 2001) or -5.005_03 (released in March 1999), although 5.004_05 isn't that bad -if you B need such an old version (released in April 1999) -for stability reasons. Anything older than 5.004_05 shouldn't be used. +the supported version. As of August 2002 that means running either +5.8.0 (released in July 2002), or one of the older releases like +5.6.1 (released in April 2001) or 5.005_03 (released in March 1999), +although 5.004_05 isn't that bad if you B need such an old +version (released in April 1999) for stability reasons. +Anything older than 5.004_05 shouldn't be used. Of particular note is the massive bug hunt for buffer overflow problems that went into the 5.004 release. All releases prior to diff -ruN perl-5.8.0/pod/perlfunc.pod AP802_source/pod/perlfunc.pod --- perl-5.8.0/pod/perlfunc.pod Fri Jul 19 09:35:23 2002 +++ AP802_source/pod/perlfunc.pod Thu Nov 7 17:44:38 2002 @@ -4969,8 +4969,8 @@ You can specify a precision (for numeric conversions) or a maximum width (for string conversions) by specifying a C<.> followed by a number. -For floating point formats, this specifies the number of decimal places -to show (the default being 6), eg: +For floating point formats, with the exception of 'g' and 'G', this specifies +the number of decimal places to show (the default being 6), eg: # these examples are subject to system-specific variation printf '<%f>', 1; # prints "<1.000000>" @@ -4979,6 +4979,18 @@ printf '<%e>', 10; # prints "<1.000000e+01>" printf '<%.1e>', 10; # prints "<1.0e+01>" +For 'g' and 'G', this specifies the maximum number of digits to show, +including prior to the decimal point as well as after it, eg: + + # these examples are subject to system-specific variation + printf '<%g>', 1; # prints "<1>" + printf '<%.10g>', 1; # prints "<1>" + printf '<%g>', 100; # prints "<100>" + printf '<%.1g>', 100; # prints "<1e+02>" + printf '<%.2g>', 100.01; # prints "<1e+02>" + printf '<%.5g>', 100.01; # prints "<100.01>" + printf '<%.4g>', 100.01; # prints "<100>" + For integer conversions, specifying a precision implies that the output of the number itself should be zero-padded to this width: @@ -5006,23 +5018,49 @@ =item size For numeric conversions, you can specify the size to interpret the -number as using C, C, C, C, C or C. For integer -conversions, numbers are usually assumed to be whatever the default -integer size is on your platform (usually 32 or 64 bits), but you -can override this to use instead one of the standard C types, as -supported by the compiler used to build Perl: +number as using C, C, C, C, C, or C. For integer +conversions (C), numbers are usually assumed to be +whatever the default integer size is on your platform (usually 32 or 64 +bits), but you can override this to use instead one of the standard C types, +as supported by the compiler used to build Perl: l interpret integer as C type "long" or "unsigned long" h interpret integer as C type "short" or "unsigned short" - q, L or ll interpret integer as C type "long long" or "unsigned long long" - (if your platform supports such a type, else it is an error) + q, L or ll interpret integer as C type "long long", "unsigned long long". + or "quads" (typically 64-bit integers) -For floating point conversions, numbers are usually assumed to be -the default floating point size on your platform (double or long double), -but you can force 'long double' with C, C or C if your -platform supports them. +The last will produce errors if Perl does not understand "quads" in your +installation. (This requires that either the platform natively supports quads +or Perl was specifically compiled to support quads.) You can find out +whether your Perl supports quads via L: -The size specifier 'V' has no effect for Perl code, but it supported + use Config; + ($Config{use64bitint} eq 'define' || $Config{longsize} >= 8) && + print "quads\n"; + +For floating point conversions (C), numbers are usually assumed +to be the default floating point size on your platform (double or long double), +but you can force 'long double' with C, C, or C if your +platform supports them. You can find out whether your Perl supports long +doubles via L: + + use Config; + $Config{d_longdbl} eq 'define' && print "long doubles\n"; + +You can find out whether Perl considers 'long double' to be the default +floating point size to use on your platform via L: + + use Config; + ($Config{uselongdouble} eq 'define') && + print "long doubles by default\n"; + +It can also be the case that long doubles and doubles are the same thing: + + use Config; + ($Config{doublesize} == $Config{longdblsize}) && + print "doubles are long doubles\n"; + +The size specifier C has no effect for Perl code, but it is supported for compatibility with XS code; it means 'use the standard size for a Perl integer (or floating-point number)', which is already the default for Perl code. @@ -5064,44 +5102,6 @@ point in formatted real numbers is affected by the LC_NUMERIC locale. See L. -If Perl understands "quads" (64-bit integers) (this requires -either that the platform natively support quads or that Perl -be specifically compiled to support quads), the characters - - d u o x X b i D U O - -print quads, and they may optionally be preceded by - - ll L q - -For example - - %lld %16LX %qo - -You can find out whether your Perl supports quads via L: - - use Config; - ($Config{use64bitint} eq 'define' || $Config{longsize} == 8) && - print "quads\n"; - -If Perl understands "long doubles" (this requires that the platform -support long doubles), the flags - - e f g E F G - -may optionally be preceded by - - ll L - -For example - - %llf %Lg - -You can find out whether your Perl supports long doubles via L: - - use Config; - $Config{d_longdbl} eq 'define' && print "long doubles\n"; - =item sqrt EXPR =item sqrt @@ -5253,7 +5253,7 @@ $group_read = ($mode & S_IRGRP) >> 3; $other_execute = $mode & S_IXOTH; - printf "Permissions are %04o\n", S_ISMODE($mode), "\n"; + printf "Permissions are %04o\n", S_IMODE($mode), "\n"; $is_setuid = $mode & S_ISUID; $is_setgid = S_ISDIR($mode); @@ -5281,7 +5281,7 @@ and the S_IF* functions are - S_IFMODE($mode) the part of $mode containing the permission bits + S_IMODE($mode) the part of $mode containing the permission bits and the setuid/setgid/sticky bits S_IFMT($mode) the part of $mode containing the file type diff -ruN perl-5.8.0/pod/perlipc.pod AP802_source/pod/perlipc.pod --- perl-5.8.0/pod/perlipc.pod Fri Jul 19 09:35:23 2002 +++ AP802_source/pod/perlipc.pod Thu Nov 7 17:44:38 2002 @@ -555,7 +555,7 @@ # add error processing as above $pid = open(KID_TO_WRITE, "|-"); - $SIG{ALRM} = sub { die "whoops, $program pipe broke" }; + $SIG{PIPE} = sub { die "whoops, $program pipe broke" }; if ($pid) { # parent for (@data) { diff -ruN perl-5.8.0/pod/perlunicode.pod AP802_source/pod/perlunicode.pod --- perl-5.8.0/pod/perlunicode.pod Fri Jul 19 09:35:23 2002 +++ AP802_source/pod/perlunicode.pod Thu Nov 7 17:44:38 2002 @@ -598,17 +598,8 @@ =back -The following cases do not yet work: - -=over 8 - -=item * - -the "final sigma" (Greek), and - -=item * - -anything to with locales (Lithuanian, Turkish, Azeri). +Things to do with locales (Lithuanian, Turkish, Azeri) do B work +since Perl does not understand the concept of Unicode locales. =back @@ -739,13 +730,13 @@ or user-defined character properties [b] to emulate subtraction [ 7] include Letters in word characters [ 8] note that Perl does Full case-folding in matching, not Simple: - for example U+1F88 is equivalent with U+1F000 U+03B9, + for example U+1F88 is equivalent with U+1F00 U+03B9, not with 1F80. This difference matters for certain Greek capital letters with certain modifiers: the Full case-folding decomposes the letter, while the Simple case-folding would map it to a single character. [ 9] see UTR#13 Unicode Newline Guidelines - [10] should do ^ and $ also on \x{85}, \x{2028} and \x{2029}) + [10] should do ^ and $ also on \x{85}, \x{2028} and \x{2029} (should also affect <>, $., and script line numbers) (the \x{85}, \x{2028} and \x{2029} do match \s) @@ -771,17 +762,19 @@ Level 2 - Extended Unicode Support - 3.1 Surrogates - MISSING - 3.2 Canonical Equivalents - MISSING [11][12] - 3.3 Locale-Independent Graphemes - MISSING [13] - 3.4 Locale-Independent Words - MISSING [14] - 3.5 Locale-Independent Loose Matches - MISSING [15] - - [11] see UTR#15 Unicode Normalization - [12] have Unicode::Normalize but not integrated to regexes - [13] have \X but at this level . should equal that - [14] need three classes, not just \w and \W - [15] see UTR#21 Case Mappings + 3.1 Surrogates - MISSING [11] + 3.2 Canonical Equivalents - MISSING [12][13] + 3.3 Locale-Independent Graphemes - MISSING [14] + 3.4 Locale-Independent Words - MISSING [15] + 3.5 Locale-Independent Loose Matches - MISSING [16] + + [11] Surrogates are solely a UTF-16 concept and Perl's internal + representation is UTF-8. The Encode module does UTF-16, though. + [12] see UTR#15 Unicode Normalization + [13] have Unicode::Normalize but not integrated to regexes + [14] have \X but at this level . should equal that + [15] need three classes, not just \w and \W + [16] see UTR#21 Case Mappings =item * @@ -1251,6 +1244,114 @@ Even though the algorithm based on C is faster than C for byte-encoded data, it pales in comparison to the speed of C when used with UTF-8 data. + +=head2 Porting code from perl-5.6.X + +Perl 5.8 has a different Unicode model from 5.6. In 5.6 the programmer +was required to use the C pragma to declare that a given scope +expected to deal with Unicode data and had to make sure that only +Unicode data were reaching that scope. If you have code that is +working with 5.6, you will need some of the following adjustments to +your code. The examples are written such that the code will continue +to work under 5.6, so you should be safe to try them out. + +=over 4 + +=item * + +A filehandle that should read or write UTF-8 + + if ($] > 5.007) { + binmode $fh, ":utf8"; + } + +=item * + +A scalar that is going to be passed to some extension + +Be it Compress::Zlib, Apache::Request or any extension that has no +mention of Unicode in the manpage, you need to make sure that the +UTF-8 flag is stripped off. Note that at the time of this writing +(October 2002) the mentioned modules are not UTF-8-aware. Please +check the documentation to verify if this is still true. + + if ($] > 5.007) { + require Encode; + $val = Encode::encode_utf8($val); # make octets + } + +=item * + +A scalar we got back from an extension + +If you believe the scalar comes back as UTF-8, you will most likely +want the UTF-8 flag restored: + + if ($] > 5.007) { + require Encode; + $val = Encode::decode_utf8($val); + } + +=item * + +Same thing, if you are really sure it is UTF-8 + + if ($] > 5.007) { + require Encode; + Encode::_utf8_on($val); + } + +=item * + +A wrapper for fetchrow_array and fetchrow_hashref + +When the database contains only UTF-8, a wrapper function or method is +a convenient way to replace all your fetchrow_array and +fetchrow_hashref calls. A wrapper function will also make it easier to +adapt to future enhancements in your database driver. Note that at the +time of this writing (October 2002), the DBI has no standardized way +to deal with UTF-8 data. Please check the documentation to verify if +that is still true. + + sub fetchrow { + my($self, $sth, $what) = @_; # $what is one of fetchrow_{array,hashref} + if ($] < 5.007) { + return $sth->$what; + } else { + require Encode; + if (wantarray) { + my @arr = $sth->$what; + for (@arr) { + defined && /[^\000-\177]/ && Encode::_utf8_on($_); + } + return @arr; + } else { + my $ret = $sth->$what; + if (ref $ret) { + for my $k (keys %$ret) { + defined && /[^\000-\177]/ && Encode::_utf8_on($_) for $ret->{$k}; + } + return $ret; + } else { + defined && /[^\000-\177]/ && Encode::_utf8_on($_) for $ret; + return $ret; + } + } + } + } + + +=item * + +A large scalar that you know can only contain ASCII + +Scalars that contain only ASCII and are marked as UTF-8 are sometimes +a drag to your program. If you recognize such a situation, just remove +the UTF-8 flag: + + utf8::downgrade($val) if $] > 5.007; + +=back =head1 SEE ALSO diff -ruN perl-5.8.0/pod/perluniintro.pod AP802_source/pod/perluniintro.pod --- perl-5.8.0/pod/perluniintro.pod Fri Jul 19 09:35:23 2002 +++ AP802_source/pod/perluniintro.pod Thu Nov 7 17:44:38 2002 @@ -862,7 +862,7 @@ Perl front-end C for character conversions. The following are fast conversions from ISO 8859-1 (Latin-1) bytes -to UTF-8 bytes, the code works even with older Perl 5 versions. +to UTF-8 bytes and back, the code works even with older Perl 5 versions. # ISO 8859-1 to UTF-8 s/([\x80-\xFF])/chr(0xC0|ord($1)>>6).chr(0x80|ord($1)&0x3F)/eg; diff -ruN perl-5.8.0/pp.c AP802_source/pp.c --- perl-5.8.0/pp.c Fri Jul 19 09:35:24 2002 +++ AP802_source/pp.c Thu Nov 7 17:44:39 2002 @@ -19,8 +19,6 @@ #include "reentr.h" -/* variations on pp_null */ - /* XXX I can't imagine anyone who doesn't have this actually _needs_ it, since pid_t is an integral type. --AD 2/20/1998 @@ -29,6 +27,8 @@ extern Pid_t getpid (void); #endif +/* variations on pp_null */ + PP(pp_stub) { dSP; @@ -47,6 +47,7 @@ PP(pp_padav) { dSP; dTARGET; + I32 gimme; if (PL_op->op_private & OPpLVAL_INTRO) SAVECLEARSV