develooper Front page | perl.cvs.parrot | Postings from December 2008

[svn:parrot] r34719 - in trunk: t/codingstd tools/build

From:
infinoid
Date:
December 31, 2008 11:18
Subject:
[svn:parrot] r34719 - in trunk: t/codingstd tools/build
Message ID:
20081231191848.D413ECB9FA@x12.develooper.com
Author: infinoid
Date: Wed Dec 31 11:18:48 2008
New Revision: 34719

Added:
   trunk/t/codingstd/c_arg_assert.t
Modified:
   trunk/t/codingstd/c_indent.t
   trunk/tools/build/headerizer.pl

Log:
[headerizer] From a suggestion from Nicholas Clark in
http://www.nntp.perl.org/group/perl.perl6.internals/2008/12/msg49677.html ,
adapt headerizer to emit macros which assert() the definedness of arguments
that should never be NULL.  If I'm understanding c_functions.pod correctly,
this means ARGIN(), ARGOUT(), ARGMOD() and NOTNULL(), but not the
ARG*_NULLOK() variants.

Also add t/codingstd/c_arg_assert.t to verify the resulting defines actually
get used.  And whitelist the generated #defines so they don't trigger
failures in t/codingstd/c_indent.t.

Added: trunk/t/codingstd/c_arg_assert.t
==============================================================================
--- (empty file)
+++ trunk/t/codingstd/c_arg_assert.t	Wed Dec 31 11:18:48 2008
@@ -0,0 +1,73 @@
+#! perl
+# Copyright (C) 2008, 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/c_arg_assert.t - checks that all the headerizer asserts are used
+
+=head1 SYNOPSIS
+
+    # test all files
+    % prove t/codingstd/c_arg_assert.t
+
+=head1 DESCRIPTION
+
+Finds all the argument guards generated by headerizer (asserts to enforce the
+non-NULLness of specially marked pointers) are actually used.
+
+=head1 SEE ALSO
+
+L<docs/pdds/pdd07_codingstd.pod>
+
+=cut
+
+my @files = Parrot::Distribution->new()->get_c_language_files();
+
+check_asserts(@files);
+
+sub check_asserts {
+    my @files = @_;
+    my @defines;
+    my %usages;
+
+    # first, find the definitions and the usages
+    diag("finding definitions");
+    foreach my $file (@files) {
+        my $path  = $file->path();
+        my @lines = ($file->read());
+        foreach my $line (@lines) {
+            if($line =~ /^#define ASSERT_ARGS_([_a-zA-Z0-9]+)\s/s) {
+                push(@defines, $1);
+            }
+            if($line =~ /^\s+ASSERT_ARGS\(([_a-zA-Z0-9]+)\);/) {
+                $usages{$1} = 1;
+            }
+        }
+    }
+
+    # next, cross reference them.
+    my @missing = grep { !exists($usages{$_}) } @defines;
+    ok(!scalar @missing);
+    if(scalar @missing) {
+        diag("unused assert macros found:");
+        foreach my $missing (sort @missing) {
+            diag($missing);
+        }
+        diag(scalar(@missing) . " unused assert macros found in total.");
+    }
+}
+
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:

Modified: trunk/t/codingstd/c_indent.t
==============================================================================
--- trunk/t/codingstd/c_indent.t	(original)
+++ trunk/t/codingstd/c_indent.t	Wed Dec 31 11:18:48 2008
@@ -138,6 +138,7 @@
                   /x
                 )
             {
+                next if (m/ASSERT_ARGS_/); # autogenerated by headerizer
                 my $indent = q{  } x (@stack);
                 if ( $1 ne $indent ) {
                     push @pp_indent => "$path:$line_cnt\n"

Modified: trunk/tools/build/headerizer.pl
==============================================================================
--- trunk/tools/build/headerizer.pl	(original)
+++ trunk/tools/build/headerizer.pl	Wed Dec 31 11:18:48 2008
@@ -295,6 +295,32 @@
     return (@attrs,@mods);
 }
 
+sub asserts_from_args {
+    my @args = @_;
+    my @asserts;
+
+    for my $arg (@args) {
+        if ( $arg =~ m{(ARGIN|ARGOUT|ARGMOD|NOTNULL)\((.+)\)} ) {
+            my $var = $2;
+            if($var =~ /\(*\s*([a-zA-Z_][a-zA-Z0-9_]*)\s*\)\s*\(/) {
+                # argument is a function pointer
+                $var = $1;
+            }
+            else {
+                # try to isolate the variable's name;
+                # strip off everything before the final space or asterisk.
+                $var =~ s[.+[* ]([^* ]+)$][$1];
+            }
+            push( @asserts, "assert($var);" );
+        }
+        if( $arg eq 'PARROT_INTERP' ) {
+            push( @asserts, "assert(interp);" );
+        }
+    }
+
+    return (@asserts);
+}
+
 sub make_function_decls {
     my @funcs = @_;
 
@@ -305,8 +331,8 @@
         my $decl = sprintf( "%s %s(", $func->{return_type}, $func->{name} );
         $decl = "static $decl" if $func->{is_static};
 
-        my @args = @{ $func->{args} };
-        my @attrs = attrs_from_args( $func, @args );
+        my @args    = @{ $func->{args} };
+        my @attrs   = attrs_from_args( $func, @args );
 
         for my $arg (@args) {
             if ( $arg =~ m{SHIM\((.+)\)} ) {
@@ -348,6 +374,18 @@
         push( @decls, $decl );
     }
 
+    foreach my $func (@funcs) {
+        my @args    = @{ $func->{args} };
+        my @asserts = asserts_from_args( @args );
+
+        my $assert = "#define ASSERT_ARGS_" . $func->{name};
+        if(@asserts) {
+            $assert .= ' ';
+            $assert .= join(" \\\n" . ' ' x length($assert), @asserts);
+        }
+        push(@decls, $assert);
+    }
+
     return @decls;
 }
 



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About