xref: /openbsd-src/gnu/usr.bin/perl/dist/Carp/t/arg_regexp.t (revision f2da64fbbbf1b03f09f390ab01267c93dfd77c4c) 
1use warnings;
2use strict;
3
4use Test::More tests => 42;
5
6use Carp ();
7
8sub lmm { Carp::longmess("x") }
9sub lm { lmm() }
10sub rx { qr/$_[0]/ }
11
12# On Perl 5.6 we accept some incorrect quoting of Unicode characters,
13# because upgradedness of regexps isn't preserved by stringification,
14# so it's impossible to implement the correct behaviour.
15my $xe9_rx = "$]" < 5.008 ? qr/\\x\{c3\}\\x\{a9\}|\\x\{e9\}/ : qr/\\x\{e9\}/;
16my $x666_rx = "$]" < 5.008 ? qr/\\x\{d9\}\\x\{a6\}|\\x\{666\}/ : qr/\\x\{666\}/;
17my $x2603_rx = "$]" < 5.008 ? qr/\\x\{e2\}\\x\{98\}\\x\{83\}|\\x\{2603\}/ : qr/\\x\{2603\}/;
18
19like lm(qr/3/), qr/main::lm\(qr\(3\)u?\)/;
20like lm(qr/a.b/), qr/main::lm\(qr\(a\.b\)u?\)/;
21like lm(qr/a.b/s), qr/main::lm\(qr\(a\.b\)u?s\)/;
22like lm(qr/a.b$/s), qr/main::lm\(qr\(a\.b\$\)u?s\)/;
23like lm(qr/a.b$/sm), qr/main::lm\(qr\(a\.b\$\)u?ms\)/;
24like lm(qr/foo/), qr/main::lm\(qr\(foo\)u?\)/;
25like lm(qr/a\$b\@c\\d/), qr/main::lm\(qr\(a\\\$b\\\@c\\\\d\)u?\)/;
26like lm(qr/a\nb/), qr/main::lm\(qr\(a\\nb\)u?\)/;
27like lm(rx("a\nb")), qr/main::lm\(qr\(a\\x\{a\}b\)u?\)/;
28like lm(qr/a\x{666}b/), qr/main::lm\(qr\(a\\x\{666\}b\)u?\)/;
29like lm(rx("a\x{666}b")), qr/main::lm\(qr\(a${x666_rx}b\)u?\)/;
30like lm(qr/\x{666}b/), qr/main::lm\(qr\(\\x\{666\}b\)u?\)/;
31like lm(rx("\x{666}b")), qr/main::lm\(qr\(${x666_rx}b\)u?\)/;
32like lm(qr/a\x{666}/), qr/main::lm\(qr\(a\\x\{666\}\)u?\)/;
33like lm(rx("a\x{666}")), qr/main::lm\(qr\(a${x666_rx}\)u?\)/;
34like lm(qr/L\xe9on/), qr/main::lm\(qr\(L\\xe9on\)u?\)/;
35like lm(rx("L\xe9on")), qr/main::lm\(qr\(L${xe9_rx}on\)u?\)/;
36like lm(qr/L\xe9on \x{2603} !/), qr/main::lm\(qr\(L\\xe9on \\x\{2603\} !\)u?\)/;
37like lm(rx("L\xe9on \x{2603} !")), qr/main::lm\(qr\(L${xe9_rx}on ${x2603_rx} !\)u?\)/;
38
39$Carp::MaxArgLen = 5;
40foreach my $arg ("foo bar baz", "foo bar ba", "foo bar b", "foo bar ", "foo bar", "foo ba") {
41    like lm(rx($arg)), qr/main::lm\(qr\(fo\)\.\.\.u?\)/;
42}
43foreach my $arg ("foo b", "foo ", "foo", "fo", "f", "") {
44    like lm(rx($arg)), qr/main::lm\(qr\(\Q$arg\E\)u?\)/;
45}
46like lm(qr/foo.bar$/sm), qr/main::lm\(qr\(fo\)\.\.\.u?ms\)/;
47like lm(qr/L\xe9on \x{2603} !/), qr/main::lm\(qr\(L\\\)\.\.\.u?\)/;
48like lm(rx("L\xe9on \x{2603} !")), qr/main::lm\(qr\(L\\\)\.\.\.u?\)/;
49like lm(qr/L\xe9on\x{2603}/), qr/main::lm\(qr\(L\\\)\.\.\.u?\)/;
50like lm(rx("L\xe9on\x{2603}")), qr/main::lm\(qr\(L\\\)\.\.\.u?\)/;
51like lm(qr/foo\x{2603}/), qr/main::lm\(qr\(fo\)\.\.\.u?\)/;
52like lm(rx("foo\x{2603}")), qr/main::lm\(qr\(fo\)\.\.\.u?\)/;
53
54$Carp::MaxArgLen = 0;
55foreach my $arg ("wibble:" x 20, "foo bar baz") {
56    like lm(rx($arg)), qr/main::lm\(qr\(\Q$arg\E\)u?\)/;
57}
58like lm(qr/L\xe9on\x{2603}/), qr/main::lm\(qr\(L\\xe9on\\x\{2603\}\)u?\)/;
59like lm(rx("L\xe9on\x{2603}")), qr/main::lm\(qr\(L${xe9_rx}on${x2603_rx}\)u?\)/;
60
611;
62