develooper Front page | perl.cvs.parrot | Postings from January 2009

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

From:
bernhard
Date:
January 15, 2009 03:15
Subject:
[svn:parrot] r35581 - trunk/t/codingstd
Message ID:
20090115111450.79400CB9AE@x12.develooper.com
Author: bernhard
Date: Thu Jan 15 03:14:48 2009
New Revision: 35581

Modified:
   trunk/t/codingstd/c_arg_assert.t

Log:
[t] Some beautifications.
More info for misplaced macro invocations.
Pull expensive join outside the loop.


Modified: trunk/t/codingstd/c_arg_assert.t
==============================================================================
--- trunk/t/codingstd/c_arg_assert.t	(original)
+++ trunk/t/codingstd/c_arg_assert.t	Thu Jan 15 03:14:48 2009
@@ -1,11 +1,11 @@
 #! perl
-# Copyright (C) 2008, The Perl Foundation.
+# Copyright (C) 2008-2009, The Perl Foundation.
 # $Id$
 
 use strict;
 use warnings;
-
 use lib qw( . lib ../lib ../../lib );
+
 use Test::More tests => 2;
 use Parrot::Distribution;
 
@@ -22,6 +22,7 @@
 
 Finds all the argument guards generated by headerizer (asserts to enforce the
 non-NULLness of specially marked pointers) are actually used.
+Verifies that macros are invoked on a sane position.
 
 =head1 SEE ALSO
 
@@ -35,47 +36,51 @@
 
 sub check_asserts {
     my @files = @_;
+
     my @defines;
     my %usages;
-    my @offsets;
+    my @misplaced;
 
-    # first, find the definitions and the usages
-    diag("finding definitions");
+    # first, find the definitions and the usages in all files
+    diag('finding macro definitions and invocations');
     foreach my $file (@files) {
-        my $path  = $file->path();
-        my @lines = ($file->read());
+        my $path     = $file->path();
+        my @lines    = $file->read();
+        my $fulltext = join('', @lines);
         foreach my $line (@lines) {
-            if($line =~ /^#define ASSERT_ARGS_([_a-zA-Z0-9]+)\s/s) {
-                push(@defines, [$1, $path] );
+            if ( my ($func) = $line =~ m/^#define ASSERT_ARGS_([_a-zA-Z0-9]+)\s/s ) {
+                push @defines, [$func, $path];
             }
-            if($line =~ /^\s+ASSERT_ARGS\(([_a-zA-Z0-9]+)\)$/) {
-                my $func = $1;
+            
+            if ( my ($func) = $line =~ m/^\s+ASSERT_ARGS\(([_a-zA-Z0-9]+)\)$/ ) {
                 $usages{$func} = 1;
-                my $fulltext = join('',@lines);
-                if($fulltext !~ /\n\{\s*ASSERT_ARGS\($func\)\n/s) {
-                    push(@offsets, $func);
+
+                # The ASSERT_ARGS macro needs to follow an opening curly bracket
+                if ($fulltext !~ m/\n\{\s*ASSERT_ARGS\($func\)\n/s) {
+                    push @misplaced, [$func, $path];
                 }
             }
         }
     }
 
     # next, cross reference them.
-    my @missing = grep { !exists($usages{$_->[0]}) } @defines;
-    ok(!scalar @missing);
-    if(scalar @missing) {
-        diag("unused assert macros found:");
-        foreach my $missing (sort { $a->[1] . $a->[0] cmp $b->[1] . $b->[0]} @missing) {
-            diag($missing->[1] . ": " . $missing->[0]);
+    my @missing = grep { ! exists($usages{$_->[0]}) } @defines;
+    ok(! @missing, 'no unused assert macros');
+    if (@missing) {
+        diag('unused assert macros found:');
+        foreach (sort { $a->[1] . $a->[0] cmp $b->[1] . $b->[0]} @missing) {
+            diag($_->[1] . ': ' . $_->[0]);
         }
-        diag(scalar(@missing) . " unused assert macros found in total.");
+        diag(scalar(@missing) . ' unused assert macros found in total.');
     }
-    ok(!scalar @offsets);
-    if(scalar @offsets) {
-        diag("The following macros exist but aren't at the top of their function:");
-        foreach my $offset (sort @offsets) {
-            diag($offset);
+
+    ok(! @misplaced, 'macros used in correct position');
+    if (@misplaced) {
+        diag(q{The following macros exist but aren't at the top of their function:});
+        foreach (sort @misplaced) {
+            diag($_->[1] . ': ' . $_->[0]);
         }
-        diag(scalar(@offsets) . " offset macros found in total.");
+        diag(scalar(@misplaced) . ' misplaced macros found in total.');
     }
 }
 



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