#!/usr/bin/env perl use strict; use warnings; use Capture::Tiny ':all'; use File::Slurper 'read_lines'; use Regexp::Parsertron; # Warning: Can't use Test2 or Test::Stream because of the '#' in the regexps. use Test::More; use Try::Tiny; # ------------------------------------------------ # The input file is generated by scripts/extract.errors.pl. my($input_file) = "xt/author/re_tests"; my(@lines) = read_lines($input_file); my($parser) = Regexp::Parsertron -> new; my($count) = 0; my($expectation); my(@fields); my($got); my($message); my($perl_error); my($re, $result, @result); my($stdout, $stderr); my($test); for my $line (@lines) { $line =~ s/^\s+//; $line =~ s/\s+$//; next if ( ($line eq '') || ($line =~ /^#/) || ($line =~ /^__END__/) ); @fields = split(/\t/, $line); $test = $fields[0]; $expectation = $fields[2]; # See xt/author/regexp.txt. if ($expectation !~ /[yn]/) { ok(1, "Error expected. Skipping $test"); } # Count all tests, not just successful ones. # This makes it easier to work on the scripts when it's in xt/authors/, # since then the prints and says below can be activated. $stderr = ''; # The try is for when Perl throws an error on a regexp syntax error. # The capture is for when Perl prints a warning to stderr. Eg: /a{4,1}/ because 4 > 1. try { ($stdout, $stderr) = capture { $re = qr/$test/; }; } catch { $stderr = $_; }; if ($stderr) { # This line is 'print', not 'say'! #print "Count: $count. Perl error: " . $stderr; next; } try { # Return 0 for success and 1 for failure. $result = $parser -> parse(re => $re); if ($result == 0) # Success. { $count++; $got = $parser -> as_string; $message = "Count: $count: re: $re. got: $got"; is_deeply($got, "$re", $message); } else { #print "Count: $count. ", $parser -> warning_str, "\n"; } } catch { # This line is 'print', not 'say'! #print "Count: $count: Error in $test: $_" if (defined); }; # Reset for next test. $parser -> reset; } print "# Internal test count: $count\n"; done_testing;