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