summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2011-03-06 18:59:52 +0000
committerNicholas Clark <nick@ccl4.org>2011-03-06 20:39:57 +0000
commitcedc31d0900eea3a62ab0e324927251011d4b832 (patch)
tree597d3a8d443d2dd1d28f3aaed3d0942add51b6f9 /ext
parent563ff921d7b97889a3a611987ca6f2f250c5b876 (diff)
downloadperl-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.t143
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^^^