t/porting/args_assert.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5 use Config;
   6
   7 require './test.pl';
   8
   9 if ( $Config{usecrosscompile} ) {
  10   skip_all( "Not all files are available during cross-compilation" );
  11 }
  12
  13 plan('no_plan');
  14
  15 # Fail for every PERL_ARGS_ASSERT* macro that was declared but not used.
  16
  17 my %declared;
  18 my %used;
  19
  20 my $prefix = '';
  21
  22 unless (-d 't' && -f 'MANIFEST') {
  23     # we'll assume that we are in t then.
  24     # All files are internal to perl, so Unix-style is sufficiently portable.
  25     $prefix = '../';
  26 }
  27
  28 {
  29     my $proto = $prefix . 'proto.h';
  30
  31     open my $fh, '<', $proto or die "Can't open $proto: $!";
  32
  33     while (<$fh>) {
  34         $declared{$1}++ if /^#define\s+(PERL_ARGS_ASSERT[A-Za-z0-9_]+)\s+/;
  35     }
  36 }
  37
  38 cmp_ok(scalar keys %declared, '>', 0, 'Some macros were declared');
  39
  40 if (!@ARGV) {
  41     my $manifest = $prefix . 'MANIFEST';
  42     open my $fh, '<', $manifest or die "Can't open $manifest: $!";
  43     while (<$fh>) {
  44         # *.c or */*.c
  45         push @ARGV, $prefix . $1 if m!^((?:[^/]+/)?[^/]+\.c)\t!;
  46         # Special case the *inline.h since they behave like *.c
  47         push @ARGV, $prefix . $1 if m!^(([^/]+)?inline\.h)\t!;
  48     }
  49 }
  50
  51 while (<>) {
  52     $used{$1}++ if /^\s+(PERL_ARGS_ASSERT_[A-Za-z0-9_]+);$/;
  53 }
  54
  55 my %unused;
  56
  57 foreach (keys %declared) {
  58     $unused{$_}++ unless $used{$_};
  59 }
  60
  61 if (keys %unused) {
  62     fail("$_ is declared but not used") foreach sort keys %unused;
  63 } else {
  64     pass('Every PERL_ARGS_ASSERT* macro declared is used');
  65 }