This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add regexp_nonull.t
authorFather Chrysostomos <sprout@cpan.org>
Sat, 17 Sep 2016 18:06:55 +0000 (11:06 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 17 Sep 2016 18:07:32 +0000 (11:07 -0700)
for testing the regular expression engine with strings that
lack a trailing null byte.

MANIFEST
ext/XS-APItest/APItest.xs
t/re/regexp.t
t/re/regexp_nonull.t [new file with mode: 0644]

index d99b41b..f37157f 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -5678,6 +5678,7 @@ t/re/regex_sets.t         Test (?[ ])
 t/re/regex_sets_compat.t       Test (?[ ]) is compatible with old [ ]
 t/re/regexp.t                  See if regular expressions work
 t/re/regexp_noamp.t            See if regular expressions work with optimizations
+t/re/regexp_nonull.t           See if regexps work without trailing nulls
 t/re/regexp_notrie.t           See if regular expressions work without trie optimisation
 t/re/regexp_qr.t               See if regular expressions work as qr//
 t/re/regexp_qr_embed.t         See if regular expressions work with embedded qr//
index 4602cee..907c17d 100644 (file)
@@ -4219,6 +4219,18 @@ CODE:
     } else
         Perl_croak(aTHX_ "load_module can't yet support %"IVdf" items", (IV)items);
 
+SV *
+string_without_null(SV *sv)
+    CODE:
+    {
+        STRLEN len;
+        const char *s = SvPV(sv, len);
+        RETVAL = newSVpvn_flags(s, len, SvUTF8(sv));
+        *SvEND(RETVAL) = 0xff;
+    }
+    OUTPUT:
+        RETVAL
+
 MODULE = XS::APItest PACKAGE = XS::APItest::AUTOLOADtest
 
 int
index 5ec6e5c..2cbfc9f 100644 (file)
@@ -98,7 +98,8 @@ sub convert_from_ascii {
 use strict;
 use warnings FATAL=>"all";
 use vars qw($bang $ffff $nulnul); # used by the tests
-use vars qw($qr $skip_amp $qr_embed $qr_embed_thr $regex_sets); # set by our callers
+use vars qw($qr $skip_amp $qr_embed $qr_embed_thr $regex_sets
+            $no_null); # set by our callers
 
 
 
@@ -363,6 +364,7 @@ foreach (@tests) {
        # Need to make a copy, else the utf8::upgrade of an already studied
        # scalar confuses things.
        my $subject = $subject;
+       $subject = XS::APItest::string_without_null($subject) if $no_null;
        my $c = $iters;
        my ($code, $match, $got);
         if ($repl eq 'pos') {
diff --git a/t/re/regexp_nonull.t b/t/re/regexp_nonull.t
new file mode 100644 (file)
index 0000000..885ef0f
--- /dev/null
@@ -0,0 +1,17 @@
+#!./perl
+
+# Matches regular expressions against strings with no terminating null
+# character.
+
+print("1..0 # Skip No XS::APItest under miniperl\n"), exit 0 if
+  !defined &DynaLoader::boot_DynaLoader;
+
+$no_null = 1;
+require XS::APItest;
+for $file ('./re/regexp.t', './t/re/regexp.t', ':re:regexp.t') {
+  if (-r $file) {
+    do $file or die $@;
+    exit;
+  }
+}
+die "Cannot find ./re/regexp.t or ./t/re/regexp.t\n";