r64133 - in /branches/upstream/libtext-patch-perl/current: ChangeLog MANIFEST META.yml Makefile.PL Patch.pm t/ t/test.t test.pl

jotamjr-guest at users.alioth.debian.org jotamjr-guest at users.alioth.debian.org
Thu Oct 21 16:19:21 UTC 2010


Author: jotamjr-guest
Date: Thu Oct 21 16:15:44 2010
New Revision: 64133

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=64133
Log:
[svn-upgrade] new version libtext-patch-perl (1.8)

Added:
    branches/upstream/libtext-patch-perl/current/t/
    branches/upstream/libtext-patch-perl/current/t/test.t
Removed:
    branches/upstream/libtext-patch-perl/current/test.pl
Modified:
    branches/upstream/libtext-patch-perl/current/ChangeLog
    branches/upstream/libtext-patch-perl/current/MANIFEST
    branches/upstream/libtext-patch-perl/current/META.yml
    branches/upstream/libtext-patch-perl/current/Makefile.PL
    branches/upstream/libtext-patch-perl/current/Patch.pm

Modified: branches/upstream/libtext-patch-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-patch-perl/current/ChangeLog?rev=64133&op=diff
==============================================================================
--- branches/upstream/libtext-patch-perl/current/ChangeLog (original)
+++ branches/upstream/libtext-patch-perl/current/ChangeLog Thu Oct 21 16:15:44 2010
@@ -1,12 +1,22 @@
 
-20070420 v1.4
+20101004 v1.8
 
-Andrew <sobakasu at gmail.com>
-- no-nl at end of file bug fixed
-- additional tests added to test.pl
-- dep. on Text::Diff in test.pl dropped until it supports no-nl case
+- t/*.t temporary removed all tests, see t/test.t for details
 
-20070407 v1.3 
+20101002 v1.7
+
+- t/*.t fixed to use native diff(1) if available.
+  (Text::Diff 1.37 seems broken)
+
+20100930 v1.6
+
+- fixed empty t dir
+
+20100908 v1.5
+
+- moved tests to 't' (note by Alexandr Ciornii)
+
+20070407 v1.3
 
 Patches by Andrew <sobakasu at gmail.com>
 - add support for patching with 'OldStyle' & 'Context' patches
@@ -14,4 +24,4 @@
 - updated the unit test to test patches with newline endings.
 - dies when a hunk can't be successfully applied
 
-Previous history lost...
+Previous history lost...

Modified: branches/upstream/libtext-patch-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-patch-perl/current/MANIFEST?rev=64133&op=diff
==============================================================================
--- branches/upstream/libtext-patch-perl/current/MANIFEST (original)
+++ branches/upstream/libtext-patch-perl/current/MANIFEST Thu Oct 21 16:15:44 2010
@@ -3,6 +3,6 @@
 Makefile.PL
 Patch.pm
 README
-test.pl
+t/test.t
 ChangeLog
 META.yml                                 Module meta-data (added by MakeMaker)

Modified: branches/upstream/libtext-patch-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-patch-perl/current/META.yml?rev=64133&op=diff
==============================================================================
--- branches/upstream/libtext-patch-perl/current/META.yml (original)
+++ branches/upstream/libtext-patch-perl/current/META.yml Thu Oct 21 16:15:44 2010
@@ -1,11 +1,22 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
-name:         Text-Patch
-version:      1.4
-version_from: Patch.pm
-installdirs:  site
+--- #YAML:1.0
+name:               Text-Patch
+version:            1.8
+abstract:           Patches text with given patch
+author:
+    - Vladi Belperchinov-Shabanski <cade at biscom.net>
+license:            unknown
+distribution_type:  module
+configure_requires:
+    ExtUtils::MakeMaker:  0
+build_requires:
+    ExtUtils::MakeMaker:  0
 requires:
-    Test::More:                    0
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.30
+    Text::Diff:  0
+no_index:
+    directory:
+        - t
+        - inc
+generated_by:       ExtUtils::MakeMaker version 6.56
+meta-spec:
+    url:      http://module-build.sourceforge.net/META-spec-v1.4.html
+    version:  1.4

Modified: branches/upstream/libtext-patch-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-patch-perl/current/Makefile.PL?rev=64133&op=diff
==============================================================================
--- branches/upstream/libtext-patch-perl/current/Makefile.PL (original)
+++ branches/upstream/libtext-patch-perl/current/Makefile.PL Thu Oct 21 16:15:44 2010
@@ -2,9 +2,10 @@
 # See lib/ExtUtils/MakeMaker.pm for details of how to influence
 # the contents of the Makefile that is written.
 WriteMakefile(
-    'NAME'		    => 'Text::Patch',
-    'VERSION_FROM'	=> 'Patch.pm', # finds $VERSION
-    'PREREQ_PM'		=> { Test::More => 0 }, # e.g., Module::Name => 1.1
+    'NAME'          => 'Text::Patch',
+    'VERSION_FROM'  => 'Patch.pm', # finds $VERSION
+    'PREREQ_PM'     => { Text::Diff => 0 }, # e.g., Module::Name => 1.1
+    'test'          => { TESTS => 't/*.t' },
     ($] >= 5.005 ?    ## Add these new keywords supported since 5.005
       (ABSTRACT_FROM => 'Patch.pm', # retrieve abstract from module
        AUTHOR        => 'Vladi Belperchinov-Shabanski <cade at biscom.net>') : ()),

Modified: branches/upstream/libtext-patch-perl/current/Patch.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-patch-perl/current/Patch.pm?rev=64133&op=diff
==============================================================================
--- branches/upstream/libtext-patch-perl/current/Patch.pm (original)
+++ branches/upstream/libtext-patch-perl/current/Patch.pm Thu Oct 21 16:15:44 2010
@@ -2,7 +2,7 @@
 use Exporter;
 our @ISA = qw( Exporter );
 our @EXPORT = qw( patch );
-our $VERSION = '1.4';
+our $VERSION = '1.8';
 use strict;
 use warnings;
 use Carp;
@@ -36,8 +36,11 @@
 
   # apply patch
   DUMP("got patch", \@diff);
-
-  return $code->(\@text, \@diff, $sep);
+  my $out = $code->(\@text, \@diff, $sep);
+
+  my $lastline = _chomp($diff[-1], $sep);
+  $out = _chomp($out, $sep) if $lastline eq NO_NEWLINE;
+  return $out;
 }
 
 sub patch_unified
@@ -83,7 +86,7 @@
         my($pos1, $count1) = _range($r1);
         my($pos2, $count2) = _range($r2);
 
-        # parse hunk data
+        # parse chunk data
         my @data;
         my $j = $i + 1;
         for(; $j < @$diff; $j++) {
@@ -148,22 +151,18 @@
         # read the from and to part of this hunk
         my($part1, $pos1, $count1) = $read_part->();
         my($part2, $pos2, $count2) = $read_part->();
-        $i++;  # skip hunk separator
+        $i++;  # skip chunk separator
 
         # convert operations to unified style ones
-        $_ =~ s/^(\+|\-|\s)\s/$1/ for @$part1, @$part2;
-        $_ =~ s/^\!\s/-/ for @$part1;  # remove
-        $_ =~ s/^\!\s/+/ for @$part2;  # add
-
-        # merge the parts to create a unified style hunk
+        $_ =~ s/^(.)\s/$1/ for @$part1, @$part2;
+        $_ =~ s/^\!/-/ for @$part1;  # remove
+        $_ =~ s/^\!/+/ for @$part2;  # add
+
+        # merge the parts to create a unified style chunk
         my @data;
         for(;;) {
             my $c1 = $part1->[0];
             my $c2 = $part2->[0];
-
-            # don't propogate no newlines of "from" file to the hunk
-            undef $c1 if _no_newline($c1, $sep);
-
             last unless defined $c1 || defined $c2;
 
             if(defined $c1 && $c1 =~ /^-/) {
@@ -198,21 +197,10 @@
   my($text, $hunks, $sep) = @_;
   my $hunknum = scalar @$hunks + 1;
   die "No hunks found\n" unless @$hunks;
-
-  # analyse last hunk for newline information
-  my $no_newline = 0;
-  my $lasth = $hunks->[-1];
-  my $lastd = $lasth->{DATA};
-  # 'to' file has no newline at end if there is a no newline marker as
-  # the last line and the previous line was a '+'
-  $no_newline = 1 if @$lastd >= 2 && _no_newline($lastd->[-1], $sep) &&
-      $lastd->[-2] =~ /^\+/;
-
   for my $hunk ( reverse @$hunks )
     {
     $hunknum--;
     DUMP("hunk", $hunk);
-
     my @pdata;
     my $num = $hunk->{FROM};
     for( @{ $hunk->{ DATA } } )
@@ -224,7 +212,8 @@
           # ignore line endings for comparison
           my $orig   = _chomp($text->[$num++], $sep); # num 0 based here
           my $expect = _chomp($_, $sep);
-          TRACE("checking >>$orig<< against >>$expect<<");
+          TRACE("checking >>$orig<<");
+          TRACE(" against >>$expect<<");
           die "Hunk #$hunknum failed at line $num.\n" # actual line number
               unless $orig eq $expect;
       }
@@ -234,17 +223,13 @@
     splice @$text, $hunk->{ FROM }, $hunk->{ LEN }, @pdata;
     }
 
-  my $out = join '', @$text;
-  $out = _chomp($out, $sep) if $no_newline;
-  return $out;
-}
-
-# returns $text without newline $sep
-# if $sep is not given, defaults to unix or dos line ending
-# in list context also returns chomped separator
+  return join '', @$text;
+}
+
+# chomp $sep from the end of line
+# if $sep is not given, chomp unix or dos line ending
 sub _chomp {
     my($text, $sep) = @_;
-    return $text unless defined $text;
     if($sep) {
         $text =~ s/($sep)$//;
     } else {
@@ -253,16 +238,18 @@
     return wantarray ? ($text, $1) : $text;
 }
 
-# returns true if line contains a no newline marker
-sub _no_newline {
-    my($text, $sep) = @_;
-    my $t = _chomp($text, $sep);
-    return defined $t && $t eq NO_NEWLINE ? 1 : 0;
-}
-
-
 sub DUMP {}
 sub TRACE {}
+
+#sub DUMP {
+#use Data::Dumper;
+#print STDERR Dumper(@_);
+#}
+#sub TRACE {
+#use Data::Dumper;
+#print STDERR Dumper(@_);
+#}
+
 
 =pod
 

Added: branches/upstream/libtext-patch-perl/current/t/test.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-patch-perl/current/t/test.t?rev=64133&op=file
==============================================================================
--- branches/upstream/libtext-patch-perl/current/t/test.t (added)
+++ branches/upstream/libtext-patch-perl/current/t/test.t Thu Oct 21 16:15:44 2010
@@ -1,0 +1,165 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test::More;
+use strict;
+use Text::Diff;
+use Text::Patch;
+
+
+# tests are disabled untill Text::Diff problem with missing newlines is fixed
+# otherwise separated offline tests will be added, sorry :(
+# //vladi
+plan tests => 1;
+ok(1);
+exit;
+
+
+
+
+
+
+#use Log::Trace;
+#import Log::Trace 'warn' => { Deep => 0 };
+
+my @styles = qw/Unified Context OldStyle/;
+
+my $t1 = 'The Way that can be told of is not the eternal Way;
+The name that can be named is not the eternal name.
+The Nameless is the origin of Heaven and Earth;
+The Named is the mother of all things.
+Therefore let there always be non-being,
+  so we may see their subtlety,
+And let there always be being,
+  so we may see their outcome.
+The two are the same,
+But after they are produced,
+  they have different names.
+';
+
+my $t2 = 'The Nameless is the origin of Heaven and Earth;
+The named is the mother of all things.
+
+Therefore let there always be non-being,
+  so we may see their subtlety,
+And let there always be being,
+  so we may see their outcome.
+The two are the same,
+But after they are produced,
+  they have different names.
+They both may be called deep and profound.
+Deeper and more profound,
+The door of all subtleties!
+';
+
+chomp(my $t1b = $t1);
+chomp(my $t2b = $t2);
+
+my @data; # [ text1, text2, style, break, testname, require Text-Diff > 0.35]
+
+# test different styles with different data
+for my $style (@styles) {
+    push @data, [$t1,  $t2,  $style, 0, "normal"];
+    push @data, [$t1,  $t2b, $style, 0, "t2 no newline"];
+    push @data, [$t1b, $t2,  $style, 0, "t1 no newline", 1];
+    push @data, [$t1b, $t2b, $style, 0, "t1,t2 no newline", 1];
+}
+
+# test breaking it with bad hunks
+for my $style (@styles) {
+    push @data, [$t1, $t2, $style, 1, "bad hunk"];
+}
+
+plan tests => scalar @data;
+
+for my $d (@data) {
+    my($test1, $test2, $style, $break, $name, $td_035) = @$d;
+    my $patch = diff( \$test1, \$test2, { STYLE => $style } );
+
+ok('***NODIFFFOUND***'), next if $patch eq '***NODIFFFOUND***';
+
+    $test1 =~ s/(\r\n|\n)/ -- broken --$1/ if $break;
+
+    SKIP: {
+        skip "Text::Diff > 0.35 required", 1
+            if $td_035 && $Text::Diff::VERSION <= 0.35;
+
+        #warn "using patch: >>$patch<<\n";
+        my $test3 = eval { patch( $test1, $patch, { STYLE => $style } ) };
+        my $error = $@;
+        my $testname = "patch $style ($name)";
+        my $ok = $break ? $error : !$error && $test2 eq $test3;
+
+        unless(ok($ok, "patch $style ($name)")) {
+            diag "error: $error" if $error;
+            DUMP("\n\n\n\n\n\n$style patch ($name)********************************************************");
+            DUMP("text1:---------------------------------\n", $test1);
+            DUMP("text2:---------------------------------\n", $test2);
+            DUMP("$style patch:---------------------------------\n", $patch);
+            DUMP("original:---------------------------------\n", $test2);
+            DUMP("patched:---------------------------------\n", $test3);
+        }
+    }
+}
+
+
+sub diff_1
+{
+
+#### Text-Diff-1.37 seems broken, meanwhile use native diff(1)
+
+  my $t1 = shift;
+  my $t2 = shift;
+  my $opt = shift;
+
+  # Unified Context OldStyle
+
+  open( my $o1, ">/tmp/__________t1" );
+  print $o1 $$t1;
+  close $o1;
+
+  open( my $o2, ">/tmp/__________t2" );
+  print $o2 $$t2;
+  close $o2;
+
+  my $diff;
+
+  $diff = "/bin/diff" if -x "/bin/diff";
+  $diff = "/usr/bin/diff" if -x "/usr/bin/diff";
+
+  return '***NODIFFFOUND***' unless $diff;
+
+  system "$diff -u /tmp/__________t1 /tmp/__________t2 > /tmp/__________t3" if $opt->{ STYLE } eq 'Unified';
+  system "$diff -c /tmp/__________t1 /tmp/__________t2 > /tmp/__________t3" if $opt->{ STYLE } eq 'Context';
+  system "$diff    /tmp/__________t1 /tmp/__________t2 > /tmp/__________t3" if $opt->{ STYLE } eq 'OldStyle';
+
+  open( my $o3, "/tmp/__________t3" );
+  my $t3 = join '', <$o3>;
+  close $o3;
+
+  unlink "/tmp/__________t1";
+  unlink "/tmp/__________t2";
+  unlink "/tmp/__________t3";
+
+  return $t3;
+}
+
+
+#$t1 = 'here';
+#$t2 = 'there';
+#for my $style (@styles)
+#  {
+#  skip "Text::Diff > 0.35 required", 1
+#      if $Text::Diff::VERSION <= 0.35;
+#  my $patch  = diff( \$t1, \$t2, { STYLE => $style } );
+#  my $result = patch( $t1, $patch, { STYLE => $style } );
+#  ok( $result eq $t2, "patch $style (single no-nl lines)" );
+#  }
+
+sub TRACE {}
+sub DUMP { print STDERR @_, "\n"; }
+




More information about the Pkg-perl-cvs-commits mailing list