chdir '..' if -d '../pod' && -d '../t';
@INC = 'lib';
require './t/test.pl';
- plan(24);
+ plan(31);
}
BEGIN {
# Multiple messages with the same description
seek STDERR, 0,0;
$warning = '';
-warn 'Code point 0xBEE5 is not Unicode, may not be portable';
-like $warning, qr/S utf8/,
+warn 'Deep recursion on anonymous subroutine';
+like $warning, qr/W recursion/,
'Message sharing its description with the following message';
+seek STDERR, 0,0;
+$warning = '';
+warn 'Deep recursion on subroutine "foo"';
+like $warning, qr/W recursion/,
+ 'Message sharing its description with the preceding message';
# Periods at end of entries in perldiag.pod get matched correctly
seek STDERR, 0,0;
$warning = '';
warn "Using just the first character returned by \\N{} in character class in regex; marked by <-- HERE in m/%s/";
like $warning,
- qr/A charnames handler may return a sequence/s,
+ qr/Named Unicode character escapes/s,
'multi-line entries in perldiag.pod match';
# ; at end of entry in perldiag.pod
seek STDERR, 0,0;
$warning = '';
-warn "Perl folding rules are not up-to-date for 0xA; please use the perlbug utility to report; in regex; marked by <-- HERE in m/\ <-- HERE q/";
+warn "Perl folding rules are not up-to-date for 0x0A; please use the perlbug utility to report; in regex; marked by <-- HERE in m/\ <-- HERE q/";
like $warning,
- qr/regular expression folding rules/s,
+ qr/You used a regular expression with case-insensitive matching/s,
'; works at the end of entries in perldiag.pod';
# Differences in spaces in warnings (Why not be nice and accept them?)
qr/The whole warning/s,
'spaces in warnings with periods at the end are matched lightly';
+# Wrapped links
+seek STDERR, 0,0;
+$warning = '';
+warn "Argument \"%s\" treated as 0 in increment (++)";
+like $warning,
+ qr/Auto-increment.*Auto-decrement/s,
+ 'multiline links are not truncated';
+
+{
+# Find last warning in perldiag.pod, and last items if any
+ my $lw;
+ my $over_level = 0;
+ my $inlast;
+ my $item;
+ my $items_not_in_overs = 0;
+
+ open(my $f, '<', "pod/perldiag.pod")
+ or die "failed to open pod/perldiag.pod for reading: $!";
+
+ while (<$f>) {
+
+ # We only look for entries (=item lines) in the first level of =overs
+
+ if ( /^=over\b/) {
+ $over_level++;
+ } elsif ( /^=item\s+(.*)/) {
+ if ($over_level < 1) {
+ $items_not_in_overs++;
+ }
+ elsif ($over_level == 1) {
+ $lw = $1;
+ }
+ } elsif (/^=back\b/) {
+ $inlast = 1 if $over_level == 1;
+ $over_level--;
+ } elsif ($inlast) {
+ # Skip headings
+ next if /^=/;
+
+ # Strip specials
+ $_ =~ s/\w<(.*?)>/$1/g;
+
+ # And whitespace
+ $_ =~ s/(^\s+|\s+$)//g;
+
+ if ($_) {
+ $item = $_;
+
+ last;
+ }
+ }
+ }
+ close($f);
+
+ is($over_level, 0, "(sanity...) =over balanced with =back (off by $over_level)");
+ is($items_not_in_overs, 0, "(sanity...) all =item lines are within =over..=back blocks");
+ ok($item, "(sanity...) found an item to check with ($item)");
+ seek STDERR, 0,0;
+ $warning = '';
+ warn $lw;
+ ok($warning, '(sanity...) got a warning');
+ unlike $warning,
+ qr/\Q$item\E/,
+ "Junk after =back doesn't show up in last warning";
+}
*STDERR = $old_stderr;