Change 20934 by [EMAIL PROTECTED] on 2003/08/29 15:12:24
Integrate:
[ 20927]
MPE/iX gcc 3.3.1 changes from Mark Klein and Mark Bixby.
[ 20928]
Subject: RE: [PATCH] Pod::InputObjects performance de-pessimization
From: [EMAIL PROTECTED]
Date: Wed, 27 Aug 2003 17:25:28 +0200
Message-ID: <[EMAIL PROTECTED]>
PodParser-1.25 prerelease.
[ 20929]
Subject: [PATCH] maint / blead tweaks in perlio.c for Cygwin
From: "Gerrit P. Haase" <[EMAIL PROTECTED]>
Date: Thu, 28 Aug 2003 08:18:51 +0200
Message-ID: <[EMAIL PROTECTED]>
(changed so that the 'b' is always appended)
[ 20930]
Subject: [PATCH op.c] Perl_newCONSTSUB() related memory leaks
From: "Marcus Holland-Moritz" <[EMAIL PROTECTED]>
Date: Thu, 28 Aug 2003 21:47:22 +0200
Message-ID: <[EMAIL PROTECTED]>
[ 20931]
Some Ultrix test dodgings.
[ 20932]
Better skip() explicit number of tests, test counts getting
out of sync less likely that way.
(in the change #20989 podchecker.PL changes were ignored since
the maint change #18402 is missing from the blead)
Affected files ...
... //depot/maint-5.8/perl/ext/DynaLoader/dl_mpeix.xs#2 integrate
... //depot/maint-5.8/perl/lib/Pod/Checker.pm#6 integrate
... //depot/maint-5.8/perl/lib/Pod/Find.pm#3 integrate
... //depot/maint-5.8/perl/lib/Pod/InputObjects.pm#2 integrate
... //depot/maint-5.8/perl/lib/Pod/Parser.pm#2 integrate
... //depot/maint-5.8/perl/mpeix/mpeix.c#3 integrate
... //depot/maint-5.8/perl/op.c#37 integrate
... //depot/maint-5.8/perl/perlio.c#31 integrate
... //depot/maint-5.8/perl/pod/pod2usage.PL#3 integrate
... //depot/maint-5.8/perl/pod/podchecker.PL#3 integrate
... //depot/maint-5.8/perl/pod/podselect.PL#5 integrate
... //depot/maint-5.8/perl/t/base/num.t#3 integrate
... //depot/maint-5.8/perl/t/op/arith.t#2 integrate
... //depot/maint-5.8/perl/t/op/pack.t#13 integrate
... //depot/maint-5.8/perl/t/pod/find.t#3 integrate
... //depot/maint-5.8/perl/t/pod/poderrs.xr#6 integrate
Differences ...
==== //depot/maint-5.8/perl/ext/DynaLoader/dl_mpeix.xs#2 (text) ====
Index: perl/ext/DynaLoader/dl_mpeix.xs
--- perl/ext/DynaLoader/dl_mpeix.xs#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/ext/DynaLoader/dl_mpeix.xs Fri Aug 29 08:12:24 2003
@@ -54,8 +54,8 @@
DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,
flags));
if (flags & 0x01)
- Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while
loading %s
-",filename);
+ Perl_warn(aTHX_
+"Can't make loaded symbols global on this platform while loading %s",filename);
obj = (p_mpe_dld) safemalloc(sizeof(t_mpe_dld));
memzero(obj, sizeof(t_mpe_dld));
if (filename[0] != '/')
==== //depot/maint-5.8/perl/lib/Pod/Checker.pm#6 (text) ====
Index: perl/lib/Pod/Checker.pm
--- perl/lib/Pod/Checker.pm#5~18892~ Mon Mar 10 12:26:04 2003
+++ perl/lib/Pod/Checker.pm Fri Aug 29 08:12:24 2003
@@ -10,7 +10,7 @@
package Pod::Checker;
use vars qw($VERSION);
-$VERSION = 1.40; ## Current version of this package
+$VERSION = 1.41; ## Current version of this package
require 5.005; ## requires this Perl version or later
use Pod::ParseUtils; ## for hyperlinks and lists
@@ -53,11 +53,9 @@
B<podchecker> will perform syntax checking of Perl5 POD format documentation.
-I<NOTE THAT THIS MODULE IS CURRENTLY IN THE BETA STAGE!>
-
-It is hoped that curious/ambitious user will help flesh out and add the
-additional features they wish to see in B<Pod::Checker> and B<podchecker>
-and verify that the checks are consistent with L<perlpod>.
+Curious/ambitious users are welcome to propose additional features they wish
+to see in B<Pod::Checker> and B<podchecker> and verify that the checks are
+consistent with L<perlpod>.
The following checks are currently preformed:
@@ -319,7 +317,7 @@
=head1 EXAMPLES
-I<[T.B.D.]>
+See L</SYNOPSIS>
=head1 INTERFACE
@@ -329,6 +327,13 @@
a first pass before actually starting to convert. This is expensive in terms
of execution time, but allows for very robust conversions.
+Since PodParser-1.24 the B<Pod::Checker> module uses only the B<poderror>
+method to print errors and warnings. The summary output (e.g.
+"Pod syntax OK") has been dropped from the module and has been included in
+B<podchecker> (the script). This allows users of B<Pod::Checker> to
+control completely the output behaviour. Users of B<podchecker> (the script)
+get the well-known behaviour.
+
=cut
#############################################################################
@@ -742,7 +747,6 @@
my $out_fh = $self->output_handle();
if(@{$self->{_list_stack}}) {
- # _TODO_ display, but don't count them for now
my $list;
while(($list = $self->_close_list('EOF',$infile)) &&
$list->indent() ne 'auto') {
@@ -790,19 +794,8 @@
-msg => "multiple occurrence of link target '$_'"});
}
- ## Print the number of errors found
- my $num_errors = $self->num_errors();
- if ($num_errors > 0) {
- printf $out_fh ("$infile has $num_errors pod syntax %s.\n",
- ($num_errors == 1) ? "error" : "errors");
- }
- elsif($self->{_commands} == 0) {
- print $out_fh "$infile does not contain any pod commands.\n";
- $self->num_errors(-1);
- }
- else {
- print $out_fh "$infile pod syntax OK.\n";
- }
+ # no POD found here
+ $self->num_errors(-1) if($self->{_commands} == 0);
}
# check a POD command directive
@@ -1078,17 +1071,17 @@
foreach(@$ptree) {
# regular text chunk
unless(ref) {
- my $count;
# count the unescaped angle brackets
# complain only when warning level is greater than 1
- my $i = $_;
- if($count = $i =~ tr/<>/<>/) {
+ if($self->{-warnings} && $self->{-warnings}>1) {
+ my $count;
+ if($count = tr/<>/<>/) {
$self->poderror({ -line => $line, -file => $file,
-severity => 'WARNING',
- -msg => "$count unescaped <> in paragraph" })
- if($self->{-warnings} && $self->{-warnings}>1);
+ -msg => "$count unescaped <> in paragraph" });
+ }
}
- $text .= $i;
+ $text .= $_;
next;
}
# have an interior sequence
==== //depot/maint-5.8/perl/lib/Pod/Find.pm#3 (text) ====
Index: perl/lib/Pod/Find.pm
--- perl/lib/Pod/Find.pm#2~19991~ Fri Jul 4 06:54:33 2003
+++ perl/lib/Pod/Find.pm Fri Aug 29 08:12:24 2003
@@ -13,7 +13,7 @@
package Pod::Find;
use vars qw($VERSION);
-$VERSION = 0.23; ## Current version of this package
+$VERSION = 0.24; ## Current version of this package
require 5.005; ## requires this Perl version or later
use Carp;
@@ -446,13 +446,14 @@
if $options{'-verbose'};
next Dir;
}
- # for some strange reason the path on MacOS/darwin is
+ # for some strange reason the path on MacOS/darwin/cygwin is
# 'pods' not 'pod'
# this could be the case also for other systems that
# have a case-tolerant file system, but File::Spec
- # does not recognize 'darwin' yet
- #if(File::Spec->case_tolerant && -d File::Spec->catdir($dir,'pods')) {
- if($^O =~ /macos|darwin/i && -d File::Spec->catdir($dir,'pods')) {
+ # does not recognize 'darwin' yet. And cygwin also has "pods",
+ # but is not case tolerant. Oh well...
+ if((File::Spec->case_tolerant || $^O =~ /macos|darwin|cygwin/i)
+ && -d File::Spec->catdir($dir,'pods')) {
$dir = File::Spec->catdir($dir,'pods');
redo Dir;
}
==== //depot/maint-5.8/perl/lib/Pod/InputObjects.pm#2 (text) ====
Index: perl/lib/Pod/InputObjects.pm
--- perl/lib/Pod/InputObjects.pm#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/lib/Pod/InputObjects.pm Fri Aug 29 08:12:24 2003
@@ -11,7 +11,7 @@
package Pod::InputObjects;
use vars qw($VERSION);
-$VERSION = 1.13; ## Current version of this package
+$VERSION = 1.14; ## Current version of this package
require 5.005; ## requires this Perl version or later
#############################################################################
@@ -855,9 +855,15 @@
sub append {
my $self = shift;
local *ptree = $self;
+ my $can_append = @ptree && !(ref $ptree[-1]);
for (@_) {
- next unless length;
- if (@ptree and !(ref $ptree[-1]) and !(ref $_)) {
+ if (ref) {
+ push @ptree, $_;
+ }
+ elsif(!length) {
+ next;
+ }
+ elsif ($can_append) {
$ptree[-1] .= $_;
}
else {
==== //depot/maint-5.8/perl/lib/Pod/Parser.pm#2 (text) ====
Index: perl/lib/Pod/Parser.pm
--- perl/lib/Pod/Parser.pm#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/lib/Pod/Parser.pm Fri Aug 29 08:12:24 2003
@@ -788,13 +788,15 @@
## Look for the beginning of a sequence
if ( /^([A-Z])(<(?:<+\s)?)$/ ) {
## Push a new sequence onto the stack of those "in-progress"
- ($cmd, $ldelim) = ($1, $2);
+ my $ldelim_orig;
+ ($cmd, $ldelim_orig) = ($1, $2);
+ ($ldelim = $ldelim_orig) =~ s/\s+$//;
+ ($rdelim = $ldelim) =~ tr/</>/;
$seq = Pod::InteriorSequence->new(
-name => $cmd,
- -ldelim => $ldelim, -rdelim => '',
+ -ldelim => $ldelim_orig, -rdelim => $rdelim,
-file => $file, -line => $line
);
- $ldelim =~ s/\s+$//, ($rdelim = $ldelim) =~ tr/</>/;
(@seq_stack > 1) and $seq->nested($seq_stack[-1]);
push @seq_stack, $seq;
}
@@ -827,9 +829,13 @@
$seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq)
: $seq);
## Remember the current cmd-name and left-delimiter
- $cmd = (@seq_stack > 1) ? $seq_stack[-1]->name : '';
- $ldelim = (@seq_stack > 1) ? $seq_stack[-1]->ldelim : '';
- $ldelim =~ s/\s+$//, ($rdelim = $ldelim) =~ tr/</>/;
+ if(@seq_stack > 1) {
+ $cmd = $seq_stack[-1]->name;
+ $ldelim = $seq_stack[-1]->ldelim;
+ $rdelim = $seq_stack[-1]->rdelim;
+ } else {
+ $cmd = $ldelim = $rdelim = '';
+ }
}
}
elsif (length) {
==== //depot/maint-5.8/perl/mpeix/mpeix.c#3 (text) ====
Index: perl/mpeix/mpeix.c
--- perl/mpeix/mpeix.c#2~20349~ Wed Jul 30 06:38:17 2003
+++ perl/mpeix/mpeix.c Fri Aug 29 08:12:24 2003
@@ -42,10 +42,10 @@
*
* Refer to the gcc documentation or http://www.dis.com/gnu/gcc_toc.html
*/
- asm volatile (
- "comiclr,= 0,%1,%%r28;
- ldsid (%%r0,%1),%%r28;
- stw %%r28, %0"
+ __asm__ __volatile__ (
+ " comiclr,= 0,%1,%%r28\n"
+ "\t ldsid (%%r0,%1),%%r28\n"
+ "\t stw %%r28, %0"
: "=m" (val) // Output to val
: "r" (source) // Source must be gen reg
: "%r28"); // Clobbers %r28
@@ -59,11 +59,11 @@
* Return the long pointer for the address in sr5 space.
*/
- asm volatile (
- "comiclr,= 0,%2,%%r28;
- ldsid (%%r0,%2),%%r28;
- stw %%r28, %0;
- stw %2, %1"
+ __asm__ __volatile__ (
+ " comiclr,= 0,%2,%%r28\n"
+ "\t ldsid (%%r0,%2),%%r28\n"
+ "\t stw %%r28, %0\n"
+ "\t stw %2, %1"
: "=m" (lptr.spaceid),
"=m" (lptr.offset) // Store to lptr
: "r" (source) // Source must be gen reg
@@ -79,9 +79,9 @@
* Increment a longpointer.
*/
- asm volatile (
- "copy %0,%%r28; // copy space to r28
- add %1,%2,%%r29" // Increment the pointer
+ __asm__ __volatile__ (
+ " copy %0,%%r28\n" // copy space to r28
+ "\t add %1,%2,%%r29" // Increment the pointer
: // No output
: "r" (source.spaceid), // Source address
"r" (source.offset),
@@ -98,14 +98,14 @@
* Move data between two buffers in long pointer space.
*/
- asm volatile (
- ".import $$lr_unk_unk_long,MILLICODE;
- mtsp %0,%%sr1; // copy source space to sr1
- copy %1,%%r26; // load source offset to r26
- copy %4,%%r24; // load length to r24
- copy %3,%%r25; // load target offset to r25
- bl $$lr_unk_unk_long,%%r31; // start branch to millicode
- mtsp %2,%%sr2" // copy target space to sr2
+ __asm__ __volatile__ (
+ " .import $$lr_unk_unk_long,MILLICODE\n"
+ "\t mtsp %0,%%sr1\n" // copy source space to sr1
+ "\t copy %1,%%r26\n" // load source offset to r26
+ "\t copy %4,%%r24\n" // load length to r24
+ "\t copy %3,%%r25\n" // load target offset to r25
+ "\t bl $$lr_unk_unk_long,%%r31\n" // start branch to millicode
+ "\t mtsp %2,%%sr2" // copy target space to sr2
: // No output
: "r" (source.spaceid), // Source address
"r" (source.offset),
@@ -126,11 +126,11 @@
*/
unsigned int val;
- asm volatile (
- "mtsp %1, %%sr1;
- copy %2, %%r28;
- ldw 0(%%sr1, %%r28), %%r28;
- stw %%r28, %0"
+ __asm__ __volatile__ (
+ " mtsp %1, %%sr1\n"
+ "\t copy %2, %%r28\n"
+ "\t ldw 0(%%sr1, %%r28), %%r28\n"
+ "\t stw %%r28, %0"
: "=m" (val) // Output val
: "r" (source.spaceid), // Source space ID
"r" (source.offset) // Source offset
@@ -145,10 +145,10 @@
/*
* Store the val into long pointer space.
*/
- asm volatile (
- "mtsp %0,%%sr1;
- copy %1, %%r28;
- stw %2, 0(%%sr1, %%r28)"
+ __asm__ __volatile__ (
+ " mtsp %0,%%sr1\n"
+ "\t copy %1, %%r28\n"
+ "\t stw %2, 0(%%sr1, %%r28)"
: // No output
: "r" (target.spaceid), // Target space ID
"r" (target.offset), // Target offset
@@ -164,12 +164,12 @@
/*
* Move using short pointers.
*/
- asm volatile (
- ".import $$lr_unk_unk,MILLICODE;
- copy %1, %%r26; // Move source addr into pos
- copy %2, %%r25; // Move target addr into pos
- bl $$lr_unk_unk,%%r31; // Start branch to millicode
- copy %0, %%r24" // Move length into position
+ __asm__ __volatile__ (
+ " .import $$lr_unk_unk,MILLICODE\n"
+ "\t copy %1, %%r26\n" // Move source addr into pos
+ "\t copy %2, %%r25\n" // Move target addr into pos
+ "\t bl $$lr_unk_unk,%%r31\n" // Start branch to millicode
+ "\t copy %0, %%r24" // Move length into position
: // No output
: "r" (len), // Byte length
"r" (source), // Source address
==== //depot/maint-5.8/perl/op.c#37 (text) ====
Index: perl/op.c
--- perl/op.c#36~20181~ Wed Jul 23 06:12:38 2003
+++ perl/op.c Fri Aug 29 08:12:24 2003
@@ -3890,6 +3890,8 @@
return o;
}
+static void const_sv_xsub(pTHX_ CV* cv);
+
/*
=for apidoc cv_undef
@@ -3913,8 +3915,9 @@
#endif /* USE_5005THREADS */
#ifdef USE_ITHREADS
- if (CvFILE(cv) && !CvXSUB(cv)) {
- /* for XSUBs CvFILE point directly to static memory; __FILE__ */
+ if (CvFILE(cv) && (!CvXSUB(cv) || CvXSUB(cv) == const_sv_xsub)) {
+ /* for XSUBs CvFILE point directly to static memory; __FILE__
+ * except when XSUB was constructed via newCONSTSUB() */
Safefree(CvFILE(cv));
}
CvFILE(cv) = 0;
@@ -3981,8 +3984,6 @@
}
}
-static void const_sv_xsub(pTHX_ CV* cv);
-
/*
=head1 Optree Manipulation Functions
@@ -4446,6 +4447,9 @@
CvXSUBANY(cv).any_ptr = sv;
CvCONST_on(cv);
sv_setpv((SV*)cv, ""); /* prototype is "" */
+
+ if (stash)
+ CopSTASH_free(PL_curcop);
LEAVE;
==== //depot/maint-5.8/perl/perlio.c#31 (text) ====
Index: perl/perlio.c
--- perl/perlio.c#30~20677~ Wed Aug 13 06:10:04 2003
+++ perl/perlio.c Fri Aug 29 08:12:24 2003
@@ -2609,7 +2609,7 @@
while (*mode) {
*tmode++ = *mode++;
}
-#ifdef PERLIO_USING_CRLF
+#if defined(PERLIO_USING_CRLF) || defined(__CYGWIN__)
*tmode++ = 'b';
#endif
*tmode = '\0';
@@ -2710,25 +2710,28 @@
fd = PerlLIO_open3(path, imode, perm);
}
else {
- FILE *stdio = PerlSIO_fopen(path, mode);
- if (stdio) {
- PerlIOStdio *s;
- if (!f) {
- f = PerlIO_allocate(aTHX);
- }
- if ((f = PerlIO_push(aTHX_ f, self,
- (mode = PerlIOStdio_mode(mode, tmode)),
- PerlIOArg))) {
- s = PerlIOSelf(f, PerlIOStdio);
- s->stdio = stdio;
- PerlIOUnix_refcnt_inc(fileno(s->stdio));
- }
- return f;
- }
- else {
- return NULL;
- }
+ /* Append the 'b' - more correct for CRLF platforms
+ * and Cygwin and should be harmless (since it's a
+ * no-op) elsewhere. */
+ mode = PerlIOStdio_mode(mode, tmode);
+ {
+ FILE *stdio = PerlSIO_fopen(path, mode);
+ if (stdio) {
+ PerlIOStdio *s;
+ if (!f) {
+ f = PerlIO_allocate(aTHX);
+ }
+ if ((f = PerlIO_push(aTHX_ f, self,
+ mode, PerlIOArg))) {
+ s = PerlIOSelf(f, PerlIOStdio);
+ s->stdio = stdio;
+ PerlIOUnix_refcnt_inc(fileno(s->stdio));
+ }
+ return f;
+ }
+ }
}
+ return NULL;
}
if (fd >= 0) {
FILE *stdio = NULL;
==== //depot/maint-5.8/perl/pod/pod2usage.PL#3 (text) ====
Index: perl/pod/pod2usage.PL
--- perl/pod/pod2usage.PL#2~20442~ Fri Aug 1 22:43:01 2003
+++ perl/pod/pod2usage.PL Fri Aug 29 08:12:24 2003
@@ -15,8 +15,9 @@
# This is so that make depend always knows where to find PL derivatives.
$origdir = cwd;
chdir(dirname($0));
-($file = basename($0)) =~ s/\.PL$//i;
-$file .= '.COM' if ($^O eq 'VMS');
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$// if ($^O eq 'os2' or $^O eq 'dos'); # "case-forgiving"
+$file =~ s/\.pl$/.com/ if ($^O eq 'VMS'); # "case-forgiving"
open OUT,">$file" or die "Can't create $file: $!";
==== //depot/maint-5.8/perl/pod/podselect.PL#5 (text) ====
Index: perl/pod/podselect.PL
--- perl/pod/podselect.PL#4~20442~ Fri Aug 1 22:43:01 2003
+++ perl/pod/podselect.PL Fri Aug 29 08:12:24 2003
@@ -15,8 +15,9 @@
# This is so that make depend always knows where to find PL derivatives.
$origdir = cwd;
chdir(dirname($0));
-($file = basename($0)) =~ s/\.PL$//i;
-$file .= '.COM' if ($^O eq 'VMS');
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$// if ($^O eq 'os2' or $^O eq 'dos'); # "case-forgiving"
+$file =~ s/\.pl$/.com/ if ($^O eq 'VMS'); # "case-forgiving"
open OUT,">$file" or die "Can't create $file: $!";
==== //depot/maint-5.8/perl/t/base/num.t#3 (text) ====
Index: perl/t/base/num.t
--- perl/t/base/num.t#2~18080~ Sun Nov 3 21:23:04 2002
+++ perl/t/base/num.t Fri Aug 29 08:12:24 2003
@@ -171,8 +171,13 @@
$b = 0.0005000000000000000104;
print $a <= $b ? "ok 46\n" : "not ok 46\n";
-$a = 0.00000000000000000000000000000000000000000000000000000000000000000001;
-print $a > 0 ? "ok 47\n" : "not ok 47\n";
+if ($^O eq 'ultrix') {
+ # Ultrix enters looong nirvana over this.
+ print "ok 47\n";
+} else {
+ $a = 0.00000000000000000000000000000000000000000000000000000000000000000001;
+ print $a > 0 ? "ok 47\n" : "not ok 47\n";
+}
$a = 80000.0000000000000000000000000;
print $a == 80000.0 ? "ok 48\n" : "not ok 48\n";
==== //depot/maint-5.8/perl/t/op/arith.t#2 (xtext) ====
Index: perl/t/op/arith.t
--- perl/t/op/arith.t#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/t/op/arith.t Fri Aug 29 08:12:24 2003
@@ -283,6 +283,9 @@
elsif (($^O eq 'VMS') && !defined($Config{useieee})) {
print "ok 134 # SKIP -- the IEEE infinity model is unavailable in this
configuration.\n";
}
+elsif ($^O eq 'ultrix') {
+ print "not ok 134 # TODO Ultrix enters deep nirvana instead of producing
infinity.\n";
+}
else {
# The computation of $v should overflow and produce "infinity"
# on any system whose max exponent is less than 10**1506.
==== //depot/maint-5.8/perl/t/op/pack.t#13 (xtext) ====
Index: perl/t/op/pack.t
--- perl/t/op/pack.t#12~20830~ Fri Aug 22 05:28:15 2003
+++ perl/t/op/pack.t Fri Aug 29 08:12:24 2003
@@ -180,15 +180,15 @@
SKIP: {
# Is this a stupid thing to do on VMS, VOS and other unusual platforms?
- skip "-- the IEEE infinity model is unavailable in this configuration."
+ skip("-- the IEEE infinity model is unavailable in this configuration.", 1)
if (($^O eq 'VMS') && !defined($Config{useieee}));
- skip "-- MPE/iX has serious fp indigestionf on w-packed infinities"
- if (($^O eq 'mpeix'));
+ skip("-- $^O has serious fp indigestion on w-packed infinities", 1)
+ if (($^O eq 'mpeix') || ($^O eq 'ultrix'));
my $inf = eval '2**10000';
- skip "Couldn't generate infinity - got error '$@'"
+ skip("Couldn't generate infinity - got error '$@'", 1)
unless defined $inf and $inf == $inf / 2 and $inf + 1 == $inf;
local our $TODO;
@@ -201,13 +201,16 @@
SKIP: {
- skip "-- the full range of an IEEE double may not be available in this
configuration."
+ skip("-- the full range of an IEEE double may not be available in this
configuration.", 3)
if (($^O eq 'VMS') && !defined($Config{useieee}));
+ skip("-- $^O does not like 2**1023", 3)
+ if (($^O eq 'ultrix'));
+
# This should be about the biggest thing possible on an IEEE double
my $big = eval '2**1023';
- skip "Couldn't generate 2**1023 - got error '$@'", 3
+ skip("Couldn't generate 2**1023 - got error '$@'", 3)
unless defined $big and $big != $big / 2;
eval { $x = pack 'w', $big };
==== //depot/maint-5.8/perl/t/pod/find.t#3 (text) ====
Index: perl/t/pod/find.t
--- perl/t/pod/find.t#2~18673~ Sat Feb 8 09:38:33 2003
+++ perl/t/pod/find.t Fri Aug 29 08:12:24 2003
@@ -2,41 +2,62 @@
# Author: Marek Rouchal <[EMAIL PROTECTED]>
BEGIN {
+ if($ENV{PERL_CORE}) {
chdir 't' if -d 't';
# The ../../../../../lib is for finding lib/utf8.pm
# when running under all-utf8 settings (pod/find.t)
# does not directly require lib/utf8.pm but regular
# expressions will need that.
@INC = qw(../lib ../../../../../lib);
+ }
}
$| = 1;
use Test;
-BEGIN {
- plan tests => 4;
+BEGIN {
+ plan tests => 4;
use File::Spec;
}
use Pod::Find qw(pod_find pod_where);
+use File::Spec;
# load successful
ok(1);
require Cwd;
-my $VERBOSE = 0;
-my $lib_dir = File::Spec->catdir('pod', 'testpods', 'lib');
+my $THISDIR = Cwd::cwd();
+my $VERBOSE = $ENV{PERL_CORE} ? 0 : ($ENV{TEST_VERBOSE} || 0);
+my $lib_dir = $ENV{PERL_CORE} ?
+ File::Spec->catdir('pod', 'testpods', 'lib')
+ : File::Spec->catdir($THISDIR,'lib');
if ($^O eq 'VMS') {
- $lib_dir = VMS::Filespec::unixify(File::Spec->catdir('pod', 'testpods', 'lib'));
+ $lib_dir = $ENV{PERL_CORE} ?
+ VMS::Filespec::unixify(File::Spec->catdir('pod', 'testpods', 'lib'))
+ : VMS::Filespec::unixify(File::Spec->catdir($THISDIR,'-','lib','pod'));
$Qlib_dir = $lib_dir;
$Qlib_dir =~ s#\/#::#g;
}
+
print "### searching $lib_dir\n";
my %pods = pod_find($lib_dir);
my $result = join(',', sort values %pods);
-my $compare = join(',', sort qw(
+print "### found $result\n";
+my $compare = $ENV{PERL_CORE} ?
+ join(',', sort qw(
Pod::Stuff
+))
+ : join(',', qw(
+ Pod::Checker
+ Pod::Find
+ Pod::InputObjects
+ Pod::ParseUtils
+ Pod::Parser
+ Pod::PlainText
+ Pod::Select
+ Pod::Usage
));
if ($^O eq 'VMS') {
$compare = lc($compare);
@@ -53,14 +74,13 @@
}
ok($count/($#result+1)-1,$#compare);
}
-elsif ($^O eq 'dos') {
+elsif (File::Spec->case_tolerant || $^O eq 'dos') {
ok(lc $result,lc $compare);
}
else {
ok($result,$compare);
}
-
print "### searching for File::Find\n";
$result = pod_where({ -inc => 1, -verbose => $VERBOSE }, 'File::Find')
|| 'undef - pod not found!';
@@ -74,19 +94,38 @@
ok($result,$compare);
}
else {
- $compare = File::Spec->catfile(File::Spec->updir, 'lib','File','Find.pm');
+ $compare = $ENV{PERL_CORE} ?
+ File::Spec->catfile(File::Spec->updir, 'lib','File','Find.pm')
+ : File::Spec->catfile($Config::Config{privlib},"File","Find.pm");
ok(_canon($result),_canon($compare));
}
# Search for a documentation pod rather than a module
-print "### searching for Stuff.pod\n";
-my $search = File::Spec->catdir('pod', 'testpods', 'lib', 'Pod');
-$result = pod_where({ -dirs => [$search], -verbose => $VERBOSE }, 'Stuff')
- || 'undef - Stuff.pod not found!';
+my $searchpod = $ENV{PERL_CORE} ? 'Stuff' : 'perlfunc';
+print "### searching for $searchpod.pod\n";
+$result = pod_where($ENV{PERL_CORE} ?
+ { -dirs => [ File::Spec->catdir('pod', 'testpods', 'lib', 'Pod') ],
+ -verbose => $VERBOSE }
+ : { -inc => 1, -verbose => $VERBOSE }, $searchpod)
+ || "undef - $searchpod.pod not found!";
print "### found $result\n";
-$compare = File::Spec->catfile('pod', 'testpods', 'lib', 'Pod' ,'Stuff.pod');
-ok(_canon($result),_canon($compare));
+if($ENV{PERL_CORE}) {
+ $compare = File::Spec->catfile('pod', 'testpods', 'lib', 'Pod' ,'Stuff.pm');
+ ok(_canon($result),_canon($compare));
+}
+elsif ($^O eq 'VMS') { # privlib is perl_root:[lib] unfortunately
+ $compare = "/lib/pod/perlfunc.pod";
+ $result = VMS::Filespec::unixify($result);
+ $result =~ s/perl_root\///i;
+ $result =~ s/^\.\.//; # needed under `mms test`
+ ok($result,$compare);
+}
+else {
+ $compare = File::Spec->catfile($Config::Config{privlib},
+ ($^O =~ /macos|darwin|cygwin/i ? 'pods' : 'pod'),"perlfunc.pod");
+ ok(_canon($result),_canon($compare));
+}
# make the path as generic as possible
sub _canon
@@ -96,8 +135,9 @@
my @comp = File::Spec->splitpath($path);
my @dir = File::Spec->splitdir($comp[1]);
$comp[1] = File::Spec->catdir(@dir);
- $path = File::Spec->catpath(@dir);
+ $path = File::Spec->catpath(@comp);
$path = uc($path) if File::Spec->case_tolerant;
+ print "### general path: $path\n" if $VERBOSE;
$path;
}
==== //depot/maint-5.8/perl/t/pod/poderrs.xr#6 (text) ====
Index: perl/t/pod/poderrs.xr
--- perl/t/pod/poderrs.xr#5~18897~ Mon Mar 10 13:11:03 2003
+++ perl/t/pod/poderrs.xr Fri Aug 29 08:12:24 2003
@@ -46,4 +46,3 @@
*** ERROR: unresolved internal link 'abc def' at line 114 in file t/pod/poderrs.t
*** ERROR: unresolved internal link 'I/O Operators' at line 202 in file
t/pod/poderrs.t
*** WARNING: multiple occurrence of link target 'Misc' at line - in file
t/pod/poderrs.t
-t/pod/poderrs.t has 34 pod syntax errors.
End of Patch.
