diff options
author | Nicholas Clark <nick@ccl4.org> | 2011-03-06 18:59:52 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2011-03-06 20:39:57 +0000 |
commit | cedc31d0900eea3a62ab0e324927251011d4b832 (patch) | |
tree | 597d3a8d443d2dd1d28f3aaed3d0942add51b6f9 /ext | |
parent | 563ff921d7b97889a3a611987ca6f2f250c5b876 (diff) | |
download | perl-cedc31d0900eea3a62ab0e324927251011d4b832.tar.gz |
Move t/re/re.t to ext/re/t/re_funcs_u.t, so that it is not part of minitest.
The test file is for functions in the re:: namespace implemented in
universal.c, but needs to load re, which isn't built for minitest. As none of
these functions are used as part of the core's build process, seems best to
move it with all the other tests related to the re extension.
Diffstat (limited to 'ext')
-rw-r--r-- | ext/re/t/re_funcs_u.t | 143 |
1 files changed, 143 insertions, 0 deletions
diff --git a/ext/re/t/re_funcs_u.t b/ext/re/t/re_funcs_u.t new file mode 100644 index 0000000000..dcb35e1334 --- /dev/null +++ b/ext/re/t/re_funcs_u.t @@ -0,0 +1,143 @@ +#!./perl + +BEGIN { + require Config; + if (($Config::Config{'extensions'} !~ /\bre\b/) ){ + print "1..0 # Skip -- Perl configured without re module\n"; + exit 0; + } + require 'test.pl'; # For watchdog +} + +use strict; +use warnings; + +use re qw(is_regexp regexp_pattern + regname regnames regnames_count); +{ + use feature 'unicode_strings'; # Force 'u' pat mod + my $qr=qr/foo/pi; + no feature 'unicode_strings'; + my $rx = $$qr; + + ok(is_regexp($qr),'is_regexp(REGEXP ref)'); + ok(is_regexp($rx),'is_regexp(REGEXP)'); + ok(!is_regexp(''),'is_regexp("")'); + + is((regexp_pattern($qr))[0],'foo','regexp_pattern[0] (ref)'); + is((regexp_pattern($qr))[1],'uip','regexp_pattern[1] (ref)'); + is(regexp_pattern($qr),'(?^upi:foo)','scalar regexp_pattern (ref)'); + + is((regexp_pattern($rx))[0],'foo','regexp_pattern[0] (bare REGEXP)'); + is((regexp_pattern($rx))[1],'uip','regexp_pattern[1] (bare REGEXP)'); + is(regexp_pattern($rx),'(?^upi:foo)', 'scalar regexp_pattern (bare REGEXP)'); + + ok(!regexp_pattern(''),'!regexp_pattern("")'); +} + +if ('1234'=~/(?:(?<A>\d)|(?<C>!))(?<B>\d)(?<A>\d)(?<B>\d)/){ + my @names = sort +regnames(); + is("@names","A B","regnames"); + @names = sort +regnames(0); + is("@names","A B","regnames"); + my $names = regnames(); + is($names, "B", "regnames in scalar context"); + @names = sort +regnames(1); + is("@names","A B C","regnames"); + is(join("", @{regname("A",1)}),"13"); + is(join("", @{regname("B",1)}),"24"); + { + if ('foobar'=~/(?<foo>foo)(?<bar>bar)/) { + is(regnames_count(),2); + } else { + ok(0); ok(0); + } + } + is(regnames_count(),3); +} + +{ + my ($pat, $mods); + $|=1; + + my $re = qr/a/d; + ($pat, $mods) = regexp_pattern($re); + is($mods, "", "Verify /d results in default mod"); + $re = qr/a/u; + ($pat, $mods) = regexp_pattern($re); + is($mods, "u", "Verify /u is understood"); + $re = qr/a/l; + ($pat, $mods) = regexp_pattern($re); + is($mods, "l", "Verify /l is understood"); + $re = qr/a/a; + ($pat, $mods) = regexp_pattern($re); + is($mods, "a", "Verify /a is understood"); + $re = qr/a/aa; + ($pat, $mods) = regexp_pattern($re); + is($mods, "aa", "Verify /aa is understood"); +} + +{ + # tests for new regexp flags + my $text = "\xE4"; + my $check; + + { + # check u/d-flag without setting a locale + $check = $text =~ /(?u)\w/; + ok( $check ); + $check = $text =~ /(?d)\w/; + ok( !$check ); + } + + SKIP: { + skip_if_miniperl("no dynamic loading on miniperl, no POSIX", 3); + require POSIX; + my $current_locale = POSIX::setlocale( &POSIX::LC_CTYPE, 'de_DE.ISO-8859-1' ); + if ( !$current_locale || $current_locale ne 'de_DE.ISO-8859-1' ) { + skip( 'cannot use locale de_DE.ISO-8859-1', 3 ); + } + + $check = $text =~ /(?u)\w/; + ok( $check ); + $check = $text =~ /(?d)\w/; + ok( !$check ); + $check = $text =~ /(?l)\w/; + ok( $check ); + } + + SKIP: { + skip_if_miniperl("no dynamic loading on miniperl, no POSIX", 3); + require POSIX; + my $current_locale = POSIX::setlocale( &POSIX::LC_CTYPE, 'C' ); + if ( !$current_locale || $current_locale ne 'C' ) { + skip( 'cannot set locale C', 3 ); + } + + $check = $text =~ /(?u)\w/; + ok( $check ); + $check = $text =~ /(?d)\w/; + ok( !$check ); + $check = $text =~ /(?l)\w/; + ok( !$check ); + } +} + +# New tests go here ^^^ + + { # Keep these tests last, as whole script will be interrupted if times out + # Bug #72998; this can loop + watchdog(2); + eval '"\x{100}\x{FB00}" =~ /\x{100}\N{U+66}+/i'; + pass("Didn't loop"); + + # Bug #78058; this can loop + no warnings; # Because the 8 may be warned on + eval 'qr/\18/'; + pass(q"qr/\18/ didn't loop"); + } + +done_testing(); + +__END__ +# New tests go up there^^^ |