"$int$frac" => [ $num_version, $pretty_version ];
}
+my $latest_dev_rev = 23;
+
+sub perl_is_supported {
+ my $v = "$_[0]";
+
+ return unless $v >= '5.010001';
+
+ if ($v =~ /^5\.([0-9]{2}[13579])/) {
+ return $1 >= $latest_dev_rev;
+ }
+
+ return 1;
+}
+
my %perls = map key_version($_),
- grep "$_" >= '5.010001',
+ grep perl_is_supported($_),
keys %Module::CoreList::released;
{
my %patched_chunks;
my %expected_chunks = (
'regcomp.c' => [
+ 'PERL_IN_XSUB_RE',
're_defs',
'COMP_NODE_HOOK',
'COMP_BEGIN_HOOK',
('COMP_NODE_HOOK') x 3,
],
'regexec.c' => [
- 're_defs',
+ 'PERL_IN_XSUB_RE+re_defs',
'EXEC_NODE_HOOK',
],
);
sub patch_regcomp {
my ($line, $file) = @_;
- if ($line =~ /#\s*include\s+"INTERN\.h"/) {
+ if ($line =~ /#\s*include\s+"perl\.h"/) {
+ push @{$patched_chunks{$file}}, 'PERL_IN_XSUB_RE';
+ return (
+ "#undef PERL_IN_XSUB_RE\n",
+ "#define PERL_IN_XSUB_RE 1\n",
+ $line,
+ "#undef PERL_IN_XSUB_RE\n",
+ );
+ } elsif ($line =~ /#\s*include\s+"INTERN\.h"/) {
push @{$patched_chunks{$file}}, 're_defs';
return "#include \"re_defs.h\"\n";
} elsif ($line =~ /^(\s*)RExC_rxi\s*=\s*ri\s*;\s*$/) {
my ($line, $file) = @_;
if ($line =~ /#\s*include\s+"perl\.h"/) {
- push @{$patched_chunks{$file}}, 're_defs';
- return $line, "#include \"re_defs.h\"\n";
+ push @{$patched_chunks{$file}}, 'PERL_IN_XSUB_RE+re_defs';
+ return (
+ "#undef PERL_IN_XSUB_RE\n",
+ "#define PERL_IN_XSUB_RE 1\n",
+ $line,
+ "#include \"re_defs.h\"\n",
+ "#undef PERL_IN_XSUB_RE\n",
+ );
} elsif ($line =~ /^\s*reenter_switch:\s*$/) {
push @{$patched_chunks{$file}}, 'EXEC_NODE_HOOK';
return "\tREH_CALL_EXEC_NODE_HOOK(rex, scan, reginfo, st);\n", $line;
}
my %manglers = (
- 'regcomp.c' => \&patch_regcomp,
- 'regexec.c' => \&patch_regexec,
+ 'dquote_static.c' => sub { $_[0] },
+ 'inline_invlist.c' => sub { $_[0] },
+ 'regcomp.c' => \&patch_regcomp,
+ 'regexec.c' => \&patch_regexec,
);
sub patch_source_file {
open my $out, '>', $dst or die "Can't open $dst for writing: $!";
while (defined(my $line = <$in>)) {
- print $out $mangler->($line, $dst);
+ my @lines = $mangler->($line, $dst);
+
+ for (@lines) {
+ s/\s*$/\n/; # Remove trailing whitespace
+ 1 while s/^( *)\t/$1 . (' ' x 8)/e; # Replace leading tabs by 8 spaces
+ s|^((?: )+) {0,3}([^ ])|(' ' x ((length $1) / 4)) . $2|e;
+ s/\t/ /g;
+ }
+
+ print $out @lines;
}
- my $patched_chunks = join ' ', @{$patched_chunks{$dst}};
- my $expected_chunks = join ' ', @{$expected_chunks{$file}};
+ my $patched_chunks = join ' ', @{$patched_chunks{$dst} || [ ]};
+ my $expected_chunks = join ' ', @{$expected_chunks{$file} || [ ]};
unless ($patched_chunks eq $expected_chunks) {
die "File $dst was not properly patched (got \"$patched_chunks\", expected \"$expected_chunks\")\n";
}