Commit | Line | Data |
de8c5301 |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | @INC = '../lib'; |
6 | require Config; |
7 | if (($Config::Config{'extensions'} !~ /\bre\b/) ){ |
8 | print "1..0 # Skip -- Perl configured without re module\n"; |
9 | exit 0; |
10 | } |
11 | } |
12 | |
13 | use strict; |
14 | |
256ddcd0 |
15 | use Test::More; # test count at bottom of file |
44a2ac75 |
16 | use re qw(is_regexp regexp_pattern regmust |
17 | regname regnames regnames_count |
18 | regnames_iterinit regnames_iternext); |
bcdf7404 |
19 | { |
20 | my $qr=qr/foo/ki; |
21 | ok(is_regexp($qr),'is_regexp($qr)'); |
22 | ok(!is_regexp(''),'is_regexp("")'); |
23 | is((regexp_pattern($qr))[0],'foo','regexp_pattern[0]'); |
24 | is((regexp_pattern($qr))[1],'ik','regexp_pattern[1]'); |
25 | is(regexp_pattern($qr),'(?ki-xsm:foo)','scalar regexp_pattern'); |
26 | ok(!regexp_pattern(''),'!regexp_pattern("")'); |
27 | } |
256ddcd0 |
28 | { |
29 | my $qr=qr/here .* there/x; |
30 | my ($anchored,$floating)=regmust($qr); |
31 | is($anchored,'here',"Regmust anchored - qr//"); |
32 | is($floating,'there',"Regmust floating - qr//"); |
33 | my $foo='blah'; |
34 | ($anchored,$floating)=regmust($foo); |
35 | is($anchored,undef,"Regmust anchored - non ref"); |
36 | is($floating,undef,"Regmust anchored - non ref"); |
37 | my $bar=['blah']; |
38 | ($anchored,$floating)=regmust($foo); |
39 | is($anchored,undef,"Regmust anchored - ref"); |
40 | is($floating,undef,"Regmust anchored - ref"); |
41 | } |
42 | |
44a2ac75 |
43 | |
44 | if ('1234'=~/(?:(?<A>\d)|(?<C>!))(?<B>\d)(?<A>\d)(?<B>\d)/){ |
45 | my $qr = qr/(?<foo>foo)(?<bar>bar)/; |
46 | my @names = sort +regnames($qr); |
47 | is("@names","","regnames"); |
48 | @names = sort +regnames($qr,1); |
49 | is("@names","bar foo","regnames - all"); |
50 | @names = sort +regnames(); |
51 | is("@names","A B","regnames"); |
52 | @names = sort +regnames(undef,1); |
53 | is("@names","A B C","regnames"); |
54 | is(join("", @{regname("A",undef,1)}),"13"); |
55 | is(join("", @{regname("B",undef,1)}),"24"); |
56 | { |
57 | if ('foobar'=~/$qr/) { |
58 | regnames_iterinit(); |
59 | my @res; |
60 | while (defined(my $key=regnames_iternext)) { |
61 | push @res,$key; |
62 | } |
63 | @res=sort @res; |
64 | is("@res","bar foo"); |
65 | is(regnames_count(),2); |
66 | } else { |
67 | ok(0); ok(0); |
68 | } |
69 | } |
70 | is(regnames_count(),3); |
71 | is(regnames_count($qr),2); |
72 | } |
73 | { |
74 | use warnings; |
75 | require re::Tie::Hash::NamedCapture; |
76 | my $qr = qr/(?<foo>foo)/; |
77 | if ( 'foo' =~ /$qr/ ) { |
78 | tie my %hash,"re::Tie::Hash::NamedCapture",re => $qr; |
79 | if ('bar'=~/bar/) { |
80 | # last successful match is now different |
81 | is($hash{foo},'foo'); # prints foo |
82 | } |
83 | } |
84 | } |
256ddcd0 |
85 | # New tests above this line, don't forget to update the test count below! |
44a2ac75 |
86 | use Test::More tests => 23; |
256ddcd0 |
87 | # No tests here! |