This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [PATCH] Callbacks for named captures (%+ and %-)
[perl5.git] / ext / re / t / re_funcs.t
CommitLineData
de8c5301
YO
1#!./perl
2
3BEGIN {
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
13use strict;
14
256ddcd0 15use Test::More; # test count at bottom of file
44a2ac75 16use re qw(is_regexp regexp_pattern regmust
192b9cd1 17 regname regnames regnames_count);
bcdf7404 18{
87e95b7f 19 my $qr=qr/foo/pi;
bcdf7404
YO
20 ok(is_regexp($qr),'is_regexp($qr)');
21 ok(!is_regexp(''),'is_regexp("")');
22 is((regexp_pattern($qr))[0],'foo','regexp_pattern[0]');
87e95b7f
YO
23 is((regexp_pattern($qr))[1],'ip','regexp_pattern[1]');
24 is(regexp_pattern($qr),'(?pi-xsm:foo)','scalar regexp_pattern');
bcdf7404
YO
25 ok(!regexp_pattern(''),'!regexp_pattern("")');
26}
256ddcd0
YO
27{
28 my $qr=qr/here .* there/x;
29 my ($anchored,$floating)=regmust($qr);
30 is($anchored,'here',"Regmust anchored - qr//");
31 is($floating,'there',"Regmust floating - qr//");
32 my $foo='blah';
33 ($anchored,$floating)=regmust($foo);
34 is($anchored,undef,"Regmust anchored - non ref");
35 is($floating,undef,"Regmust anchored - non ref");
36 my $bar=['blah'];
37 ($anchored,$floating)=regmust($foo);
38 is($anchored,undef,"Regmust anchored - ref");
39 is($floating,undef,"Regmust anchored - ref");
40}
41
44a2ac75 42if ('1234'=~/(?:(?<A>\d)|(?<C>!))(?<B>\d)(?<A>\d)(?<B>\d)/){
28d8d7f4 43 my @names = sort +regnames();
44a2ac75 44 is("@names","A B","regnames");
192b9cd1
AB
45 my @names = sort +regnames(0);
46 is("@names","A B","regnames");
47 my $names = regnames();
48 is($names, "B", "regnames in scalar context");
28d8d7f4 49 @names = sort +regnames(1);
44a2ac75 50 is("@names","A B C","regnames");
28d8d7f4
YO
51 is(join("", @{regname("A",1)}),"13");
52 is(join("", @{regname("B",1)}),"24");
44a2ac75 53 {
28d8d7f4 54 if ('foobar'=~/(?<foo>foo)(?<bar>bar)/) {
44a2ac75
YO
55 is(regnames_count(),2);
56 } else {
57 ok(0); ok(0);
58 }
59 }
60 is(regnames_count(),3);
44a2ac75 61}
256ddcd0 62# New tests above this line, don't forget to update the test count below!
192b9cd1 63use Test::More tests => 20;
256ddcd0 64# No tests here!