xref: /openbsd-src/gnu/usr.bin/perl/ext/XS-APItest/t/callregexec.t (revision b8851fcc53cbe24fd20b090f26dd149e353f6174)
191f110e0Safresh1#!perl
291f110e0Safresh1
391f110e0Safresh1# test CALLREGEXEC()
491f110e0Safresh1# (currently it just checks that it handles non-\0 terminated strings;
591f110e0Safresh1# full tests haven't been added yet)
691f110e0Safresh1
791f110e0Safresh1use warnings;
891f110e0Safresh1use strict;
991f110e0Safresh1
1091f110e0Safresh1use XS::APItest;
1191f110e0Safresh1*callregexec = *XS::APItest::callregexec;
1291f110e0Safresh1
13*b8851fccSafresh1use Test::More tests => 48;
1491f110e0Safresh1
1591f110e0Safresh1# Test that the regex engine can handle strings without terminating \0
1691f110e0Safresh1# XXX This is by no means comprehensive; it doesn't test all ops, nor all
1791f110e0Safresh1# code paths within those ops (especially not utf8).
1891f110e0Safresh1
1991f110e0Safresh1
2091f110e0Safresh1# this sub takes a string that has an extraneous char at the end.
2191f110e0Safresh1# First see if the string (less the last char) matches the regex;
2291f110e0Safresh1# then see if that string (including the last char) matches when
2391f110e0Safresh1# calling callregexec(), but with the length arg set to 1 char less than
2491f110e0Safresh1# the length of the string.
2591f110e0Safresh1# In theory the result should be the same for both matches, since
2691f110e0Safresh1# they should both not 'see' the final char.
2791f110e0Safresh1
2891f110e0Safresh1sub try {
2991f110e0Safresh1    my ($str, $re, $exp, $desc) = @_;
3091f110e0Safresh1
3191f110e0Safresh1    my $str1 = substr($str, 0, -1);
3291f110e0Safresh1    ok !!$exp == !!($str1 =~ $re), "$desc str =~ qr";
3391f110e0Safresh1
3491f110e0Safresh1    my $bytes = do { use bytes; length $str1 };
3591f110e0Safresh1    ok  !!$exp == !!callregexec($re, 0, $bytes, 0, $str, 0),
3691f110e0Safresh1	    "$desc callregexec";
3791f110e0Safresh1}
3891f110e0Safresh1
3991f110e0Safresh1
4091f110e0Safresh1{
4191f110e0Safresh1    try "\nx",         qr/\n^/m,          0, 'MBOL';
4291f110e0Safresh1    try "ax",          qr/a$/m,           1, 'MEOL';
4391f110e0Safresh1    try "ax",          qr/a$/s,           1, 'SEOL';
4491f110e0Safresh1    try "abx",         qr/^(ab|X)./s,     0, 'SANY';
4591f110e0Safresh1    try "abx",         qr/^(ab|X)./,      0, 'REG_ANY';
4691f110e0Safresh1    try "abx",         qr/^ab(c|d|e|x)/,  0, 'TRIE/TRIEC';
4791f110e0Safresh1    try "abx",         qr/^abx/,          0, 'EXACT';
4891f110e0Safresh1    try "abx",         qr/^ABX/i,         0, 'EXACTF';
4991f110e0Safresh1    try "abx",         qr/^ab\b/,         1, 'BOUND';
5091f110e0Safresh1    try "ab-",         qr/^ab\B/,         0, 'NBOUND';
5191f110e0Safresh1    try "aas",         qr/a[st]/,         0, 'ANYOF';
5291f110e0Safresh1    try "aas",         qr/a[s\xDF]/i,     0, 'ANYOFV';
5391f110e0Safresh1    try "ab1",         qr/ab\d/,          0, 'DIGIT';
5491f110e0Safresh1    try "ab\n",        qr/ab[[:ascii:]]/, 0, 'POSIX';
5591f110e0Safresh1    try "aP\x{307}",   qr/^a\X/,          1, 'CLUMP 1';
5691f110e0Safresh1    try "aP\x{307}x",  qr/^a\X/,          1, 'CLUMP 2';
5791f110e0Safresh1    try "\x{100}\r\n", qr/^\x{100}\X/,    1, 'CLUMP 3';
5891f110e0Safresh1    try "abb",         qr/^a(b)\1/,       0, 'REF';
5991f110e0Safresh1    try "ab\n",        qr/^.+\R/,         0, 'LNBREAK';
6091f110e0Safresh1    try "ab\n",        qr/^.+\v/,         0, 'VERTWS';
6191f110e0Safresh1    try "abx",         qr/^.+\V/,         1, 'NVERTWS';
6291f110e0Safresh1    try "ab\t",        qr/^.+\h/,         0, 'HORIZWS';
6391f110e0Safresh1    try "abx",         qr/^.+\H/,         1, 'NHORIZWS';
6491f110e0Safresh1    try "abx",         qr/a.*x/,          0, 'CURLY';
6591f110e0Safresh1}
66