This patch describes the changes made in ActivePerl build 8XX over the official Perl v5.8.4 sources from CPAN. Summary of changes in build 8XX: * Make "perl -V" output reflect ActiveState build. * Add Win32::BuildNumber() for compatibility. * Add resources to perl.exe and perl58.dll. 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.4 sources using the GNU patch utility. e.g: % cd perl-5.8.4 % patch -lNp1 < this_file --------------------------------------------------------------------------- diff -ruN perl-5.8.4/BuildInfo.h AP810_source/BuildInfo.h --- perl-5.8.4/BuildInfo.h 1969-12-31 16:00:00.000000000 -0800 +++ AP810_source/BuildInfo.h 2004-06-04 16:47:50.000000000 -0700 @@ -0,0 +1,26 @@ +/* BuildInfo.h + * + * Copyright (c) 1998-2004 ActiveState Corp. All rights reserved. + * + */ + +#ifndef ___BuildInfo__h___ +#define ___BuildInfo__h___ + +#define PRODUCT_BUILD_NUMBER "810" +#define PERLFILEVERSION "5,8,4,810\0" +#define PERLRC_VERSION 5,8,4,810 +#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 " __DATE__ " " __TIME__ +#define ACTIVEPERL_LOCAL_PATCHES_ENTRY "ActivePerl Build " PRODUCT_BUILD_NUMBER ACTIVEPERL_CHANGELIST +#define BINARY_BUILD_NOTICE PerlIO_printf(PerlIO_stdout(), "\n\ +Binary build " PRODUCT_BUILD_NUMBER ACTIVEPERL_CHANGELIST " provided by ActiveState Corp. http://www.ActiveState.com\n\ +ActiveState is a division of Sophos.\n\ +" ACTIVEPERL_VERSION "\n"); + +#endif /* ___BuildInfo__h___ */ diff -ruN perl-5.8.4/Changes AP810_source/Changes --- perl-5.8.4/Changes 2004-06-04 17:30:02.000000000 -0700 +++ AP810_source/Changes 2004-06-04 16:47:50.000000000 -0700 @@ -24,6 +24,23 @@ to the perl5-porters mailing list. You can retrieve the messages for example from http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/ +-------------------- +ActivePerl build 810 Additional core patches in ActivePerl build 810 +-------------------- +____________________________________________________________________________ +[ 22751] By: ams on 2004/04/29 08:24:31 + Log: Update to Test.pm 1.25 (from SBURKE). + Branch: perl + + lib/Test/t/05_about_verbose.t lib/Test/t/multiline.t + ! MANIFEST lib/Test.pm +____________________________________________________________________________ +[ 21540] By: rgs on 2003/10/26 14:59:53 + Log: Fix backward-compatibility issues in if.pm. + Branch: perl + ! lib/if.pm +____________________________________________________________________________ + + -------------- Version v5.8.4 Maintenance release working toward v5.8.4 -------------- diff -ruN perl-5.8.4/Configure AP810_source/Configure --- perl-5.8.4/Configure 2004-06-04 17:30:03.000000000 -0700 +++ AP810_source/Configure 2004-06-04 16:47:51.000000000 -0700 @@ -9832,6 +9832,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' @@ -9850,6 +9852,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.4/ext/util/make_ext AP810_source/ext/util/make_ext --- perl-5.8.4/ext/util/make_ext 2004-06-04 17:29:58.000000000 -0700 +++ AP810_source/ext/util/make_ext 2004-06-04 16:47:52.000000000 -0700 @@ -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.4/hints/aix.sh AP810_source/hints/aix.sh --- perl-5.8.4/hints/aix.sh 2004-06-04 17:30:02.000000000 -0700 +++ AP810_source/hints/aix.sh 2004-06-04 16:47:52.000000000 -0700 @@ -149,6 +149,28 @@ # 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" @@ -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 @@ -257,7 +263,12 @@ ;; *) ccflags="$ccflags +DD64" - ldflags="$ldflags +DD64" + + case "$archname" in + PA-RISC*) + ldflags="$ldflags +DD64" + ;; + esac ;; esac @@ -265,7 +276,7 @@ # are the right type # (NOTE: on IA64, this doesn't work with .a files.) libscheck='case "`/usr/bin/file $xxx`" in - *ELF-64*|*LP64*|*PA-RISC2.0*) ;; + *ELF-64*|*LP64*|*PA-RISC2.0*|*pa20_64*) ;; *) xxx=/no/64-bit$xxx ;; esac' @@ -278,7 +289,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,14 +352,17 @@ $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" - ld=/usr/bin/ld + ld="$cc" + #ld=/usr/bin/ld cccdlflags='-fPIC' - #lddlflags='-shared' - lddlflags='-b' + lddlflags='-shared -static-libgcc -fPIC' + case "$ccflags" in + *-mlp64*) lddlflags="$lddlflags -mlp64" ;; + esac + #lddlflags='-b' case "$optimize" in *-g*-O*|*-O*-g*) # gcc without gas will not accept -g @@ -396,6 +413,35 @@ ;; 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 + +# Link with libcres.a, a performance library, on PA-RISC when using HP C +case "$archname" in + PA-RISC*) + case "$ccisgcc" in + '') + libswanted="cres $libswanted" + ;; + esac + esac + ## LARGEFILES #case "$uselargefiles-$ccisgcc" in @@ -595,9 +641,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 ;; @@ -607,7 +661,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 @@ -627,7 +681,7 @@ usemymalloc='n' case "$useperlio" in - $undef|false|[nN]*) usemymalloc='y' ;; + $undef|false|[nN]*) usemymalloc='n' ;; esac # malloc wrap works diff -ruN perl-5.8.4/hints/solaris_2.sh AP810_source/hints/solaris_2.sh --- perl-5.8.4/hints/solaris_2.sh 2004-06-04 17:30:02.000000000 -0700 +++ AP810_source/hints/solaris_2.sh 2004-06-04 16:47:52.000000000 -0700 @@ -348,7 +348,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" # -lpthread overrides some lib C functions, so put it before c. set `echo X "$libswanted "| sed -e "s/ c / pthread c /"` diff -ruN perl-5.8.4/intrpvar.h AP810_source/intrpvar.h --- perl-5.8.4/intrpvar.h 2004-06-04 17:30:03.000000000 -0700 +++ AP810_source/intrpvar.h 2004-06-04 16:47:52.000000000 -0700 @@ -527,11 +527,14 @@ PERLVAR(Isort_RealCmp, SVCOMPARE_t) +/* Iin_load_module moved here because it was already in build 806 */ +PERLVARI(Iin_load_module, int, 0) /* to prevent recursions in PerlIO_find_layer */ + PERLVARI(Icheckav_save, AV*, Nullav) /* save CHECK{}s when compiling */ PERLVARI(Iclocktick, long, 0) /* this many times() ticks in a second */ -PERLVARI(Iin_load_module, int, 0) /* to prevent recursions in PerlIO_find_layer */ +/* PERLVARI(Iin_load_module, int, 0) */ /* to prevent recursions in PerlIO_find_layer */ PERLVAR(Iunicode, U32) /* Unicode features: $ENV{PERL_UNICODE} or -C */ @@ -575,4 +578,3 @@ * XSUB.h provides wrapper functions via perlapi.h that make this * irrelevant, but not all code may be expected to #include XSUB.h. */ - diff -ruN perl-5.8.4/lib/CGI/Carp.pm AP810_source/lib/CGI/Carp.pm --- perl-5.8.4/lib/CGI/Carp.pm 2004-06-04 17:29:59.000000000 -0700 +++ AP810_source/lib/CGI/Carp.pm 2004-06-04 16:47:52.000000000 -0700 @@ -368,12 +368,16 @@ # 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(); - $message =~ s,eval[^\n]+(ModPerl|Apache)/Registry\w*\.pm.*,,s - if exists $ENV{MOD_PERL}; - return $message; + my $mod_perl = exists $ENV{MOD_PERL}; + my $plex = exists($ENV{'GATEWAY_INTERFACE'}) + && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-PerlEx/; + $message =~ s,eval[^\n]+((ModPerl|Apache)/Registry\w*\.pm|\s*PerlEx::Precompiler).*,,s + if $mod_perl or $plex; + return $message; } sub ineval { @@ -440,15 +444,17 @@ For help, please send mail to $wm, giving this error message and the time and date of the error. END - ; - my $mod_perl = exists $ENV{MOD_PERL}; + ; + my $mod_perl = exists $ENV{MOD_PERL}; + my $plex = exists($ENV{'GATEWAY_INTERFACE'}) + && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-PerlEx/; warningsToBrowser(1); # emit warnings before dying if ($CUSTOM_MSG) { if (ref($CUSTOM_MSG) eq 'CODE') { print STDOUT "Content-type: text/html\n\n" - unless $mod_perl; + unless $mod_perl || $plex; &$CUSTOM_MSG($msg); # nicer to perl 5.003 users return; } else { diff -ruN perl-5.8.4/lib/ExtUtils/Install.pm AP810_source/lib/ExtUtils/Install.pm --- perl-5.8.4/lib/ExtUtils/Install.pm 2004-06-04 17:30:00.000000000 -0700 +++ AP810_source/lib/ExtUtils/Install.pm 2004-06-04 16:47:53.000000000 -0700 @@ -205,7 +205,7 @@ if ($pack{'write'}) { $dir = install_rooted_dir(dirname($pack{'write'})); mkpath($dir,0,0755) unless $nonono; - print "Writing $pack{'write'}\n"; + print "Writing $pack{'write'}\n" if $verbose; $packlist->write(install_rooted_file($pack{'write'})) unless $nonono; } } @@ -370,7 +370,7 @@ } # if not verbose, we just say nothing } else { - print "Unlinking $targetfile (shadowing?)\n"; + print "Unlinking $targetfile (shadowing?)\n" if $verbose; forceunlink($targetfile); } } diff -ruN perl-5.8.4/lib/ExtUtils/MM_Unix.pm AP810_source/lib/ExtUtils/MM_Unix.pm --- perl-5.8.4/lib/ExtUtils/MM_Unix.pm 2004-06-04 17:30:01.000000000 -0700 +++ AP810_source/lib/ExtUtils/MM_Unix.pm 2004-06-04 16:47:53.000000000 -0700 @@ -1612,7 +1612,7 @@ my($ispod)=0; if (open(FH,"<$name")) { while () { - if (/^=head1\s+\w+/) { + if (/^=\w/) { $ispod=1; last; } @@ -3357,7 +3357,14 @@ } - $ppd_xml .= sprintf <<'PPD_OUT', $Config{archname}; + + my $archname = $Config{archname}; + if ($^V ge v5.8) { +# archname did not change from 5.6 to 5.8, but those versions may not be not binary compatible +# so now we append the part of the version that changes when binary compatibility may change + $archname .= "-". substr($Config{version},0,3); + } + $ppd_xml .= sprintf <<'PPD_OUT', $archname; PPD_OUT diff -ruN perl-5.8.4/lib/ExtUtils/t/basic.t AP810_source/lib/ExtUtils/t/basic.t --- perl-5.8.4/lib/ExtUtils/t/basic.t 2004-06-04 17:30:00.000000000 -0700 +++ AP810_source/lib/ExtUtils/t/basic.t 2004-06-04 16:47:53.000000000 -0700 @@ -96,7 +96,13 @@ ' ' ); like( $ppd_html, qr{^\s*}m, ' ' ); -like( $ppd_html, qr{^\s*}m, +my $archname = $Config{archname}; +if ($^V ge v5.8) { +# archname did not change from 5.6 to 5.8, but those versions may not be not binary compatible +# so now we append the part of the version that changes when binary compatibility may change + $archname .= "-". substr($Config{version},0,3); +} +like( $ppd_html, qr{^\s*}m, ' '); like( $ppd_html, qr{^\s*}m, ' '); like( $ppd_html, qr{^\s*}m, ' '); @@ -118,7 +124,7 @@ diag $test_out; -my $install_out = run("$make install"); +my $install_out = run("$make install VERBINST=1"); is( $?, 0, 'install' ) || diag $install_out; like( $install_out, qr/^Installing /m ); like( $install_out, qr/^Writing /m ); @@ -138,7 +144,7 @@ SKIP: { skip "VMS install targets do not preserve $(PREFIX)", 8 if $Is_VMS; - $install_out = run("$make install PREFIX=elsewhere"); + $install_out = run("$make install VERBINST=1 PREFIX=elsewhere"); is( $?, 0, 'install with PREFIX override' ) || diag $install_out; like( $install_out, qr/^Installing /m ); like( $install_out, qr/^Writing /m ); @@ -157,7 +163,7 @@ SKIP: { skip "VMS install targets do not preserve $(DESTDIR)", 10 if $Is_VMS; - $install_out = run("$make install PREFIX= DESTDIR=other"); + $install_out = run("$make install VERBINST=1 PREFIX= DESTDIR=other"); is( $?, 0, 'install with DESTDIR' ) || diag $install_out; like( $install_out, qr/^Installing /m ); @@ -197,7 +203,7 @@ SKIP: { skip "VMS install targets do not preserve $(PREFIX)", 9 if $Is_VMS; - $install_out = run("$make install PREFIX=elsewhere DESTDIR=other/"); + $install_out = run("$make install VERBINST=1 PREFIX=elsewhere DESTDIR=other/"); is( $?, 0, 'install with PREFIX override and DESTDIR' ) || diag $install_out; like( $install_out, qr/^Installing /m ); diff -ruN perl-5.8.4/lib/if.pm AP810_source/lib/if.pm --- perl-5.8.4/lib/if.pm 2004-06-04 17:30:00.000000000 -0700 +++ AP810_source/lib/if.pm 2004-06-04 16:47:53.000000000 -0700 @@ -1,6 +1,6 @@ package if; -our $VERSION = '0.03'; +$VERSION = '0.04'; sub work { my $method = shift() ? 'import' : 'unimport'; @@ -8,7 +8,7 @@ my $p = $_[0]; # PACKAGE (my $file = "$p.pm") =~ s!::!/!g; - require $file or die; + require $file; my $m = $p->can($method); goto &$m if $m; diff -ruN perl-5.8.4/lib/Pod/Find.pm AP810_source/lib/Pod/Find.pm --- perl-5.8.4/lib/Pod/Find.pm 2004-06-04 17:29:59.000000000 -0700 +++ AP810_source/lib/Pod/Find.pm 2004-06-04 16:47:53.000000000 -0700 @@ -193,7 +193,7 @@ my $name; if(-f $try) { if($name = _check_and_extract_name($try, $opts{-verbose})) { - _check_for_duplicates($try, $name, \%names, \%pods); + _check_for_duplicates($try, $name, \%names, \%pods, $opts{-verbose}); } next; } @@ -218,7 +218,7 @@ return; } if($name = _check_and_extract_name($item, $opts{-verbose}, $root_rx)) { - _check_for_duplicates($item, $name, \%names, \%pods); + _check_for_duplicates($item, $name, \%names, \%pods, $opts{-verbose}); } }, $try); # end of File::Find::find } @@ -227,11 +227,12 @@ } sub _check_for_duplicates { - my ($file, $name, $names_ref, $pods_ref) = @_; - if($$names_ref{$name}) { - warn "Duplicate POD found (shadowing?): $name ($file)\n"; - warn " Already seen in ", - join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n"; + my ($file, $name, $names_ref, $pods_ref, $verbose) = @_; + if ($$names_ref{$name}) { + warn "Duplicate POD found (shadowing?): $name ($file)\n", + " Already seen in ", + join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n" + if $verbose; } else { $$names_ref{$name} = 1; @@ -244,7 +245,7 @@ # check extension or executable flag # this involves testing the .bat extension on Win32! - unless(-f $file && -T _ && ($file =~ /\.(pod|pm|plx?)\z/i || -x _ )) { + unless(-f $file && -T _ && ($file =~ /\.(pod|pm|plx?)\z/i || -x $file )) { return undef; } diff -ruN perl-5.8.4/lib/Pod/Html.pm AP810_source/lib/Pod/Html.pm --- perl-5.8.4/lib/Pod/Html.pm 2004-06-04 17:29:59.000000000 -0700 +++ AP810_source/lib/Pod/Html.pm 2004-06-04 16:47:53.000000000 -0700 @@ -161,7 +161,7 @@ --quiet --noquiet -Don't display I warning messages. These messages +Don't display warning messages. These messages will be displayed by default. But this is not the same as C mode. @@ -530,7 +530,7 @@ } else { /^=(\S*)\s*/; warn "$0: $Podfile: unknown pod directive '$1' in " - . "paragraph $Paragraph. ignoring.\n"; + . "paragraph $Paragraph. ignoring.\n" unless $Quiet; } } $Top = 0; @@ -889,7 +889,7 @@ scan_items( \%Items, "$pod", @poddata); } else { - warn "$0: shouldn't be here (line ".__LINE__."\n"; + warn "$0: shouldn't be here (line ".__LINE__."\n" unless $Quiet; } } @poddata = (); # clean-up a bit @@ -1065,7 +1065,7 @@ my $level = $1; if( $Listlevel ){ - warn "$0: $Podfile: unterminated list at =head in paragraph $Paragraph. ignoring.\n"; + warn "$0: $Podfile: unterminated list at =head in paragraph $Paragraph. ignoring.\n" unless $Quiet; while( $Listlevel ){ process_back(); } @@ -1133,7 +1133,7 @@ # bad! but, the proper thing to do seems to be to just assume # they did do an =over. so warn them once and then continue. if( $Listlevel == 0 ){ - warn "$0: $Podfile: unexpected =item directive in paragraph $Paragraph. ignoring.\n"; + warn "$0: $Podfile: unexpected =item directive in paragraph $Paragraph. ignoring.\n" unless $Quiet; process_over(); } @@ -1192,7 +1192,7 @@ # sub process_back { if( $Listlevel == 0 ){ - warn "$0: $Podfile: unexpected =back directive in paragraph $Paragraph. ignoring.\n"; + warn "$0: $Podfile: unexpected =back directive in paragraph $Paragraph. ignoring.\n" unless $Quiet; return; } @@ -1621,7 +1621,7 @@ # warning; show some text. $linktext = $opar unless defined $linktext; - warn "$0: $Podfile: cannot resolve L<$opar> in paragraph $Paragraph.\n"; + warn "$0: $Podfile: cannot resolve L<$opar> in paragraph $Paragraph.\n" unless $Quiet; } # now we have a URL or just plain code @@ -1644,7 +1644,7 @@ } elsif( $func eq 'Z' ){ # Z<> - empty warn "$0: $Podfile: invalid X<> in paragraph $Paragraph.\n" - unless $$rstr =~ s/^>//; + unless $$rstr =~ s/^>// or $Quiet; } else { my $term = pattern $closing; @@ -1662,7 +1662,7 @@ if( $lev == 1 ){ $res .= pure_text( $$rstr ); } else { - warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph.\n"; + warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph.\n" unless $Quiet; } } return $res; @@ -1686,7 +1686,7 @@ } $res .= $2; } - warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph.\n"; + warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph.\n" unless $Quiet; return $res; } @@ -2069,7 +2069,7 @@ # honour the perlfunc manpage: func [PAR[,[ ]PAR]...] # and some funnies with ... Module ... - return $1 if $text =~ m{^([a-z\d]+)(\s+[A-Z\d,/& ]+)?$}; + return $1 if $text =~ m{^([a-z\d_]+)(\s+[A-Z\d,/& ]+)?$}; return $1 if $text =~ m{^([a-z\d]+)\s+Module(\s+[A-Z\d,/& ]+)?$}; # text? normalize! diff -ruN perl-5.8.4/lib/Test/t/05_about_verbose.t AP810_source/lib/Test/t/05_about_verbose.t --- perl-5.8.4/lib/Test/t/05_about_verbose.t 1969-12-31 16:00:00.000000000 -0800 +++ AP810_source/lib/Test/t/05_about_verbose.t 2004-06-04 16:47:53.000000000 -0700 @@ -0,0 +1,82 @@ +require 5; +# Time-stamp: "2004-04-24 16:53:03 ADT" + +# Summary of, well, things. + +use Test; +BEGIN {plan tests => 2}; + +ok 1; + +{ + my @out; + push @out, + "\n\nPerl v", + defined($^V) ? sprintf('%vd', $^V) : $], + " under $^O ", + (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber()) + ? ("(Win32::BuildNumber ", &Win32::BuildNumber(), ")") : (), + (defined $MacPerl::Version) + ? ("(MacPerl version $MacPerl::Version)") : (), + "\n" + ; + + # Ugly code to walk the symbol tables: + my %v; + my @stack = (''); # start out in %:: + my $this; + my $count = 0; + my $pref; + while(@stack) { + $this = shift @stack; + die "Too many packages?" if ++$count > 1000; + next if exists $v{$this}; + next if $this eq 'main'; # %main:: is %:: + + #print "Peeking at $this => ${$this . '::VERSION'}\n"; + + if(defined ${$this . '::VERSION'} ) { + $v{$this} = ${$this . '::VERSION'} + } elsif( + defined *{$this . '::ISA'} or defined &{$this . '::import'} + or ($this ne '' and grep defined *{$_}{'CODE'}, values %{$this . "::"}) + # If it has an ISA, an import, or any subs... + ) { + # It's a class/module with no version. + $v{$this} = undef; + } else { + # It's probably an unpopulated package. + ## $v{$this} = '...'; + } + + $pref = length($this) ? "$this\::" : ''; + push @stack, map m/^(.+)::$/ ? "$pref$1" : (), keys %{$this . '::'}; + #print "Stack: @stack\n"; + } + push @out, " Modules in memory:\n"; + delete @v{'', '[none]'}; + foreach my $p (sort {lc($a) cmp lc($b)} keys %v) { + $indent = ' ' x (2 + ($p =~ tr/:/:/)); + push @out, ' ', $indent, $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n"; + } + push @out, sprintf "[at %s (local) / %s (GMT)]\n", + scalar(gmtime), scalar(localtime); + my $x = join '', @out; + $x =~ s/^/#/mg; + print $x; +} + +print "# Running", + (chr(65) eq 'A') ? " in an ASCII world.\n" : " in a non-ASCII world.\n", + "#\n", +; + +print "# \@INC:\n", map("# [$_]\n", @INC), "#\n#\n"; + +print "# \%INC:\n"; +foreach my $x (sort {lc($a) cmp lc($b)} keys %INC) { + print "# [$x] = [", $INC{$x} || '', "]\n"; +} + +ok 1; + diff -ruN perl-5.8.4/lib/Test/t/multiline.t AP810_source/lib/Test/t/multiline.t --- perl-5.8.4/lib/Test/t/multiline.t 1969-12-31 16:00:00.000000000 -0800 +++ AP810_source/lib/Test/t/multiline.t 2004-06-04 16:47:53.000000000 -0700 @@ -0,0 +1,47 @@ +#!./perl -w + +BEGIN { open(STDERR, ">&STDOUT"); } + +use strict; +use Test; plan tests => 2, todo => [1,2]; # actually false failure + +# perl -Ilib -It/noinck t/multiline.t + +ok( +q{ +Jojo was a man who thought he was a loner +But he knew it couldn't last +Jojo left his home in Tucson, Arizona +For some California Grass +Get back, get back +Get back to where you once belonged +Get back, get back +Get back to where you once belonged +Get back Jojo Go home +Get back, get back +Back to where you once belonged +Get back, get back +Back to where you once belonged +Get back Jo +} +, +q{ +Sweet Loretta Martin thought she was a woman +But she was another man +All the girls around her say she's got it coming +But she gets it while she can +Get back, get back +Get back to where you once belonged +Get back, get back +Get back to where you once belonged +Get back Loretta Go home +Get back, get back +Get back to where you once belonged +Get back, get back +Get back to where you once belonged +Get home Loretta +}); + +ok "zik\nzak\n wazaaaaap\ncha ching!\n", "crunk\n\t zonk\nbjork\nchachacha!\n"; + + diff -ruN perl-5.8.4/lib/Test.pm AP810_source/lib/Test.pm --- perl-5.8.4/lib/Test.pm 2004-06-04 17:30:00.000000000 -0700 +++ AP810_source/lib/Test.pm 2004-06-04 16:47:53.000000000 -0700 @@ -1,13 +1,13 @@ require 5.004; package Test; -# Time-stamp: "2003-04-18 21:48:01 AHDT" +# Time-stamp: "2004-04-28 21:46:51 ADT" use strict; use Carp; use vars (qw($VERSION @ISA @EXPORT @EXPORT_OK $ntest $TestLevel), #public-ish - qw($TESTOUT $TESTERR %Program_Lines + qw($TESTOUT $TESTERR %Program_Lines $told_about_diff $ONFAIL %todo %history $planned @FAILDETAIL) #private-ish ); @@ -21,7 +21,7 @@ $planned = 0; } -$VERSION = '1.24'; +$VERSION = '1.25'; require Exporter; @ISA=('Exporter'); @@ -74,11 +74,11 @@ ok 'segmentation fault', '/(?i)success/'; #regex match skip( - $^O eq 'MSWin' ? "Skip unless MSWin" : 0, # whether to skip + $^O =~ m/MSWin/ ? "Skip if MSWin" : 0, # whether to skip $foo, $bar # arguments just like for ok(...) ); skip( - $^O eq 'MSWin' ? 0 : "Skip if MSWin", # whether to skip + $^O =~ m/MSWin/ ? 0 : "Skip unless MSWin", # whether to skip $foo, $bar # arguments just like for ok(...) ); @@ -159,14 +159,14 @@ _read_program( (caller)[1] ); my $max=0; - for (my $x=0; $x < @_; $x+=2) { - my ($k,$v) = @_[$x,$x+1]; + while (@_) { + my ($k,$v) = splice(@_, 0, 2); if ($k =~ /^test(s)?$/) { $max = $v; } - elsif ($k eq 'todo' or + elsif ($k eq 'todo' or $k eq 'failok') { for (@$v) { $todo{$_}=1; }; } - elsif ($k eq 'onfail') { + elsif ($k eq 'onfail') { ref $v eq 'CODE' or croak "Test::plan(onfail => $v): must be CODE"; - $ONFAIL = $v; + $ONFAIL = $v; } else { carp "Test::plan(): skipping unrecognized directive '$k'" } } @@ -189,7 +189,7 @@ printf $TESTOUT "# Current time local: %s\n# Current time GMT: %s\n", scalar(localtime($^T)), scalar(gmtime($^T)); - + print $TESTOUT "# Using Test.pm version $VERSION\n"; # Retval never used: @@ -203,10 +203,10 @@ open(SOURCEFILE, "<$file") || return; $Program_Lines{$file} = []; close(SOURCEFILE); - + foreach my $x (@{$Program_Lines{$file}}) { $x =~ tr/\cm\cj\n\r//d } - + unshift @{$Program_Lines{$file}}, ''; return 1; } @@ -218,16 +218,39 @@ my $value = _to_value($input); Converts an C parameter to its value. Typically this just means -running it, if it's a code reference. You should run all inputted +running it, if it's a code reference. You should run all inputted values through this. =cut sub _to_value { my ($v) = @_; - return (ref $v or '') eq 'CODE' ? $v->() : $v; + return ref $v eq 'CODE' ? $v->() : $v; +} + +sub _quote { + my $str = $_[0]; + return "" unless defined $str; + $str =~ s/\\/\\\\/g; + $str =~ s/"/\\"/g; + $str =~ s/\a/\\a/g; + $str =~ s/[\b]/\\b/g; + $str =~ s/\e/\\e/g; + $str =~ s/\f/\\f/g; + $str =~ s/\n/\\n/g; + $str =~ s/\r/\\r/g; + $str =~ s/\t/\\t/g; + $str =~ s/([\0-\037])(?!\d)/sprintf('\\%o',ord($1))/eg; + $str =~ s/([\0-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg; + $str =~ s/([^\0-\176])/sprintf('\\x{%X}',ord($1))/eg; + #if( $_[1] ) { + # substr( $str , 218-3 ) = "..." + # if length($str) >= 218 and !$ENV{PERL_TEST_NO_TRUNC}; + #} + return qq("$str"); } + =end _private =item C @@ -271,17 +294,35 @@ time() - $start_time >= 4 }); -In its two-argument form, C,I)> compares the two scalar -values to see if they equal. (The equality is checked with C). +In its two-argument form, C, I)> compares the two +scalar values to see if they match. They match if both are undefined, +or if I is a regex that matches I, or if they compare equal +with C. # Example of ok(scalar, scalar) ok( "this", "that" ); # not ok, 'this' ne 'that' + ok( "", undef ); # not ok, "" is defined + +The second argument is considered a regex if it is either a regex +object or a string that looks like a regex. Regex objects are +constructed with the qr// operator in recent versions of perl. A +string is considered to look like a regex if its first and last +characters are "/", or if the first character is "m" +and its second and last characters are both the +same non-alphanumeric non-whitespace character. These regexp + +Regex examples: + + ok( 'JaffO', '/Jaff/' ); # ok, 'JaffO' =~ /Jaff/ + ok( 'JaffO', 'm|Jaff|' ); # ok, 'JaffO' =~ m|Jaff| + ok( 'JaffO', qr/Jaff/ ); # ok, 'JaffO' =~ qr/Jaff/; + ok( 'JaffO', '/(?i)jaff/ ); # ok, 'JaffO' =~ /jaff/i; If either (or both!) is a subroutine reference, it is run and used as the value for comparing. For example: - ok 4, sub { + ok sub { open(OUT, ">x.dat") || die $!; print OUT "\x{e000}"; close OUT; @@ -289,24 +330,16 @@ unlink 'x.dat' or warn "Can't unlink : $!"; return $bytecount; }, + 4 ; -The above test passes two values to C -- the first is -the number 4, and the second is a coderef. Before C compares them, +The above test passes two values to C -- the first +a coderef, and the second is the number 4. Before C compares them, it calls the coderef, and uses its return value as the real value of this parameter. Assuming that C<$bytecount> returns 4, C ends up -testing C<4 eq 4>. Since that's true, this test passes. - -If C is either a regex object (i.e., C) or a string -that I a regex (e.g., C<'/foo/'>), then -C,I)> will perform a pattern -match against it, instead of using C. +testing C<4 eq 4>. Since that's true, this test passes. - ok( 'JaffO', '/Jaff/' ); # ok, 'JaffO' =~ /Jaff/ - ok( 'JaffO', qr/Jaff/ ); # ok, 'JaffO' =~ qr/Jaff/; - ok( 'JaffO', '/(?i)jaff/ ); # ok, 'JaffO' =~ /jaff/i; - -Finally, you can append an optional third argument, in +Finally, you can append an optional third argument, in C,I, I)>, where I is a string value that will be printed if the test fails. This should be some useful information about the test, pertaining to why it failed, and/or @@ -348,7 +381,7 @@ my $ok=0; my $result = _to_value(shift); - my ($expected,$diag,$isregex,$regex); + my ($expected, $isregex, $regex); if (@_ == 0) { $ok = $result; } else { @@ -358,7 +391,7 @@ $ok = !defined $result; } elsif (!defined $result) { $ok = 0; - } elsif ((ref($expected)||'') eq 'Regexp') { + } elsif (ref($expected) eq 'Regexp') { $ok = $result =~ /$expected/; $regex = $expected; } elsif (($regex) = ($expected =~ m,^ / (.+) / $,sx) or @@ -380,64 +413,206 @@ else { print $TESTOUT "ok $ntest\n"; } - - if (!$ok) { - my $detail = { 'repetition' => $repetition, 'package' => $pkg, - 'result' => $result, 'todo' => $todo }; - $$detail{expected} = $expected if defined $expected; - - # Get the user's diagnostic, protecting against multi-line - # diagnostics. - $diag = $$detail{diagnostic} = _to_value(shift) if @_; - $diag =~ s/\n/\n#/g if defined $diag; - - $context .= ' *TODO*' if $todo; - if (!$compare) { - if (!$diag) { - print $TESTERR "# Failed test $ntest in $context\n"; - } else { - print $TESTERR "# Failed test $ntest in $context: $diag\n"; - } - } else { - my $prefix = "Test $ntest"; - print $TESTERR "# $prefix got: ". - (defined $result? "'$result'":'')." ($context)\n"; - $prefix = ' ' x (length($prefix) - 5); - if (defined $regex) { - $expected = 'qr{'.$regex.'}'; - } - elsif (defined $expected) { - $expected = "'$expected'"; - } - else { - $expected = ''; - } - if (!$diag) { - print $TESTERR "# $prefix Expected: $expected\n"; - } else { - print $TESTERR "# $prefix Expected: $expected ($diag)\n"; - } - } - - if(defined $Program_Lines{$file}[$line]) { - print $TESTERR - "# $file line $line is: $Program_Lines{$file}[$line]\n" - if - $Program_Lines{$file}[$line] =~ m/[^\s\#\(\)\{\}\[\]\;]/ - # Otherwise it's a pretty uninteresting line! - ; - - undef $Program_Lines{$file}[$line]; - # So we won't repeat it. - } - push @FAILDETAIL, $detail; - } + $ok or _complain($result, $expected, + { + 'repetition' => $repetition, 'package' => $pkg, + 'result' => $result, 'todo' => $todo, + 'file' => $file, 'line' => $line, + 'context' => $context, 'compare' => $compare, + @_ ? ('diagnostic' => _to_value(shift)) : (), + }); + } ++ $ntest; $ok; } + +sub _complain { + my($result, $expected, $detail) = @_; + $$detail{expected} = $expected if defined $expected; + + # Get the user's diagnostic, protecting against multi-line + # diagnostics. + my $diag = $$detail{diagnostic}; + $diag =~ s/\n/\n#/g if defined $diag; + + $$detail{context} .= ' *TODO*' if $$detail{todo}; + if (!$$detail{compare}) { + if (!$diag) { + print $TESTERR "# Failed test $ntest in $$detail{context}\n"; + } else { + print $TESTERR "# Failed test $ntest in $$detail{context}: $diag\n"; + } + } else { + my $prefix = "Test $ntest"; + + print $TESTERR "# $prefix got: " . _quote($result) . + " ($$detail{context})\n"; + $prefix = ' ' x (length($prefix) - 5); + my $expected_quoted = (defined $$detail{regex}) + ? 'qr{'.($$detail{regex}).'}' : _quote($expected); + + print $TESTERR "# $prefix Expected: $expected_quoted", + $diag ? " ($diag)" : (), "\n"; + + _diff_complain( $result, $expected, $detail, $prefix ) + if defined($expected) and 2 < ($expected =~ tr/\n//); + } + + if(defined $Program_Lines{ $$detail{file} }[ $$detail{line} ]) { + print $TESTERR + "# $$detail{file} line $$detail{line} is: $Program_Lines{ $$detail{file} }[ $$detail{line} ]\n" + if $Program_Lines{ $$detail{file} }[ $$detail{line} ] + =~ m/[^\s\#\(\)\{\}\[\]\;]/; # Otherwise it's uninformative + + undef $Program_Lines{ $$detail{file} }[ $$detail{line} ]; + # So we won't repeat it. + } + + push @FAILDETAIL, $detail; + return; +} + + + +sub _diff_complain { + my($result, $expected, $detail, $prefix) = @_; + return _diff_complain_external(@_) if $ENV{PERL_TEST_DIFF}; + return _diff_complain_algdiff(@_) + if eval { require Algorithm::Diff; Algorithm::Diff->VERSION(1.15); 1; }; + + $told_about_diff++ or print $TESTERR <<"EOT"; +# $prefix (Install the Algorithm::Diff module to have differences in multiline +# $prefix output explained. You might also set the PERL_TEST_DIFF environment +# $prefix variable to run a diff program on the output.) +EOT + ; + return; +} + + + +sub _diff_complain_external { + my($result, $expected, $detail, $prefix) = @_; + my $diff = $ENV{PERL_TEST_DIFF} || die "WHAAAA?"; + + require File::Temp; + my($got_fh, $got_filename) = File::Temp::tempfile("test-got-XXXXX"); + my($exp_fh, $exp_filename) = File::Temp::tempfile("test-exp-XXXXX"); + unless ($got_fh && $exp_fh) { + warn "Can't get tempfiles"; + return; + } + + print $got_fh $result; + print $exp_fh $expected; + if (close($got_fh) && close($exp_fh)) { + my $diff_cmd = "$diff $exp_filename $got_filename"; + print $TESTERR "#\n# $prefix $diff_cmd\n"; + if (open(DIFF, "$diff_cmd |")) { + local $_; + while () { + print $TESTERR "# $prefix $_"; + } + close(DIFF); + } + else { + warn "Can't run diff: $!"; + } + } else { + warn "Can't write to tempfiles: $!"; + } + unlink($got_filename); + unlink($exp_filename); + return; +} + + + +sub _diff_complain_algdiff { + my($result, $expected, $detail, $prefix) = @_; + + my @got = split(/^/, $result); + my @exp = split(/^/, $expected); + + my $diff_kind; + my @diff_lines; + + my $diff_flush = sub { + return unless $diff_kind; + + my $count_lines = @diff_lines; + my $s = $count_lines == 1 ? "" : "s"; + my $first_line = $diff_lines[0][0] + 1; + + print $TESTERR "# $prefix "; + if ($diff_kind eq "GOT") { + print $TESTERR "Got $count_lines extra line$s at line $first_line:\n"; + for my $i (@diff_lines) { + print $TESTERR "# $prefix + " . _quote($got[$i->[0]]) . "\n"; + } + } elsif ($diff_kind eq "EXP") { + if ($count_lines > 1) { + my $last_line = $diff_lines[-1][0] + 1; + print $TESTERR "Lines $first_line-$last_line are"; + } + else { + print $TESTERR "Line $first_line is"; + } + print $TESTERR " missing:\n"; + for my $i (@diff_lines) { + print $TESTERR "# $prefix - " . _quote($exp[$i->[1]]) . "\n"; + } + } elsif ($diff_kind eq "CH") { + if ($count_lines > 1) { + my $last_line = $diff_lines[-1][0] + 1; + print $TESTERR "Lines $first_line-$last_line are"; + } + else { + print $TESTERR "Line $first_line is"; + } + print $TESTERR " changed:\n"; + for my $i (@diff_lines) { + print $TESTERR "# $prefix - " . _quote($exp[$i->[1]]) . "\n"; + print $TESTERR "# $prefix + " . _quote($got[$i->[0]]) . "\n"; + } + } + + # reset + $diff_kind = undef; + @diff_lines = (); + }; + + my $diff_collect = sub { + my $kind = shift; + &$diff_flush() if $diff_kind && $diff_kind ne $kind; + $diff_kind = $kind; + push(@diff_lines, [@_]); + }; + + + Algorithm::Diff::traverse_balanced( + \@got, \@exp, + { + DISCARD_A => sub { &$diff_collect("GOT", @_) }, + DISCARD_B => sub { &$diff_collect("EXP", @_) }, + CHANGE => sub { &$diff_collect("CH", @_) }, + MATCH => sub { &$diff_flush() }, + }, + ); + &$diff_flush(); + + return; +} + + + + +#~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~ + + =item C, I)> This is used for tests that under some conditions can be skipped. It's @@ -458,17 +633,17 @@ Example usage: my $if_MSWin = - $^O eq 'MSWin' ? 'Skip if under MSWin' : ''; + $^O =~ m/MSWin/ ? 'Skip if under MSWin' : ''; - # A test to be run EXCEPT under MSWin: + # A test to be skipped if under MSWin (i.e., run except under MSWin) skip($if_MSWin, thing($foo), thing($bar) ); -Or, going the other way: +Or, going the other way: my $unless_MSWin = - $^O eq 'MSWin' ? 'Skip unless under MSWin' : ''; + $^O =~ m/MSWin/ ? '' : 'Skip unless under MSWin'; - # A test to be run EXCEPT under MSWin: + # A test to be skipped unless under MSWin (i.e., run only under MSWin) skip($unless_MSWin, thing($foo), thing($bar) ); The tricky thing to remember is that the first parameter is true if @@ -565,7 +740,7 @@ These tests are expected to succeed. Usually, most or all of your tests are in this category. If a normal test doesn't succeed, then that -means that something is I. +means that something is I. =item * SKIPPED TESTS @@ -598,8 +773,7 @@ triggered at the end of a test run. C is passed an array ref of hash refs that describe each test failure. Each hash will contain at least the following fields: C, C, and -C. (The file, line, and test number are not included because -their correspondence to a particular test is tenuous.) If the test +C. (You shouldn't rely on any other fields being present.) If the test had an expected value or a diagnostic (or "note") string, these will also be included. @@ -714,6 +888,26 @@ =back + +=head1 ENVIRONMENT + +If C environment variable is set, it will be used as a +command for comparing unexpected multiline results. If you have GNU +diff installed, you might want to set C to C. +If you don't have a suitable program, you might install the +C module and then set C to be C. If C isn't set +but the C module is available, then it will be used +to show the differences in multiline results. + +=for comment +If C is set, then the initial "Got 'something' but +expected 'something_else'" readings for long multiline output values aren't +truncated at about the 230th column, as they normally could be in some +cases. Normally you won't need to use this, unless you were carefully +parsing the output of your test programs. + + =head1 NOTE A past developer of this module once said that it was no longer being @@ -724,6 +918,9 @@ that there are already more ambitious modules out there, such as L and L. +Some earlier versions of this module had docs with some confusing +typoes in the description of C. + =head1 SEE ALSO @@ -744,7 +941,7 @@ Copyright (c) 2001-2002 Michael G. Schwern. -Copyright (c) 2002-2003 Sean M. Burke. +Copyright (c) 2002-2004 and counting Sean M. Burke. Current maintainer: Sean M. Burke. Esburke@cpan.orgE diff -ruN perl-5.8.4/makedef.pl AP810_source/makedef.pl --- perl-5.8.4/makedef.pl 2004-06-04 17:30:03.000000000 -0700 +++ AP810_source/makedef.pl 2004-06-04 16:47:54.000000000 -0700 @@ -365,6 +365,9 @@ PL_statusvalue_vms PL_sys_intern )]); + emit_symbols([qw( + boot_DynaLoader + )]); } elsif ($PLATFORM eq 'os2') { emit_symbols([qw( diff -ruN perl-5.8.4/MANIFEST AP810_source/MANIFEST --- perl-5.8.4/MANIFEST 2004-06-04 17:30:03.000000000 -0700 +++ AP810_source/MANIFEST 2004-06-04 16:47:51.000000000 -0700 @@ -1690,6 +1690,8 @@ lib/Test/t/skip.t See if Test works lib/Test/t/success.t See if Test works lib/Test/t/todo.t See if Test works +lib/Test/t/multiline.t See if Test works +lib/Test/t/05_about_verbose.t See if Test works lib/Test/Tutorial.pod A tutorial on writing tests lib/Text/Abbrev.pm An abbreviation table builder lib/Text/Abbrev.t Test Text::Abbrev @@ -2847,6 +2849,7 @@ t/op/re_tests Regular expressions for regexp.t t/op/reverse.t See if reverse operator works 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 diff -ruN perl-5.8.4/patchlevel.h AP810_source/patchlevel.h --- perl-5.8.4/patchlevel.h 2004-06-04 17:30:03.000000000 -0700 +++ AP810_source/patchlevel.h 2004-06-04 16:47:54.000000000 -0700 @@ -10,6 +10,8 @@ #ifndef __PATCHLEVEL_H_INCLUDED__ +#include "BuildInfo.h" + /* do not adjust the whitespace! Configure expects the numbers to be * exactly on the third column */ @@ -120,6 +122,9 @@ #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT) static char *local_patches[] = { NULL + ,ACTIVEPERL_LOCAL_PATCHES_ENTRY + ,"22751 Update to Test.pm 1.25" + ,"21540 Fix backward-compatibility issues in if.pm" ,NULL }; diff -ruN perl-5.8.4/pod/perlfaq2.pod AP810_source/pod/perlfaq2.pod --- perl-5.8.4/pod/perlfaq2.pod 2004-06-04 17:30:01.000000000 -0700 +++ AP810_source/pod/perlfaq2.pod 2004-06-04 16:47:54.000000000 -0700 @@ -476,30 +476,6 @@ and in the proprietary Microsoft flavor); the free Unix distributions also all come with Perl. -Alternatively, you can purchase commercial incidence based support -through the Perl Clinic. The following is a commercial from them: - -"The Perl Clinic is a commercial Perl support service operated by -ActiveState Tool Corp. and The Ingram Group. The operators have many -years of in-depth experience with Perl applications and Perl internals -on a wide range of platforms. - -"Through our group of highly experienced and well-trained support engineers, -we will put our best effort into understanding your problem, providing an -explanation of the situation, and a recommendation on how to proceed." - -Contact The Perl Clinic at - - www.PerlClinic.com - - North America Pacific Standard Time (GMT-8) - Tel: 1 604 606-4611 hours 8am-6pm - Fax: 1 604 606-4640 - - Europe (GMT) - Tel: 00 44 1483 862814 - Fax: 00 44 1483 862801 - See also www.perl.com for updates on tutorials, training, and support. =head2 Where do I send bug reports? diff -ruN perl-5.8.4/t/op/sig.t AP810_source/t/op/sig.t --- perl-5.8.4/t/op/sig.t 1969-12-31 16:00:00.000000000 -0800 +++ AP810_source/t/op/sig.t 2004-06-04 16:47:55.000000000 -0700 @@ -0,0 +1,56 @@ +#!perl -w + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + eval { + require POSIX; + POSIX::->import(qw(WNOHANG SIGINT SIGTERM)); + }; + if ($@ or !$Config{d_fork}) { + print "# $@\n"; + print "1..0 # skipped, not posix compatible\n"; + exit 0; + } +} + +use strict; + +my $done = 0; +sub reaper { + print "# got sig\n"; + $done = 1; +} + +sub start_child { + my $pid = fork(); + + defined $pid or die "fork() failed: $!"; + unless ($pid) { + # child + $SIG{INT} = $SIG{TERM} = \&reaper; + while () { + last if $done; + sleep(30); + } + exit; + } + sleep 1; + return $pid; +} + +my $test = 1; +my @signals = (SIGINT, SIGTERM); +print "1.." . (@signals * 3) . "\n"; + +# SIGINT/SIGTERM should not restart sleep() +for my $sig (@signals) { + my $pid = start_child(); + print "not " unless kill(SIGINT, $pid) == 1; + print "ok $test\n"; ++$test; + sleep 1; + print "not " unless waitpid($pid, WNOHANG) == $pid; + print "ok $test\n"; ++$test; + print "# [$?]\nnot " unless 0 == ($? >> 8); + print "ok $test\n"; ++$test; +} diff -ruN perl-5.8.4/util.c AP810_source/util.c --- perl-5.8.4/util.c 2004-06-04 17:30:03.000000000 -0700 +++ AP810_source/util.c 2004-06-04 16:47:55.000000000 -0700 @@ -2231,8 +2231,14 @@ sigemptyset(&act.sa_mask); act.sa_flags = 0; #ifdef SA_RESTART - if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG) - act.sa_flags |= SA_RESTART; /* SVR4, 4.3+BSD */ + if ((PL_signals & PERL_SIGNALS_UNSAFE_FLAG) +# if defined(__hpux) && !(defined(__ux_version) && __ux_version <= 1020) + && signo != SIGTERM && signo != SIGINT +# endif + ) + { + act.sa_flags |= SA_RESTART; /* SVR4, 4.3+BSD */ + } #endif #if defined(SA_NOCLDWAIT) && !defined(BSDish) /* See [perl #18849] */ if (signo == SIGCHLD && handler == (Sighandler_t)SIG_IGN) diff -ruN perl-5.8.4/win32/Makefile AP810_source/win32/Makefile --- perl-5.8.4/win32/Makefile 2004-06-04 17:30:02.000000000 -0700 +++ AP810_source/win32/Makefile 2004-06-04 16:47:55.000000000 -0700 @@ -192,6 +192,12 @@ #BUILDOPT = $(BUILDOPT) -DPERL_TEXTMODE_SCRIPTS # +# This should be enabled to maintain binary compatibility with Perl 5.8.0. +# If you want to use the new hash seed functionality then all Perl modules +# must be recompiled with Perl 5.8.1. +BUILDOPT = $(BUILDOPT) -DNO_HASH_SEED + +# # specify semicolon-separated list of extra directories that modules will # look for libraries (spaces in path names need not be quoted) # @@ -201,7 +207,7 @@ # set this to your email address (perl will guess a value from # from your loginname and your hostname, which may not be right) # -#EMAIL = +EMAIL = support@ActiveState.com ## ## Build configuration ends. @@ -476,7 +482,7 @@ PERLEXE_ICO = .\perlexe.ico PERLEXE_RES = .\perlexe.res -PERLDLL_RES = +PERLDLL_RES = .\perldll.res # Nominate a target which causes extensions to be re-built # This used to be $(PERLEXE), but at worst it is the .dll that they depend @@ -934,10 +940,10 @@ << $(XCOPY) $(PERLIMPLIB) $(COREDIR) -$(PERLEXE_ICO): $(MINIPERL) makeico.pl - $(MINIPERL) makeico.pl > $@ - -$(PERLEXE_RES): perlexe.rc $(PERLEXE_ICO) +#$(PERLEXE_ICO): $(MINIPERL) makeico.pl +# $(MINIPERL) makeico.pl > $@ +# +#$(PERLEXE_RES): perlexe.rc $(PERLEXE_ICO) $(MINIMOD) : $(MINIPERL) ..\minimod.pl cd .. @@ -1145,7 +1151,8 @@ -del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new -del /f $(CONFIGPM) -del /f bin\*.bat - -del /f $(PERLEXE_ICO) perl.base +# -del /f $(PERLEXE_ICO) + -del /f perl.base -cd .. && del /s *.lib *.map *.pdb *.ilk *.bs *$(o) .exists pm_to_blib -cd $(EXTDIR) && del /s *.def Makefile Makefile.old -if exist $(AUTODIR) rmdir /s /q $(AUTODIR) diff -ruN perl-5.8.4/win32/makefile.mk AP810_source/win32/makefile.mk --- perl-5.8.4/win32/makefile.mk 2004-06-04 17:30:02.000000000 -0700 +++ AP810_source/win32/makefile.mk 2004-06-04 16:47:55.000000000 -0700 @@ -213,6 +213,12 @@ #BUILDOPT += -DPERL_TEXTMODE_SCRIPTS # +# This should be enabled to maintain binary compatibility with Perl 5.8.0. +# If you want to use the new hash seed functionality then all Perl modules +# must be recompiled with Perl 5.8.1. +BUILDOPT += -DNO_HASH_SEED + +# # specify semicolon-separated list of extra directories that modules will # look for libraries (spaces in path names need not be quoted) # @@ -228,7 +234,7 @@ # set this to your email address (perl will guess a value from # from your loginname and your hostname, which may not be right) # -#EMAIL *= +EMAIL *= support@ActiveState.com ## ## Build configuration ends. @@ -595,7 +601,7 @@ PERLEXE_ICO = .\perlexe.ico PERLEXE_RES = .\perlexe.res -PERLDLL_RES = +PERLDLL_RES = .\perldll.res # Nominate a target which causes extensions to be re-built # This used to be $(PERLEXE), but at worst it is the .dll that they depend @@ -1057,10 +1063,10 @@ .ENDIF $(XCOPY) $(PERLIMPLIB) $(COREDIR) -$(PERLEXE_ICO): $(MINIPERL) makeico.pl - $(MINIPERL) makeico.pl > $@ - -$(PERLEXE_RES): perlexe.rc $(PERLEXE_ICO) +#$(PERLEXE_ICO): $(MINIPERL) makeico.pl +# $(MINIPERL) makeico.pl > $@ +# +#$(PERLEXE_RES): perlexe.rc $(PERLEXE_ICO) $(MINIMOD) : $(MINIPERL) ..\minimod.pl cd .. && miniperl minimod.pl > lib\ExtUtils\Miniperl.pm @@ -1273,7 +1279,8 @@ -del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new -del /f $(CONFIGPM) -del /f bin\*.bat - -del /f $(PERLEXE_ICO) perl.base +# -del /f $(PERLEXE_ICO) + -del /f perl.base -cd .. && del /s *$(a) *.map *.pdb *.ilk *.bs *$(o) .exists pm_to_blib -cd $(EXTDIR) && del /s *.def Makefile Makefile.old -if exist $(AUTODIR) rmdir /s /q $(AUTODIR) diff -ruN perl-5.8.4/win32/perldll.rc AP810_source/win32/perldll.rc --- perl-5.8.4/win32/perldll.rc 1969-12-31 16:00:00.000000000 -0800 +++ AP810_source/win32/perldll.rc 2004-06-04 16:47:55.000000000 -0700 @@ -0,0 +1,52 @@ +// PerlDll.rc + +// (c) 1995-1998 Microsoft Corporation. All rights reserved. +// Developed by ActiveState Tool Corp., http://www.ActiveState.com + +// You may distribute under the terms of either the GNU General Public +// License or the Artistic License, as specified in the README file. + +#include +#include "BuildInfo.h" + +PERLDLL ICON perl.ico + +#ifndef _DEBUG +#define VER_DEBUG 0 +#else +#define VER_DEBUG VS_FF_DEBUG +#endif + +VS_VERSION_INFO VERSIONINFO + FILEVERSION PERLRC_VERSION + PRODUCTVERSION PERLRC_VERSION + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK + FILEFLAGS VER_DEBUG + FILEOS VOS_NT_WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE VFT2_UNKNOWN + +BEGIN +BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "ActiveState, a division of Sophos\0", + VALUE "FileDescription", "Perl Interpreter\0", + VALUE "FileVersion", PERLFILEVERSION, + VALUE "InternalName", "perl58.dll\0", + VALUE "LegalCopyright", "Copyright 1987-2004, Larry Wall, Binary build by ActiveState, a division of Sophos, http://www.ActiveState.com\0", + VALUE "LegalTrademarks", "\0", + VALUE "OriginalFilename", "perl58.dll\0", + VALUE "ProductName", PERLPRODUCTNAME, + VALUE "ProductVersion", PERLPRODUCTVERSION, + END + END + + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x409, 0x04E4 + // English language (0x409) and the Windows ANSI codepage (0x04E4) + END +END + diff -ruN perl-5.8.4/win32/perlexe.rc AP810_source/win32/perlexe.rc --- perl-5.8.4/win32/perlexe.rc 2004-06-04 17:30:02.000000000 -0700 +++ AP810_source/win32/perlexe.rc 2004-06-04 16:47:55.000000000 -0700 @@ -1 +1,52 @@ -PERLEXE ICON perlexe.ico +// PerlExe.rc + +// (c) 1995-1999 Microsoft Corporation. All rights reserved. +// Developed by ActiveState Tool Corp., http://www.ActiveState.com + +// You may distribute under the terms of either the GNU General Public +// License or the Artistic License, as specified in the README file. + +#include +#include "BuildInfo.h" + +PERLEXE ICON perl.ico + +#ifndef _DEBUG +#define VER_DEBUG 0 +#else +#define VER_DEBUG VS_FF_DEBUG +#endif + +VS_VERSION_INFO VERSIONINFO + FILEVERSION PERLRC_VERSION + PRODUCTVERSION PERLRC_VERSION + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK + FILEFLAGS VER_DEBUG + FILEOS VOS_NT_WINDOWS32 + FILETYPE VFT_APP + FILESUBTYPE VFT2_UNKNOWN + +BEGIN +BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "ActiveState, a division of Sophos\0", + VALUE "FileDescription", "Perl Command Line Interpreter\0", + VALUE "FileVersion", PERLFILEVERSION, + VALUE "InternalName", "perl.exe\0", + VALUE "LegalCopyright", "Copyright 1987-2004, Larry Wall, Binary build by ActiveState, a division of Sophos, http://www.ActiveState.com\0", + VALUE "LegalTrademarks", "\0", + VALUE "OriginalFilename", "perl.exe\0", + VALUE "ProductName", PERLPRODUCTNAME, + VALUE "ProductVersion", PERLPRODUCTVERSION, + END + END + + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x409, 0x04E4 + // English language (0x409) and the Windows ANSI codepage (0x04E4) + END +END + Binary files perl-5.8.4/win32/perl.ico and AP810_source/win32/perl.ico differ diff -ruN perl-5.8.4/win32/win32.c AP810_source/win32/win32.c --- perl-5.8.4/win32/win32.c 2004-06-04 17:30:02.000000000 -0700 +++ AP810_source/win32/win32.c 2004-06-04 16:47:55.000000000 -0700 @@ -4357,6 +4357,13 @@ */ static +XS(w32_BuildNumber) +{ + dXSARGS; + XSRETURN_PV(PRODUCT_BUILD_NUMBER); +} + +static XS(w32_SetChildShowWindow) { dXSARGS; @@ -4929,6 +4936,7 @@ newXS("Win32::GetLongPathName", w32_GetLongPathName, file); newXS("Win32::CopyFile", w32_CopyFile, file); newXS("Win32::Sleep", w32_Sleep, file); + newXS("Win32::BuildNumber", w32_BuildNumber, file); newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file); /* XXX Bloat Alert! The following Activeware preloads really diff -ruN perl-5.8.4/win32/win32.h AP810_source/win32/win32.h --- perl-5.8.4/win32/win32.h 2004-06-04 17:30:02.000000000 -0700 +++ AP810_source/win32/win32.h 2004-06-04 16:47:55.000000000 -0700 @@ -9,6 +9,8 @@ #ifndef _INC_WIN32_PERL5 #define _INC_WIN32_PERL5 +#include "BuildInfo.h" + #ifndef _WIN32_WINNT # define _WIN32_WINNT 0x0400 /* needed for TryEnterCriticalSection() etc. */ #endif