This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove MI from FastCalc
[perl5.git] / ext / re / t / re_funcs.t
1 #!./perl
2
3 BEGIN {
4     require Config;
5     if (($Config::Config{'extensions'} !~ /\bre\b/) ){
6         print "1..0 # Skip -- Perl configured without re module\n";
7         exit 0;
8     }
9 }
10
11 use strict;
12 use warnings;
13
14 use Test::More; # test count at bottom of file
15 {
16     use re qw{regmust};
17     my $qr=qr/here .* there/x;
18     my ($anchored,$floating)=regmust($qr);
19     is($anchored,'here',"Regmust anchored - qr//");
20     is($floating,'there',"Regmust floating - qr//");
21     my $foo='blah';
22     ($anchored,$floating)=regmust($foo);
23     is($anchored,undef,"Regmust anchored - non ref");
24     is($floating,undef,"Regmust anchored - non ref");
25     my $bar=['blah'];
26     ($anchored,$floating)=regmust($foo);
27     is($anchored,undef,"Regmust anchored - ref");
28     is($floating,undef,"Regmust anchored - ref");
29 }
30
31 {
32     use re qw{optimization};
33     # try to show each element is populated, without working the regexp
34     # engine any harder than necessary - the real work will be testing
35     # that optimization happens correctly using this under t/re.
36
37     is(optimization(undef), undef, "non-qr returns undef");
38     is(optimization("foo"), undef, "non-qr returns undef");
39     is(optimization(bless {}, "Regexp"), undef, "non-qr returns undef");
40
41     my $o = optimization(qr{foo});
42     is(ref($o), 'HASH', "qr returns a hashref");
43     is($o->{minlen}, 3, "/foo/ has minlen");
44
45     $o = optimization(qr{foo(?=bar)});
46     is($o->{minlenret}, 3, "/foo(?=bar)/ has minlenret");
47
48     $o = optimization(qr{.\G.});
49     ok($o->{'anchor GPOS'}, "/.\\G./ has anchor GPOS");
50     is($o->{gofs}, 1, "/.\\G./ has gofs");
51
52     $o = optimization(qr{a|bc});
53     is($o->{anchored}, undef, "/a|bc/ has no anchored substring");
54     is($o->{floating}, undef, "/a|bc/ has no floating substring");
55     is($o->{checking}, "none", "/a|bc/ is checking no substring");
56
57     $o = optimization(qr{foo});
58     ok($o->{isall}, "/foo/ has isall");
59     is($o->{anchored}, "foo", "/foo/ has anchored substring");
60     is($o->{'anchored utf8'}, undef, "/foo/ has no anchored utf8");
61     is($o->{floating}, undef, "/foo/ has no floating substring");
62     is($o->{checking}, "anchored", "/foo/ is checking anchored");
63
64     $o = optimization(qr{.foo});
65     is($o->{'anchored min offset'}, 1, "/.foo/ has anchored min offset");
66     like($o->{'anchored max offset'}, qr{^[01]\z},
67             "/.foo/ has valid anchored max offset");
68
69     $o = optimization(qr{.foo\x{100}});
70     is($o->{anchored}, undef, "/.foo\\x{100}/ has no anchored");
71     is($o->{'anchored utf8'}, "foo\x{100}", "/.foo\\x{100}/ has anchored utf8");
72     is($o->{'anchored min offset'}, 1, "/.foo\\x{100}/ has anchored min");
73     like($o->{'anchored max offset'}, qr{^[01]\z},
74             "/.foo\\x{100}/ has valid anchored max offset");
75
76     $o = optimization(qr{.x?foo});
77     is($o->{anchored}, undef, "/.x?foo/ has no anchored substring");
78     is($o->{floating}, "foo", "/.x?foo/ has floating substring");
79     is($o->{'floating utf8'}, undef, "/.x?foo/ has no floating utf8");
80     is($o->{'floating min offset'}, 1, "/.x?foo/ has floating min offset");
81     is($o->{'floating max offset'}, 2, "/.x?foo/ has floating max offset");
82     is($o->{checking}, "floating", "/foo/ is checking floating");
83
84     $o = optimization(qr{[ab]+});
85     ok($o->{skip}, "/[ab]+/ has skip");
86     like($o->{stclass}, qr{^ANYOF}, "/[ab]+/ has stclass");
87
88     ok(optimization(qr{^foo})->{'anchor SBOL'}, "/^foo/ has anchor SBOL");
89     ok(optimization(qr{^foo}m)->{'anchor MBOL'}, "/^foo/m has anchor MBOL");
90     ok(optimization(qr{.*})->{implicit}, "/.*/ has implicit anchor");
91     ok(optimization(qr{^.foo})->{noscan}, "/^.foo/ has noscan");
92
93     # TODO: test anchored/floating end shift
94 }
95 # New tests above this line, don't forget to update the test count below!
96 use Test::More tests => 40;
97 # No tests here!
98
99 #
100 # ex: set ts=8 sts=4 sw=4 et:
101 #