1use warnings; 2use strict; 3 4# confirm that regexp-typed stack args are displayed correctly by longmess() 5 6use Test::More tests => 42; 7 8use Carp (); 9 10sub lmm { Carp::longmess("x") } 11sub lm { lmm() } 12sub rx { qr/$_[0]/ } 13 14# Use full generality on sufficiently recent versions. On early Perl 15# releases, U+E9 is 0x51 on all EBCDIC code pages supported then. 16my $e9 = sprintf "%02x", (($] ge 5.007_003) 17 ? utf8::unicode_to_native(0xe9) 18 : ((ord("A") == 193) 19 ? 0x51 20 : 0xE9)); 21my $xe9 = "\\x$e9"; 22my $chr_e9 = eval "\"$xe9\""; 23my $nl_as_hex = sprintf "%x", ord("\n"); 24 25# On Perl 5.6 we accept some incorrect quoting of Unicode characters, 26# because upgradedness of regexps isn't preserved by stringification, 27# so it's impossible to implement the correct behaviour. 28# FIXME: the permissive patterns don't account for EBCDIC 29my $xe9_rx = "$]" < 5.008 ? qr/\\x\{c3\}\\x\{a9\}|\\x\{e9\}/ : qr/\\x\{$e9\}/; 30my $x666_rx = "$]" < 5.008 ? qr/\\x\{d9\}\\x\{a6\}|\\x\{666\}/ : qr/\\x\{666\}/; 31my $x2603_rx = "$]" < 5.008 ? qr/\\x\{e2\}\\x\{98\}\\x\{83\}|\\x\{2603\}/ : qr/\\x\{2603\}/; 32 33like lm(qr/3/), qr/main::lm\(qr\(3\)u?\)/; 34like lm(qr/a.b/), qr/main::lm\(qr\(a\.b\)u?\)/; 35like lm(qr/a.b/s), qr/main::lm\(qr\(a\.b\)u?s\)/; 36like lm(qr/a.b$/s), qr/main::lm\(qr\(a\.b\$\)u?s\)/; 37like lm(qr/a.b$/sm), qr/main::lm\(qr\(a\.b\$\)u?ms\)/; 38like lm(qr/foo/), qr/main::lm\(qr\(foo\)u?\)/; 39like lm(qr/a\$b\@c\\d/), qr/main::lm\(qr\(a\\\$b\\\@c\\\\d\)u?\)/; 40like lm(qr/a\nb/), qr/main::lm\(qr\(a\\nb\)u?\)/; 41like lm(rx("a\nb")), qr/main::lm\(qr\(a\\x\{$nl_as_hex\}b\)u?\)/; 42like lm(qr/a\x{666}b/), qr/main::lm\(qr\(a\\x\{666\}b\)u?\)/; 43like lm(rx("a\x{666}b")), qr/main::lm\(qr\(a${x666_rx}b\)u?\)/; 44like lm(qr/\x{666}b/), qr/main::lm\(qr\(\\x\{666\}b\)u?\)/; 45like lm(rx("\x{666}b")), qr/main::lm\(qr\(${x666_rx}b\)u?\)/; 46like lm(qr/a\x{666}/), qr/main::lm\(qr\(a\\x\{666\}\)u?\)/; 47like lm(rx("a\x{666}")), qr/main::lm\(qr\(a${x666_rx}\)u?\)/; 48like lm(qr/L${xe9}on/), qr/main::lm\(qr\(L\\x${e9}on\)u?\)/; 49like lm(rx("L${chr_e9}on")), qr/main::lm\(qr\(L${xe9_rx}on\)u?\)/; 50like lm(qr/L${xe9}on \x{2603} !/), qr/main::lm\(qr\(L\\x${e9}on \\x\{2603\} !\)u?\)/; 51like lm(rx("L${chr_e9}on \x{2603} !")), qr/main::lm\(qr\(L${xe9_rx}on ${x2603_rx} !\)u?\)/; 52 53$Carp::MaxArgLen = 5; 54foreach my $arg ("foo bar baz", "foo bar ba", "foo bar b", "foo bar ", "foo bar", "foo ba") { 55 like lm(rx($arg)), qr/main::lm\(qr\(fo\)\.\.\.u?\)/; 56} 57foreach my $arg ("foo b", "foo ", "foo", "fo", "f", "") { 58 like lm(rx($arg)), qr/main::lm\(qr\(\Q$arg\E\)u?\)/; 59} 60like lm(qr/foo.bar$/sm), qr/main::lm\(qr\(fo\)\.\.\.u?ms\)/; 61like lm(qr/L${xe9}on \x{2603} !/), qr/main::lm\(qr\(L\\\)\.\.\.u?\)/; 62like lm(rx("L${chr_e9}on \x{2603} !")), qr/main::lm\(qr\(L\\\)\.\.\.u?\)/; 63like lm(qr/L${xe9}on\x{2603}/), qr/main::lm\(qr\(L\\\)\.\.\.u?\)/; 64like lm(rx("L${chr_e9}on\x{2603}")), qr/main::lm\(qr\(L\\\)\.\.\.u?\)/; 65like lm(qr/foo\x{2603}/), qr/main::lm\(qr\(fo\)\.\.\.u?\)/; 66like lm(rx("foo\x{2603}")), qr/main::lm\(qr\(fo\)\.\.\.u?\)/; 67 68$Carp::MaxArgLen = 0; 69foreach my $arg ("wibble:" x 20, "foo bar baz") { 70 like lm(rx($arg)), qr/main::lm\(qr\(\Q$arg\E\)u?\)/; 71} 72like lm(qr/L${xe9}on\x{2603}/), qr/main::lm\(qr\(L\\x${e9}on\\x\{2603\}\)u?\)/; 73like lm(rx("L${chr_e9}on\x{2603}")), qr/main::lm\(qr\(L${xe9_rx}on${x2603_rx}\)u?\)/; 74 751; 76