src/regress/usr.bin/tsort/tsort-check

   1 #!/usr/bin/perl
   2
   3 # Written by Marc Espie, 2001.
   4 # Public domain
   5
   6 %order=();
   7
   8 %exception=();
   9 %ok=();
  10
  11
  12 open(SORTED, shift) or die "No sorted output\n";
  13 while(<SORTED>) {
  14         chomp;
  15         while (m/^tsort: cycle in data/) {
  16                 @list = ();
  17                 while (<SORTED>) {
  18                         chomp;
  19                         last if m/^tsort: cycle in data/;
  20                         last unless m/^tsort:\s+/;
  21                         push(@list, $');
  22                 }
  23                 for $i (1 .. @list) {
  24                         $exception{$list[$i-1].' '.$list[$i % @list]} = 1;
  25                 }
  26                 $break{$list[1]} = 1;
  27         }
  28         $order{$_} = $i++;
  29 }
  30 close(SORTED);
  31
  32 @pairs=();
  33
  34 open(PAIRS, shift) or die "No pairs\n";
  35 while (<PAIRS>) {
  36         chomp;
  37         push(@pairs, split(/\s+/, $_));
  38         while (@pairs >= 2) {
  39             $b = pop @pairs;
  40             $a = pop @pairs;
  41             if (defined $exception{"$a $b"}) {
  42                 $ok{"$a $b"} = 1;
  43             }
  44             next if $break{$a} = 1;
  45             next unless $order{$a} < $order{$b};
  46             die "Bad pair $a $b\n";
  47         }
  48 }
  49 close(PAIRS);
  50
  51 while (($key, $v) = each %exception) {
  52         next if $v != 1;
  53         die "Bogus cycle edge $key\n" unless $ok{$key};
  54 }