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