perl.cvs.parrot
[Top] [All Lists]

[svn:parrot] r20096 - trunk/t/codingstd

Subject: [svn:parrot] r20096 - trunk/t/codingstd
From:
Date: Sun, 22 Jul 2007 02:07:45 -0700 PDT
Newsgroups: perl.cvs.parrot

Author: paultcochrane
Date: Sun Jul 22 02:07:44 2007
New Revision: 20096

Added:
   trunk/t/codingstd/check_isxxx.t   (contents, props changed)
   trunk/t/codingstd/check_toxxx.t   (contents, props changed)

Log:
[codingstd] Added two tests which check for instances of the ascii toxxx()
and isxxx() functions and makes sure that their argument is explicitly cast
to unsigned arg as per RT#40865.  I think adding them to the coding
standards test suite is the best option.  In some sense they are more cage
tests but this seems the best place at present.


Added: trunk/t/codingstd/check_isxxx.t
==============================================================================
--- (empty file)
+++ trunk/t/codingstd/check_isxxx.t     Sun Jul 22 02:07:44 2007
@@ -0,0 +1,97 @@
+#! perl
+# Copyright (C) 2006-2007, The Perl Foundation.
+# $Id$
+
+use strict;
+use warnings;
+
+use lib qw( . lib ../lib ../../lib );
+use Test::More tests => 1;
+use Parrot::Distribution;
+
+=head1 NAME
+
+t/codingstd/check_isxxx.t - checks that the isxxx() functions are passed
+unsigned char
+
+=head1 SYNOPSIS
+
+    # test all files
+    % prove t/codingstd/check_isxxx.t
+
+    # test specific files
+    % perl t/codingstd/check_isxxx.t src/foo.c include/parrot/bar.h
+
+=head1 DESCRIPTION
+
+Checks all C language files to make sure that arguments to the isxxx()
+functions are explicitly cast to unsigned char.
+
+=head1 SEE ALSO
+
+L<docs/pdds/pdd07_codingstd.pod>
+
+=cut
+
+my $DIST = Parrot::Distribution->new;
+my @files = @ARGV ? @ARGV : $DIST->get_c_language_files();
+my @no_explicit_cast;
+my @isxxx_functions_list = qw(
+    isalnum
+    isalpha
+    isblank
+    iscntrl
+    isdigit
+    isgraph
+    islower
+    isprint
+    ispunct
+    isspace
+    isupper
+    );
+my $isxxx_functions = join '|', @isxxx_functions_list;
+
+foreach my $file (@files) {
+    my $buf;
+
+    # if we have command line arguments, the file is the full path
+    # otherwise, use the relevant Parrot:: path method
+    my $path = @ARGV ? $file : $file->path;
+
+    # slurp in the file
+    open( my $fh, '<', $path )
+        or die "Cannot open '$path' for reading: $!\n";
+    {
+        local $/;
+        $buf = <$fh>;
+    }
+
+    my @buffer_lines = split(/\n/, $buf);
+
+    # find out if isxxx() functions appear in the file
+    my $num_isxxx = grep m/[^_]($isxxx_functions)\(/, @buffer_lines;
+
+    # if so, check if the args are cast to unsigned char
+    if ( $num_isxxx ) {
+        # get the lines just matching isxxx
+        my @isxxx_lines = grep m/[^_]($isxxx_functions)\(/, @buffer_lines;
+
+        # find the instances without the explicit cast
+        my $num_no_cast = grep !m/[^_]($isxxx_functions)\(\(unsigned char\)/, 
@isxxx_lines;
+
+        push @no_explicit_cast, $path, "\n" if $num_no_cast;
+    }
+    else {
+        next;
+    }
+}
+
+ok( !scalar(@no_explicit_cast), 'isxxx() functions cast correctly' )
+    or diag( "isxxx() function incorrectly cast in " . scalar 
@no_explicit_cast . " files:\n@no_explicit_cast" );
+
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:

Added: trunk/t/codingstd/check_toxxx.t
==============================================================================
--- (empty file)
+++ trunk/t/codingstd/check_toxxx.t     Sun Jul 22 02:07:44 2007
@@ -0,0 +1,84 @@
+#! perl
+# Copyright (C) 2006-2007, The Perl Foundation.
+# $Id$
+
+use strict;
+use warnings;
+
+use lib qw( . lib ../lib ../../lib );
+use Test::More tests => 1;
+use Parrot::Distribution;
+
+=head1 NAME
+
+t/codingstd/check_toxxx.t - checks that the toxxx() functions are passed
+unsigned char
+
+=head1 SYNOPSIS
+
+    # test all files
+    % prove t/codingstd/check_toxxx.t
+
+    # test specific files
+    % perl t/codingstd/check_toxxx.t src/foo.c include/parrot/bar.h
+
+=head1 DESCRIPTION
+
+Checks all C language files to make sure that arguments to the toxxx()
+functions are explicitly cast to unsigned char.
+
+=head1 SEE ALSO
+
+L<docs/pdds/pdd07_codingstd.pod>
+
+=cut
+
+my $DIST = Parrot::Distribution->new;
+my @files = @ARGV ? @ARGV : $DIST->get_c_language_files();
+my @no_explicit_cast;
+my $toxxx_functions = "toupper|tolower";
+
+foreach my $file (@files) {
+    my $buf;
+
+    # if we have command line arguments, the file is the full path
+    # otherwise, use the relevant Parrot:: path method
+    my $path = @ARGV ? $file : $file->path;
+
+    # slurp in the file
+    open( my $fh, '<', $path )
+        or die "Cannot open '$path' for reading: $!\n";
+    {
+        local $/;
+        $buf = <$fh>;
+    }
+
+    my @buffer_lines = split(/\n/, $buf);
+
+    # find out if toxxx() functions appear in the file
+    my $num_toxxx = grep m/($toxxx_functions)\(/, @buffer_lines;
+
+    # if so, check if the args are cast to unsigned char
+    if ( $num_toxxx ) {
+        # get the lines just matching toxxx
+        my @toxxx_lines = grep m/($toxxx_functions)\(/, @buffer_lines;
+
+        # find the instances without the explicit cast
+        my $num_no_cast = grep !m/($toxxx_functions)\(\(unsigned char\)/, 
@toxxx_lines;
+
+        push @no_explicit_cast, $path, "\n" if $num_no_cast;
+    }
+    else {
+        next;
+    }
+}
+
+ok( !scalar(@no_explicit_cast), 'toxxx() functions cast correctly' )
+    or diag( "toxxx() function incorrectly cast in " . scalar 
@no_explicit_cast . " files:\n@no_explicit_cast" );
+
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:

<Prev in Thread] Current Thread [Next in Thread>
  • [svn:parrot] r20096 - trunk/t/codingstd, paultcochrane <=