source: trunk/UNIT_TESTER/list_undefined_units.pl

#!/usr/bin/perl

use strict;
use warnings;

my $ARBHOME = $ENV{ARBHOME};
if (not defined $ARBHOME) { die "environment variable 'ARBHOME' is not defined"; }

my %locs = ();
sub get_loc($) {
  my ($makevar) = @_;

  my $loc = $locs{$makevar};
  if (not defined $loc) {
    my $makefile = $ARBHOME.'/Makefile';
    open(IN,'<'.$makefile) || die "cannot read $makefile";

    my $reg = qr/$makevar/;
    my $line;
  LINE: while (defined($line=<IN>)) {
      if ($line =~ $reg) {
        if (not $line =~ /^\s*\#/o) {
          $locs{$makevar} = $loc = $.;
          last LINE;
        }
      }
    }
    close(IN);
  }

  return "Makefile:$loc";
}

sub main() {
  my $args = scalar(@ARGV);
  if ($args<1) {
    print "Usage: list_undefined_units.pl [defined*] -- [archives*]\n";
    print "detects inconsistencies in listed testunits\n";
  }
  else {
    my @def = ();

    while (scalar(@ARGV) and ($ARGV[0] ne '--')) {
      push @def, shift @ARGV;
    }
    if (not ((scalar(@ARGV)>0) and ($ARGV[0] eq '--'))) {
      die "expected to see argument '--'";
    }
    shift @ARGV; # drop '--'

    my @arch = @ARGV;

    my %def = map { $_ => 1; } @def;
    my %arch = map { $_ => 1; } @arch;

    my @both = sort ( @arch, @def );

    foreach my $unit (@both) {
      if (exists $arch{$unit}) {
        if (not exists $def{$unit}) {
          my $manual_loc = get_loc('DEFINED_TEST_UNITS');
          print "${manual_loc}: Warning: $unit not listed in DEFINED_TEST_UNITS (manual lists)\n";
        }
        # else ok
      }
      elsif (exists $def{$unit}) {
        my $auto_loc = get_loc('TESTED_UNITS_AUTO');
        print "${auto_loc}: Warning: $unit not listed in TESTED_UNITS_AUTO (detected archives)\n";
      }
      else {
        die;
      }
    }
  }
}
main();