This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In bisect-runner.pl, fall back to context diffs for ancient patch binaries.
authorNicholas Clark <nick@ccl4.org>
Fri, 25 Nov 2011 09:58:16 +0000 (10:58 +0100)
committerNicholas Clark <nick@ccl4.org>
Fri, 25 Nov 2011 09:58:16 +0000 (10:58 +0100)
AIX supplies a pre-historic patch program, which certainly predates Linux
and is probably older than NT. It can't cope with unified diffs. Meanwhile,
it's hard enough to get git diff to output context diffs, let alone git show,
and nearly all the patches embedded here are unified. So it seems that the
path of least resistance is to convert unified diffs to context diffs.

Porting/bisect-runner.pl

index a1e5a02..d8d7948 100755 (executable)
@@ -530,6 +530,139 @@ sub edit_file {
     close_or_die($fh);
 }
 
+# AIX supplies a pre-historic patch program, which certainly predates Linux
+# and is probably older than NT. It can't cope with unified diffs. Meanwhile,
+# it's hard enough to get git diff to output context diffs, let alone git show,
+# and nearly all the patches embedded here are unified. So it seems that the
+# path of least resistance is to convert unified diffs to context diffs:
+
+sub process_hunk {
+    my ($from_out, $to_out, $has_from, $has_to, $delete, $add) = @_;
+    ++$$has_from if $delete;
+    ++$$has_to if $add;
+
+    if ($delete && $add) {
+        $$from_out .= "! $_\n" foreach @$delete;
+        $$to_out .= "! $_\n" foreach @$add;
+    } elsif ($delete) {
+        $$from_out .= "- $_\n" foreach @$delete;
+    } elsif ($add) {
+         $$to_out .= "+ $_\n" foreach @$add;
+    }
+}
+
+# This isn't quite general purpose, as it can't cope with
+# '\ No newline at end of file'
+sub ud2cd {
+    my $diff_in = shift;
+    my $diff_out = '';
+
+    # Stuff before the diff
+    while ($diff_in =~ s/\A(?!\*\*\* )(?!--- )([^\n]*\n?)//ms && length $1) {
+        $diff_out .= $1;
+    }
+
+    if (!length $diff_in) {
+        die "That didn't seem to be a diff";
+    }
+
+    if ($diff_in =~ /\A\*\*\* /ms) {
+        warn "Seems to be a context diff already\n";
+        return $diff_out . $diff_in;
+    }
+
+    # Loop for files
+ FILE: while (1) {
+        if ($diff_in =~ s/\A((?:diff |index )[^\n]+\n)//ms) {
+            $diff_out .= $1;
+            next;
+        }
+        if ($diff_in !~ /\A--- /ms) {
+            # Stuff after the diff;
+            return $diff_out . $diff_in;
+        }
+        $diff_in =~ s/\A([^\n]+\n?)//ms;
+        my $line = $1;
+        die "Can't parse '$line'" unless $line =~ s/\A--- /*** /ms;
+        $diff_out .= $line;
+        $diff_in =~ s/\A([^\n]+\n?)//ms;
+        $line = $1;
+        die "Can't parse '$line'" unless $line =~ s/\A\+\+\+ /--- /ms;
+        $diff_out .= $line;
+
+        # Loop for hunks
+        while (1) {
+            next FILE
+                unless $diff_in =~ s/\A\@\@ (-([0-9]+),([0-9]+) \+([0-9]+),([0-9]+)) \@\@[^\n]*\n?//;
+            my ($hunk, $from_start, $from_count, $to_start, $to_count)
+                = ($1, $2, $3, $4, $5);
+            my $from_end = $from_start + $from_count - 1;
+            my $to_end = $to_start + $to_count - 1;
+            my ($from_out, $to_out, $has_from, $has_to, $add, $delete);
+            while (length $diff_in && ($from_count || $to_count)) {
+                die "Confused in $hunk" unless $diff_in =~ s/\A([^\n]*)\n//ms;
+                my $line = $1;
+                $line = ' ' unless length $line;
+                if ($line =~ /^ .*/) {
+                    process_hunk(\$from_out, \$to_out, \$has_from, \$has_to,
+                                 $delete, $add);
+                    undef $delete;
+                    undef $add;
+                    $from_out .= " $line\n";
+                    $to_out .= " $line\n";
+                    --$from_count;
+                    --$to_count;
+                } elsif ($line =~ /^-(.*)/) {
+                    push @$delete, $1;
+                    --$from_count;
+                } elsif ($line =~ /^\+(.*)/) {
+                    push @$add, $1;
+                    --$to_count;
+                } else {
+                    die "Can't parse '$line' as part of hunk $hunk";
+                }
+            }
+            process_hunk(\$from_out, \$to_out, \$has_from, \$has_to,
+                         $delete, $add);
+            die "No lines in hunk $hunk"
+                unless length $from_out || length $to_out;
+            die "No changes in hunk $hunk"
+                unless $has_from || $has_to;
+            $diff_out .= "***************\n";
+            $diff_out .= "*** $from_start,$from_end ****\n";
+            $diff_out .= $from_out if $has_from;
+            $diff_out .= "--- $to_start,$to_end ----\n";
+            $diff_out .= $to_out if $has_to;
+        }
+    }
+}
+
+{
+    my $use_context;
+
+    sub placate_patch_prog {
+        my $patch = shift;
+
+        if (!defined $use_context) {
+            my $version = `patch -v 2>&1`;
+            die "Can't run `patch -v`, \$?=$?, bailing out"
+                unless defined $version;
+            if ($version =~ /Free Software Foundation/) {
+                $use_context = 0;
+            } elsif ($version =~ /Header: patch\.c,v.*\blwall\b/) {
+                # The system patch is older than Linux, and probably older than
+                # Windows NT.
+                $use_context = 1;
+            } else {
+                # Don't know.
+                $use_context = 0;
+            }
+        }
+
+        return $use_context ? ud2cd($patch) : $patch;
+    }
+}
+
 sub apply_patch {
     my ($patch, $what, $files) = @_;
     $what = 'patch' unless defined $what;
@@ -537,10 +670,12 @@ sub apply_patch {
         $patch =~ m!^--- a/(\S+)\n\+\+\+ b/\1!sm;
         $files = " $1";
     }
+    my $patch_to_use = placate_patch_prog($patch);
     open my $fh, '|-', 'patch', '-p1' or die "Can't run patch: $!";
-    print $fh $patch;
+    print $fh $patch_to_use;
     return if close $fh;
     print STDERR "Patch is <<'EOPATCH'\n${patch}EOPATCH\n";
+    print STDERR "\nConverted to a context diff <<'EOCONTEXT'\n${patch_to_use}EOCONTEXT\n";
     die "Can't $what$files: $?, $!";
 }