[libconfig-model-dpkg-perl] 05/11: Scanner::__squash_copyrights_years: also handle last entry of $copyrights_by_id...

dod at debian.org dod at debian.org
Fri Jul 3 19:20:13 UTC 2015


This is an automated email from the git hooks/post-receive script.

dod pushed a commit to branch master
in repository libconfig-model-dpkg-perl.

commit 6517580f3a08b101ec9e06beabdc818c08baa02f
Author: Dominique Dumont <dod at debian.org>
Date:   Thu Jul 2 13:51:19 2015 +0200

    Scanner::__squash_copyrights_years: also handle last entry of $copyrights_by_id...
    
    ... fixed the rookie mistake: test with index < size of list
    and not index < last_index...
    
    Added test to check that
---
 lib/Dpkg/Copyright/Scanner.pm      |  9 ++---
 t/scanner/squash_copyright_years.t | 67 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 72 insertions(+), 4 deletions(-)

diff --git a/lib/Dpkg/Copyright/Scanner.pm b/lib/Dpkg/Copyright/Scanner.pm
index 7d4ebee..20d3191 100644
--- a/lib/Dpkg/Copyright/Scanner.pm
+++ b/lib/Dpkg/Copyright/Scanner.pm
@@ -256,7 +256,7 @@ sub __pack_dir ($h, $pack, @path) {
 sub __squash_copyrights_years ($copyrights_by_id) {
 
     my %id_year_by_same_owner_license;
-    for (my $id = 0; $id < $#$copyrights_by_id; $id++ ) {
+    for (my $id = 0; $id <= $copyrights_by_id->$#* ; $id++ ) {
         my ($c,$l) = $copyrights_by_id->[$id]->@* ;
         #say "id $id: c $c l $l";
         my @owners ;
@@ -287,9 +287,10 @@ sub __squash_copyrights_years ($copyrights_by_id) {
         next unless @squashed_c ; # give up this entry when problem
 
         # store (c) info with coalesced years in new item of $copyrights_by_id
-        my $new_id = @$copyrights_by_id ;
-        $copyrights_by_id->[$new_id] = [ join("\n ", at squashed_c), $l ];
-
+        my $new_id = $copyrights_by_id->@* ;
+        my $new_cop = join("\n ", at squashed_c) ;
+        $copyrights_by_id->[$new_id] = [ $new_cop , $l ];
+        #say "created id $new_id with c $new_cop l $l";
         # fill the swap table entry-id -> coaslesces entry-id
         foreach my $id ( map { $_->[0]} @entries) {
             $merged_c_info[$id] = $new_id;
diff --git a/t/scanner/squash_copyright_years.t b/t/scanner/squash_copyright_years.t
new file mode 100644
index 0000000..c66df64
--- /dev/null
+++ b/t/scanner/squash_copyright_years.t
@@ -0,0 +1,67 @@
+# -*- cperl -*-
+use strict;
+use warnings;
+use 5.010;
+
+use Test::More;   # see done_testing()
+use Test::Differences;
+use YAML::Tiny;
+
+use feature qw/postderef signatures/;
+no warnings qw/experimental::postderef experimental::signatures/;
+
+require_ok( 'Dpkg::Copyright::Scanner' );
+
+
+# __pack_copyright tests
+my @tests = (
+    [
+        'dir with squashable copyright',
+        q!---
+-
+  - '2007-2011, Daniel Adler <dadler at uni-goettingen.de>'
+  - ISC
+-
+  - '2007-2015, Daniel Adler <dadler at uni-goettingen.de>'
+  - ISC
+-
+  - '2013, Daniel Adler <dadler at uni-goettingen.de>'
+  - ISC
+-
+  - '2015, Daniel Adler <dadler at uni-goettingen.de>'
+  - ISC
+-
+  - '2014, 2015, Masanori Mitsugi <mitsugi at linux.vnet.ibm.com>'
+  - ISC
+-
+  - '2013-2015, Daniel Adler <dadler at uni-goettingen.de>'
+  - ISC
+...
+!,
+        [6,6,6,6,undef,6],
+        [ [ '2007-2015, Daniel Adler <dadler at uni-goettingen.de>', 'ISC'] ]
+    ]
+);
+
+foreach my $t (@tests) {
+    my ($label,$in,$expected_indexes, $expected_additions) = @$t;
+    my $a = Load($in);
+    my $info = Dpkg::Copyright::Scanner::__squash_copyrights_years($a);
+    eq_or_diff(
+        $info,
+        ref($expected_indexes) ? $expected_indexes : Load($expected_indexes),
+        "__squash_copyrights_years $label"
+    );
+
+    # check coaslesced entries
+    my $input = Load($in);
+    my @new_indexes = $a->@[ scalar $input->@* .. $a->$#* ] ;
+    eq_or_diff(
+        \@new_indexes,
+        $expected_additions,
+        "__squash_copyrights_years $label checked new copyright entries"
+    )
+}
+
+
+done_testing();

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libconfig-model-dpkg-perl.git



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