regex_sets.t revision 1.1
1#!./perl 2 3# This tests (?[...]). XXX These are just basic tests, as full ones would be 4# best done with an infrastructure change to allow getting out the inversion 5# list of the constructed set and then comparing it character by character 6# with the expected result. 7 8use strict; 9use warnings; 10 11$| = 1; 12 13BEGIN { 14 chdir 't' if -d 't'; 15 @INC = ('../lib','.'); 16 require './test.pl'; 17} 18 19use utf8; 20no warnings 'experimental::regex_sets'; 21 22like("a", qr/(?[ [a] # This is a comment 23 ])/, 'Can ignore a comment'); 24like("a", qr/(?[ [a] # [[:notaclass:]] 25 ])/, 'A comment isn\'t parsed'); 26unlike("\x85", qr/(?[ \t�� ])/, 'NEL is white space'); 27unlike("\x85", qr/(?[ [\t��] ])/, '... including within nested []'); 28like("\x85", qr/(?[ \t + \�� ])/, 'can escape NEL to match'); 29like("\x85", qr/(?[ [\��] ])/, '... including within nested []'); 30like("\t", qr/(?[ \t + \�� ])/, 'can do basic union'); 31like("\cK", qr/(?[ \s ])/, '\s matches \cK'); 32unlike("\cK", qr/(?[ \s - \cK ])/, 'can do basic subtraction'); 33like(" ", qr/(?[ \s - \cK ])/, 'can do basic subtraction'); 34like(":", qr/(?[ [:] ])/, '[:] is not a posix class'); 35unlike("\t", qr/(?[ ! \t ])/, 'can do basic complement'); 36like("\t", qr/(?[ ! [ ^ \t ] ])/, 'can do basic complement'); 37unlike("\r", qr/(?[ \t ])/, '\r doesn\'t match \t '); 38like("\r", qr/(?[ ! \t ])/, 'can do basic complement'); 39like("0", qr/(?[ [:word:] & [:digit:] ])/, 'can do basic intersection'); 40unlike("A", qr/(?[ [:word:] & [:digit:] ])/, 'can do basic intersection'); 41like("0", qr/(?[[:word:]&[:digit:]])/, 'spaces around internal [] aren\'t required'); 42 43like("a", qr/(?[ [a] | [b] ])/, '| means union'); 44like("b", qr/(?[ [a] | [b] ])/, '| means union'); 45unlike("c", qr/(?[ [a] | [b] ])/, '| means union'); 46 47like("a", qr/(?[ [ab] ^ [bc] ])/, 'basic symmetric difference works'); 48unlike("b", qr/(?[ [ab] ^ [bc] ])/, 'basic symmetric difference works'); 49like("c", qr/(?[ [ab] ^ [bc] ])/, 'basic symmetric difference works'); 50 51like("2", qr/(?[ ( ( \pN & ( [a] + [2] ) ) ) ])/, 'Nesting parens and grouping'); 52unlike("a", qr/(?[ ( ( \pN & ( [a] + [2] ) ) ) ])/, 'Nesting parens and grouping'); 53 54unlike("\x{17f}", qr/(?[ [k] + \p{Blk=ASCII} ])/i, '/i doesn\'t affect \p{}'); 55like("\N{KELVIN SIGN}", qr/(?[ [k] + \p{Blk=ASCII} ])/i, '/i does affect literals'); 56 57my $thai_or_lao = qr/(?[ \p{Thai} + \p{Lao} ])/; 58my $thai_or_lao_digit = qr/(?[ \p{Digit} & $thai_or_lao ])/; 59like("\N{THAI DIGIT ZERO}", $thai_or_lao_digit, 'embedded qr/(?[ ])/ works'); 60unlike(chr(ord("\N{THAI DIGIT ZERO}") - 1), $thai_or_lao_digit, 'embedded qr/(?[ ])/ works'); 61like("\N{THAI DIGIT NINE}", $thai_or_lao_digit, 'embedded qr/(?[ ])/ works'); 62unlike(chr(ord("\N{THAI DIGIT NINE}") + 1), $thai_or_lao_digit, 'embedded qr/(?[ ])/ works'); 63like("\N{LAO DIGIT ZERO}", $thai_or_lao_digit, 'embedded qr/(?[ ])/ works'); 64unlike(chr(ord("\N{LAO DIGIT ZERO}") - 1), $thai_or_lao_digit, 'embedded qr/(?[ ])/ works'); 65like("\N{LAO DIGIT NINE}", $thai_or_lao_digit, 'embedded qr/(?[ ])/ works'); 66unlike(chr(ord("\N{LAO DIGIT NINE}") + 1), $thai_or_lao_digit, 'embedded qr/(?[ ])/ works'); 67 68my $ascii_word = qr/(?[ \w ])/a; 69my $ascii_digits_plus_all_of_arabic = qr/(?[ \p{Digit} & $ascii_word + \p{Arabic} ])/; 70like("9", $ascii_digits_plus_all_of_arabic, "/a, then interpolating and intersection works for ASCII in the set"); 71unlike("A", $ascii_digits_plus_all_of_arabic, "/a, then interpolating and intersection works for ASCII not in the set"); 72unlike("\N{BENGALI DIGIT ZERO}", $ascii_digits_plus_all_of_arabic, "/a, then interpolating and intersection works for non-ASCII not in either set"); 73unlike("\N{BENGALI LETTER A}", $ascii_digits_plus_all_of_arabic, "/a, then interpolating and intersection works for non-ASCII in one set"); 74like("\N{ARABIC LETTER HAMZA}", $ascii_digits_plus_all_of_arabic, "interpolation and intersection is left-associative"); 75like("\N{EXTENDED ARABIC-INDIC DIGIT ZERO}", $ascii_digits_plus_all_of_arabic, "interpolation and intersection is left-associative"); 76 77my $kelvin = qr/(?[ \N{KELVIN SIGN} ])/; 78my $fold = qr/(?[ $kelvin ])/i; 79like("\N{KELVIN SIGN}", $kelvin, '"\N{KELVIN SIGN}" matches compiled qr/(?[ \N{KELVIN SIGN} ])/'); 80unlike("K", $fold, "/i on outer (?[ ]) doesn't leak to interpolated one"); 81unlike("k", $fold, "/i on outer (?[ ]) doesn't leak to interpolated one"); 82 83my $kelvin_fold = qr/(?[ \N{KELVIN SIGN} ])/i; 84my $still_fold = qr/(?[ $kelvin_fold ])/; 85like("K", $still_fold, "/i on interpolated (?[ ]) is retained in outer without /i"); 86like("k", $still_fold, "/i on interpolated (?[ ]) is retained in outer without /i"); 87 88done_testing(); 89 901; 91