1#! perl
2# Copyright (C) 2007-2015, Parrot Foundation.
3
4use strict;
5use warnings;
6use lib qw( . lib ../lib ../../lib );
7
8use Cwd;
9use File::Spec ();
10use Parrot::Distribution;
11use Test::More tests => 4;
12
13=head1 NAME
14
15t/codingstd/copyright.t - checks for an appropriate copyright
16statement in parrot source files
17
18=head1 SYNOPSIS
19
20    # test all files
21    % prove t/codingstd/copyright.t
22
23    # test years (very slow!)
24    % TEST_SLOW=1 perl t/codingstd/copyright.t
25
26    # test specific files
27    % perl t/codingstd/copyright.t src/foo.c include/parrot/bar.h
28
29=head1 DESCRIPTION
30
31Ensures that the copyright statement exists in each source file and that it
32is up to date.
33
34=head1 SEE ALSO
35
36L<docs/pdds/pdd07_codingstd.pod>
37
38=cut
39
40my $DIST = Parrot::Distribution->new;
41
42my @files = @ARGV ? <@ARGV> : (
43    $DIST->get_c_language_files(),
44    $DIST->get_perl_language_files(),
45    $DIST->get_make_language_files(),
46    $DIST->get_pir_language_files(),
47    $DIST->get_python_language_files(),
48    $DIST->pod_source_files(),
49);
50my (
51    @no_copyright_files,
52    @bad_format_copyright_files,
53    @wrong_date_copyright_files,
54    @duplicate_copyright_files,
55);
56
57my $copyright_simple =
58    qr/Copyright \(C\) \d{4}/i;
59my $copyright_parrot =
60    qr/Copyright \(C\) (?:(?:\d{4}\-)?\d{4},)+ Parrot Foundation\.\n/;
61diag 'Running very slow copyright year checks: >20 minutes' if $ENV{TEST_SLOW};
62
63foreach my $file (@files) {
64
65    # if we have command line arguments, the file is the full path
66    # otherwise, use the relevant Parrot:: path method
67    my $path = @ARGV ? $file : $file->path;
68
69    my $buf = $DIST->slurp($path);
70
71    # skip autogenerated files (based on the first line of the file)
72    next if ( index( $buf, "# THIS IS A GENERATED FILE! DO NOT EDIT!" ) == 0 );
73    # skip book chapters since they contain an extra README.pod
74    next if $path =~ m{docs/book/} and $path !~ m{README.pod$};
75    next if $path =~ m{t/tools/install/testlib/docs/};
76
77    # does there exist a copyright statement at all?
78    if ( $buf !~ $copyright_simple ) {
79        push @no_copyright_files, $path;
80        next;
81    }
82
83    if ( $buf =~ /$copyright_parrot/ and $ENV{TEST_SLOW}) {
84        my ($startyear, $endyear) = ($1, $2);
85        $startyear =~ s/-$// if $startyear;
86        $endyear = $startyear unless $endyear;
87        if ($path !~ m{(ext/|lib/Pod/).*\.pod$}) {
88            # see if they are up-to-date
89            my $g1 = `git log --reverse --format="%ai" "$path" | head -n 1`;
90            my $g2 = `git log -n 1 --format="%ai" "$path" | head -n 1`;
91            my ($y1) = $g1 =~ /^(\d\d\d\d)-/;
92            my ($y2) = $g2 =~ /^(\d\d\d\d)-/;
93            push @wrong_date_copyright_files, [ $path, $startyear, $endyear, $y1, $y2 ]
94              if ($startyear and $y1 and $y1 ne $startyear) or ($endyear and $y2 and $y2 ne $endyear);
95        }
96    }
97
98    # is the copyright text correct?
99    # If so, remove it...
100    if ( $buf !~ s/$copyright_parrot// and $path !~ m{(ext/|lib/Pod/).*\.pod$} ) {
101        push @bad_format_copyright_files, $path;
102    }
103    # ... and then see if any other copyright notices exist.
104    elsif ($buf =~ $copyright_simple and $path !~ /\.pod$/) {
105        push @duplicate_copyright_files, $path;
106    }
107}
108
109my $suggested_version=<<END_SUGGESTION;
110  Copyright (C) C<start-year>-C<last-year-modified>, Parrot Foundation.
111To find the C<start-year>, use a command such as:
112  git log C<filename> | grep '^Date' | tail -n 1
113To find the C<last-year-modified>, use a command such as:
114  git log C<filename> | grep '^Date' | head -n 1
115END_SUGGESTION
116
117# run the tests
118ok( !scalar(@no_copyright_files), 'Copyright statement exists' )
119  or diag(
120          join
121          $/ => "No copyright statement found in " . scalar @no_copyright_files . " files:",
122          @no_copyright_files,
123          "The copyright statement should read something like:",
124          $suggested_version
125         );
126
127ok( !scalar(@bad_format_copyright_files), 'Copyright statement in the right format' )
128  or diag(
129          join
130          $/ => "Bad format in copyright statement found in "
131          . scalar @bad_format_copyright_files
132          . " files:",
133          @bad_format_copyright_files,
134          "Update to read something like:",
135          $suggested_version
136         );
137if ($ENV{TEST_SLOW}) {
138    if (scalar(@wrong_date_copyright_files)) {
139        ok( 0, 'Copyright statement with the right years' );
140        diag(
141             join
142                  $/ => "Bad year in copyright statement found in "
143                  . scalar @wrong_date_copyright_files
144                  . " files: ");
145        diag( join $/ => map
146              {
147                  $_->[0].":\t(C) ".($_->[1] ? $_->[1]."-" : "").$_->[2]." -> ".$_->[3]."-".$_->[4]
148              } @wrong_date_copyright_files);
149    }
150    else {
151        ok( 1, 'Copyright statement with the right years' );
152    }
153}
154else {
155  SKIP: {
156    skip 'set TEST_SLOW to check for the right years', 1;
157  }
158}
159
160# Certain files contain the string 'Copyright (c)' more than once
161# because they contain heredocs for generated files, correctly cite the
162# copyright information for non-Parrot code, etc.  We shall exclude them
163# from our test for duplicate copyright statements.
164
165my @permitted_duplicate_copyright_files = (
166    {
167        file    => 'examples/c/test_main.c',
168        reason  => 'sample code',
169    },
170    {
171        file    => 'Configure.pl',
172        reason  => 'cite automake copyright statement',
173    },
174    {
175        file    => 'config/gen/opengl.pm',
176        reason  => 'heredoc text for generated file',
177    },
178    {
179        file    => 'lib/Parrot/Configure/Messages.pm',
180        reason  => 'heredoc for print_introduction()',
181    },
182    {
183        file    => 'lib/Parrot/Distribution.pm',
184        reason  => 'in pod for new()',
185    },
186    {
187        file    => 't/tools/dev/search_ops/samples.pm',
188        reason  => 'sample code used in testing',
189    },
190    {
191        file    => 'tools/build/vtable_extend.pl',
192        reason  => 'heredoc text for generated file',
193    },
194    {
195        file    => 'tools/dev/create_language.pl',
196        reason  => 'generated files in data section',
197    },
198    {
199        file    => 'tools/release/parrot_github_release.pl',
200        reason  => 'in --version ballot',
201    },
202    {
203        file    => 'examples/pir/quine_ord.pir',
204        reason  => 'quine',
205    },
206    {
207        file    => 'tools/dev/nci_thunk_gen.pir',
208        reason  => 'heredoc text for generated file',
209    },
210    {
211        file    => 'frontend/parrot/main.c',
212        reason  => 'Parrot_version() prints copyright notice ',
213    },
214    {
215        file    => 't/examples/streams.t',
216        reason  => 'heredoc-like text in test',
217    },
218    {
219        file    => 't/pmc/stringhandle.t',
220        reason  => 'text for generated test file',
221    },
222);
223my $cwd = cwd();
224my %permitted_duplicate_copyright_files =
225    map { ( File::Spec->catfile( $cwd, $_->{file} ) ) => 1 }
226        @permitted_duplicate_copyright_files;
227
228my @non_permitted_duplicate_copyright_files =
229    grep { ! $permitted_duplicate_copyright_files{ $_ } }
230        @duplicate_copyright_files;
231
232TODO: {
233    local $TODO = 'duplicate copyrights exist.';
234
235    ok( !scalar(@non_permitted_duplicate_copyright_files),
236        'Duplicate Copyright statements' )
237        or diag(
238        join
239            $/ => "Duplicate copyright statement found in "
240            . scalar @non_permitted_duplicate_copyright_files
241            . " files:",
242        @non_permitted_duplicate_copyright_files,
243        "Please get copyright assigned to Parrot Foundation",
244        "and remove alternate notice; or remove duplicated",
245        "notice for Parrot Foundation."
246        );
247}
248
249# Local Variables:
250#   mode: cperl
251#   cperl-indent-level: 4
252#   fill-column: 100
253# End:
254# vim: expandtab shiftwidth=4:
255