Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 81 lines (56 sloc) 1.989 kB
52a8cb1 @paultcochrane [codingstd] Added two tests which check for instances of the ascii to…
paultcochrane authored
1 #! perl
8ee1ad7 @allisonrandal [cage] Updating copyright in whole repository to Parrot Foundation.
allisonrandal authored
2 # Copyright (C) 2006-2009, Parrot Foundation.
52a8cb1 @paultcochrane [codingstd] Added two tests which check for instances of the ascii to…
paultcochrane authored
3
4 use strict;
5 use warnings;
6
7 use lib qw( . lib ../lib ../../lib );
8 use Test::More tests => 1;
9 use Parrot::Distribution;
10
11 =head1 NAME
12
13 t/codingstd/check_toxxx.t - checks that the toxxx() functions are passed
14 unsigned char
15
16 =head1 SYNOPSIS
17
18 # test all files
19 % prove t/codingstd/check_toxxx.t
20
21 # test specific files
22 % perl t/codingstd/check_toxxx.t src/foo.c include/parrot/bar.h
23
24 =head1 DESCRIPTION
25
26 Checks all C language files to make sure that arguments to the toxxx()
27 functions are explicitly cast to unsigned char.
28
29 =head1 SEE ALSO
30
31 L<docs/pdds/pdd07_codingstd.pod>
32
33 =cut
34
35 my $DIST = Parrot::Distribution->new;
617c34d @fperrad [t] glob arguments if any
fperrad authored
36 my @files = @ARGV ? <@ARGV> : $DIST->get_c_language_files();
52a8cb1 @paultcochrane [codingstd] Added two tests which check for instances of the ascii to…
paultcochrane authored
37 my @no_explicit_cast;
38 my $toxxx_functions = "toupper|tolower";
39
40 foreach my $file (@files) {
626f3c5 @paultcochrane [codingstd] Tidied code with perltidy
paultcochrane authored
41
52a8cb1 @paultcochrane [codingstd] Added two tests which check for instances of the ascii to…
paultcochrane authored
42 # if we have command line arguments, the file is the full path
43 # otherwise, use the relevant Parrot:: path method
44 my $path = @ARGV ? $file : $file->path;
45
626f3c5 @paultcochrane [codingstd] Tidied code with perltidy
paultcochrane authored
46 my $buf = $DIST->slurp($path);
52a8cb1 @paultcochrane [codingstd] Added two tests which check for instances of the ascii to…
paultcochrane authored
47
bc79de2 @paultcochrane [t] Tidied code with perltidy
paultcochrane authored
48 my @buffer_lines = split( /\n/, $buf );
52a8cb1 @paultcochrane [codingstd] Added two tests which check for instances of the ascii to…
paultcochrane authored
49
50 # find out if toxxx() functions appear in the file
51 my $num_toxxx = grep m/($toxxx_functions)\(/, @buffer_lines;
52
53 # if so, check if the args are cast to unsigned char
bc79de2 @paultcochrane [t] Tidied code with perltidy
paultcochrane authored
54 if ($num_toxxx) {
55
52a8cb1 @paultcochrane [codingstd] Added two tests which check for instances of the ascii to…
paultcochrane authored
56 # get the lines just matching toxxx
57 my @toxxx_lines = grep m/($toxxx_functions)\(/, @buffer_lines;
58
59 # find the instances without the explicit cast
60 my $num_no_cast = grep !m/($toxxx_functions)\(\(unsigned char\)/, @toxxx_lines;
61
9ce45c1 @paultcochrane [t/codingstd] Corrected calculation of number of failing files. Added a
paultcochrane authored
62 $path .= "\n";
63 push @no_explicit_cast, $path if $num_no_cast;
52a8cb1 @paultcochrane [codingstd] Added two tests which check for instances of the ascii to…
paultcochrane authored
64 }
65 else {
66 next;
67 }
68 }
69
70 ok( !scalar(@no_explicit_cast), 'toxxx() functions cast correctly' )
bc79de2 @paultcochrane [t] Tidied code with perltidy
paultcochrane authored
71 or diag( "toxxx() function not cast to unsigned char "
72 . scalar @no_explicit_cast
73 . " files:\n@no_explicit_cast" );
52a8cb1 @paultcochrane [codingstd] Added two tests which check for instances of the ascii to…
paultcochrane authored
74
75 # Local Variables:
76 # mode: cperl
77 # cperl-indent-level: 4
78 # fill-column: 100
79 # End:
80 # vim: expandtab shiftwidth=4:
Something went wrong with that request. Please try again.