conform/conformtest.pl

   1 #! /usr/bin/perl
   2
   3 use Getopt::Long;
   4
   5 $CC = "gcc";
   6
   7 $dialect="XOPEN2K";
   8 GetOptions ('headers=s' => \@headers, 'dialect=s' => \$dialect);
   9 @headers = split(/,/,join(',',@headers));
  10
  11 # List of the headers we are testing.
  12 if (@headers == ()) {
  13   @headers = ("wordexp.h", "wctype.h", "wchar.h", "varargs.h", "utmpx.h",
  14               "utime.h", "unistd.h", "ulimit.h", "ucontext.h", "time.h",
  15               "termios.h", "tar.h", "sys/wait.h", "sys/utsname.h", "sys/un.h",
  16               "sys/uio.h", "sys/types.h", "sys/times.h", "sys/timeb.h",
  17               "sys/time.h", "sys/statvfs.h", "sys/stat.h", "sys/socket.h",
  18               "sys/shm.h", "sys/sem.h", "sys/resource.h", "sys/msg.h",
  19               "sys/mman.h", "sys/ipc.h", "syslog.h", "stropts.h", "strings.h",
  20               "string.h", "stdlib.h", "stdio.h", "stdint.h", "stddef.h",
  21               "stdarg.h", "spawn.h", "signal.h", "setjmp.h", "semaphore.h",
  22               "search.h", "sched.h", "regex.h", "pwd.h", "pthread.h",
  23               "poll.h", "nl_types.h", "netinet/tcp.h", "netinet/in.h",
  24               "net/if.h", "netdb.h", "ndbm.h", "mqueue.h", "monetary.h",
  25               "math.h", "locale.h", "libgen.h", "limits.h", "langinfo.h",
  26               "iso646.h", "inttypes.h", "iconv.h", "grp.h", "glob.h", "ftw.h",
  27               "fnmatch.h", "fmtmsg.h", "float.h", "fcntl.h", "errno.h",
  28               "dlfcn.h", "dirent.h", "ctype.h", "cpio.h", "assert.h",
  29               "arpa/inet.h", "aio.h");
  30 }
  31
  32 if ($dialect ne "ISO" && $dialect ne "POSIX" && $dialect ne "XPG3"
  33     && $dialect ne "XPG4" && $dialect ne "UNIX98" && $dialect ne "XOPEN2K") {
  34   die "unknown dialect \"$dialect\"";
  35 }
  36
  37 $CFLAGS{"ISO"} = "-I. '-D__attribute__(x)=' -ansi";
  38 $CFLAGS{"POSIX"} = "-I. '-D__attribute__(x)=' -D_POSIX_C_SOURCE=199912";
  39 $CFLAGS{"XPG3"} = "-I. '-D__attribute__(x)=' -D_XOPEN_SOURCE";
  40 $CFLAGS{"XPG4"} = "-I. '-D__attribute__(x)=' -D_XOPEN_SOURCE_EXTENDED";
  41 $CFLAGS{"UNIX98"} = "-I. '-D__attribute__(x)=' -D_XOPEN_SOURCE=500";
  42 $CFLAGS{"XOPEN2K"} = "-I. '-D__attribute__(x)=' -D_XOPEN_SOURCE=600";
  43
  44
  45 # These are the ISO C99 keywords.
  46 @keywords = ('auto', 'break', 'case', 'char', 'const', 'continue', 'default',
  47              'do', 'double', 'else', 'enum', 'extern', 'float', 'for', 'goto',
  48              'if', 'inline', 'int', 'long', 'register', 'restrict', 'return',
  49              'short', 'signed', 'sizeof', 'static', 'struct', 'switch',
  50              'typedef', 'union', 'unsigned', 'void', 'volatile', 'while');
  51
  52 # These are symbols which are known to pollute the namespace.
  53 @knownproblems = ('unix', 'linux', 'i386');
  54
  55 # Some headers need a bit more attention.
  56 $mustprepend{'regex.h'} = "#include <sys/types.h>\n";
  57 $mustprepend{'sched.h'} = "#include <sys/types.h>\n";
  58 $mustprepend{'signal.h'} = "#include <pthread.h>\n";
  59 $mustprepend{'wordexp.h'} = "#include <stddef.h>\n";
  60
  61 # Make a hash table from this information.
  62 while ($#keywords >= 0) {
  63   $iskeyword{pop (@keywords)} = 1;
  64 }
  65
  66 # Make a hash table from the known problems.
  67 while ($#knownproblems >= 0) {
  68   $isknown{pop (@knownproblems)} = 1;
  69 }
  70
  71 $tmpdir = "/tmp";
  72
  73 $verbose = 1;
  74
  75 $total = 0;
  76 $skipped = 0;
  77 $errors = 0;
  78
  79
  80 sub poorfnmatch {
  81   my($pattern, $string) = @_;
  82   my($strlen) = length ($string);
  83   my($res);
  84
  85   if (substr ($pattern, 0, 1) eq '*') {
  86     my($patlen) = length ($pattern) - 1;
  87     $res = ($strlen >= $patlen
  88             && substr ($pattern, -$patlen, $patlen) eq substr ($string, -$patlen, $patlen));
  89   } elsif (substr ($pattern, -1, 1) eq '*') {
  90     my($patlen) = length ($pattern) - 1;
  91     $res = ($strlen >= $patlen
  92             && substr ($pattern, 0, $patlen) eq substr ($string, 0, $patlen));
  93   } else {
  94     $res = $pattern eq $string;
  95   }
  96   return $res;
  97 }
  98
  99
 100 sub compiletest
 101 {
 102   my($fnamebase, $msg, $errmsg, $skip, $optional) = @_;
 103   my($result) = $skip;
 104   my($printlog) = 0;
 105
 106   ++$total;
 107   printf ("  $msg...");
 108
 109   if ($skip != 0) {
 110     ++$skipped;
 111     printf (" SKIP\n");
 112   } else {
 113     $ret = system "$CC $CFLAGS{$dialect} -c $fnamebase.c -o $fnamebase.o > $fnamebase.out 2>&1";
 114     if ($ret != 0) {
 115       if ($optional != 0) {
 116         printf (" $errmsg\n");
 117         $result = 1;
 118       } else {
 119         printf (" FAIL\n");
 120         if ($verbose != 0) {
 121           printf ("    $errmsg  Compiler message:\n");
 122           $printlog = 1;
 123         }
 124         ++$errors;
 125         $result = 1;
 126       }
 127     } else {
 128       printf (" OK\n");
 129       if ($verbose > 1 && -s "$fnamebase.out") {
 130         # We print all warnings issued.
 131         $printlog = 1;
 132       }
 133     }
 134     if ($printlog != 0) {
 135       printf ("    " . "-" x 71 . "\n");
 136       open (MESSAGE, "< $fnamebase.out");
 137       while (<MESSAGE>) {
 138         printf ("    %s", $_);
 139       }
 140       close (MESSAGE);
 141       printf ("    " . "-" x 71 . "\n");
 142     }
 143   }
 144   unlink "$fnamebase.c";
 145   unlink "$fnamebase.o";
 146   unlink "$fnamebase.out";
 147
 148   $result;
 149 }
 150
 151
 152 sub runtest
 153 {
 154   my($fnamebase, $msg, $errmsg, $skip) = @_;
 155   my($result) = $skip;
 156   my($printlog) = 0;
 157
 158   ++$total;
 159   printf ("  $msg...");
 160
 161   if ($skip != 0) {
 162     ++$skipped;
 163     printf (" SKIP\n");
 164   } else {
 165     $ret = system "$CC $CFLAGS{$dialect} -o $fnamebase $fnamebase.c > $fnamebase.out 2>&1";
 166     if ($ret != 0) {
 167       printf (" FAIL\n");
 168       if ($verbose != 0) {
 169         printf ("    $errmsg  Compiler message:\n");
 170         $printlog = 1;
 171       }
 172       ++$errors;
 173       $result = 1;
 174     } else {
 175       # Now run the program.  If the exit code is not zero something is wrong.
 176       $result = system "$fnamebase > $fnamebase.out2 2>&1";
 177       if ($result == 0) {
 178         printf (" OK\n");
 179         if ($verbose > 1 && -s "$fnamebase.out") {
 180           # We print all warnings issued.
 181           $printlog = 1;
 182           system "cat $fnamebase.out2 >> $fnamebase.out";
 183         }
 184       } else {
 185         printf (" FAIL\n");
 186         ++$errors;
 187         $printlog = 1;
 188         unlink "$fnamebase.out";
 189         rename "$fnamebase.out2", "$fnamebase.out";
 190       }
 191     }
 192     if ($printlog != 0) {
 193       printf ("    " . "-" x 71 . "\n");
 194       open (MESSAGE, "< $fnamebase.out");
 195       while (<MESSAGE>) {
 196         printf ("    %s", $_);
 197       }
 198       close (MESSAGE);
 199       printf ("    " . "-" x 71 . "\n");
 200     }
 201   }
 202   unlink "$fnamebase";
 203   unlink "$fnamebase.c";
 204   unlink "$fnamebase.o";
 205   unlink "$fnamebase.out";
 206   unlink "$fnamebase.out2";
 207
 208   $result;
 209 }
 210
 211
 212 sub newtoken {
 213   my($token, @allow) = @_;
 214   my($idx);
 215
 216   return if ($token =~ /^[0-9_]/ || $iskeyword{$token});
 217
 218   for ($idx = 0; $idx <= $#allow; ++$idx) {
 219     return if (poorfnmatch ($allow[$idx], $token));
 220   }
 221
 222   if ($isknown{$token}) {
 223     ++$nknown;
 224   } else {
 225     ++$nerrors;
 226     if ($nerrors == 1) {
 227       printf ("FAIL\n    " . "-" x 72 . "\n");
 228     }
 229     printf ("    Namespace violation: \"%s\"\n", $token);
 230   }
 231 }
 232
 233
 234 sub checknamespace {
 235   my($h, $fnamebase, @allow) = @_;
 236
 237   ++$total;
 238
 239   # Generate a program to get the contents of this header.
 240   open (TESTFILE, ">$fnamebase.c");
 241   print TESTFILE "#include <$h>\n";
 242   close (TESTFILE);
 243
 244   $nerrors = 0;
 245   $nknown = 0;
 246   open (CONTENT, "$CC $CFLAGS{$dialect} -E $fnamebase.c -P -Wp,-dN | sed -e '/^# [1-9]/d' -e '/^[[:space:]]*\$/d' |");
 247   loop: while (<CONTENT>) {
 248     next loop if (/^#undef /);
 249     chop;
 250     if (/^#define (.*)/) {
 251       newtoken ($1, @allow);
 252     } else {
 253       # We have to tokenize the line.
 254       my($str) = $_;
 255       my($index) = 0;
 256       my($len) = length ($str);
 257
 258       foreach $token (split(/[^a-zA-Z0-9_]/, $str)) {
 259         if ($token ne "") {
 260           newtoken ($token, @allow);
 261         }
 262       }
 263     }
 264   }
 265   close (CONTENT);
 266   unlink "$fnamebase.c";
 267   if ($nerrors != 0) {
 268     printf ("    " . "-" x 72 . "\n");
 269     ++$errors;
 270   } elsif ($nknown > 0) {
 271     printf ("EXPECTED FAILURES\n");
 272     ++$known;
 273   } else {
 274     printf ("OK\n");
 275   }
 276 }
 277
 278
 279 while ($#headers >= 0) {
 280   my($h) = pop (@headers);
 281   my($hf) = $h;
 282   $hf =~ s|/|-|;
 283   my($fnamebase) = "$tmpdir/$hf-test";
 284   my($missing);
 285   my(@allow) = ();
 286   my(@allowheader) = ();
 287   my(%seenheader) = ();
 288   my($prepend) = $mustprepend{$h};
 289
 290   printf ("Testing <$h>\n");
 291   printf ("----------" . "-" x length ($h) . "\n");
 292
 293   # Generate a program to test for the availability of this header.
 294   open (TESTFILE, ">$fnamebase.c");
 295   print TESTFILE "$prepend";
 296   print TESTFILE "#include <$h>\n";
 297   close (TESTFILE);
 298
 299   $missing = compiletest ($fnamebase, "Checking whether <$h> is available",
 300                           "Header <$h> not available", 0, 0);
 301
 302   printf ("\n");
 303
 304   open (CONTROL, "$CC -E -D$dialect - < data/$h-data |");
 305   control: while (<CONTROL>) {
 306     chop;
 307     next control if (/^#/);
 308     next control if (/^[        ]*$/);
 309
 310     if (/^element *({([^}]*)}|([^{ ]*)) *({([^}]*)}|([^{ ]*)) *([A-Za-z0-9_]*) *(.*)/) {
 311       my($struct) = "$2$3";
 312       my($type) = "$5$6";
 313       my($member) = "$7";
 314       my($rest) = "$8";
 315       my($res) = $missing;
 316
 317       # Remember that this name is allowed.
 318       push @allow, $member;
 319
 320       # Generate a program to test for the availability of this member.
 321       open (TESTFILE, ">$fnamebase.c");
 322       print TESTFILE "$prepend";
 323       print TESTFILE "#include <$h>\n";
 324       print TESTFILE "$struct a;\n";
 325       print TESTFILE "$struct b;\n";
 326       print TESTFILE "extern void xyzzy (__typeof__ (&b.$member), __typeof__ (&a.$member), unsigned);\n";
 327       print TESTFILE "void foobarbaz (void) {\n";
 328       print TESTFILE "  xyzzy (&a.$member, &b.$member, sizeof (a.$member));\n";
 329       print TESTFILE "}\n";
 330       close (TESTFILE);
 331
 332       $res = compiletest ($fnamebase, "Testing for member $member",
 333                           "Member \"$member\" not available.", $res, 0);
 334
 335
 336       # Test the types of the members.
 337       open (TESTFILE, ">$fnamebase.c");
 338       print TESTFILE "$prepend";
 339       print TESTFILE "#include <$h>\n";
 340       print TESTFILE "$struct a;\n";
 341       print TESTFILE "extern $type b$rest;\n";
 342       print TESTFILE "extern __typeof__ (a.$member) b;\n";
 343       close (TESTFILE);
 344
 345       compiletest ($fnamebase, "Testing for type of member $member",
 346                    "Member \"$member\" does not have the correct type.",
 347                    $res, 0);
 348     } elsif (/^optional-element *({([^}]*)}|([^{ ]*)) *({([^}]*)}|([^{ ]*)) *([A-Za-z0-9_]*) *(.*)/) {
 349       my($struct) = "$2$3";
 350       my($type) = "$5$6";
 351       my($member) = "$7";
 352       my($rest) = "$8";
 353       my($res) = $missing;
 354
 355       # Remember that this name is allowed.
 356       push @allow, $member;
 357
 358       # Generate a program to test for the availability of this member.
 359       open (TESTFILE, ">$fnamebase.c");
 360       print TESTFILE "$prepend";
 361       print TESTFILE "#include <$h>\n";
 362       print TESTFILE "$struct a;\n";
 363       print TESTFILE "$struct b;\n";
 364       print TESTFILE "extern void xyzzy (__typeof__ (&b.$member), __typeof__ (&a.$member), unsigned);\n";
 365       print TESTFILE "void foobarbaz (void) {\n";
 366       print TESTFILE "  xyzzy (&a.$member, &b.$member, sizeof (a.$member));\n";
 367       print TESTFILE "}\n";
 368       close (TESTFILE);
 369
 370       $res = compiletest ($fnamebase, "Testing for member $member",
 371                           "NOT AVAILABLE.", $res, 1);
 372
 373       if ($res == 0 || $missing != 0) {
 374         # Test the types of the members.
 375         open (TESTFILE, ">$fnamebase.c");
 376         print TESTFILE "$prepend";
 377         print TESTFILE "#include <$h>\n";
 378         print TESTFILE "$struct a;\n";
 379         print TESTFILE "extern $type b$rest;\n";
 380         print TESTFILE "extern __typeof__ (a.$member) b;\n";
 381         close (TESTFILE);
 382
 383         compiletest ($fnamebase, "Testing for type of member $member",
 384                      "Member \"$member\" does not have the correct type.",
 385                      $res, 0);
 386       }
 387     } elsif (/^optional-constant *([a-zA-Z0-9_]*) ([>=<]+) ([A-Za-z0-9_]*)/) {
 388       my($const) = $1;
 389       my($op) = $2;
 390       my($value) = $3;
 391       my($res) = $missing;
 392
 393       # Remember that this name is allowed.
 394       push @allow, $const;
 395
 396       # Generate a program to test for the availability of this constant.
 397       open (TESTFILE, ">$fnamebase.c");
 398       print TESTFILE "$prepend";
 399       print TESTFILE "#include <$h>\n";
 400       print TESTFILE "__typeof__ ($const) a = $const;\n";
 401       close (TESTFILE);
 402
 403       $res = compiletest ($fnamebase, "Testing for constant $const",
 404                           "NOT PRESENT", $res, 1);
 405
 406       if ($value ne "" && $res == 0) {
 407         # Generate a program to test for the value of this constant.
 408         open (TESTFILE, ">$fnamebase.c");
 409         print TESTFILE "$prepend";
 410         print TESTFILE "#include <$h>\n";
 411         # Negate the value since 0 means ok
 412         print TESTFILE "int main (void) { return !($const $op $value); }\n";
 413         close (TESTFILE);
 414
 415         $res = runtest ($fnamebase, "Testing for value of constant $const",
 416                         "Constant \"$const\" has not the right value.", $res);
 417       }
 418     } elsif (/^constant *([a-zA-Z0-9_]*) *([>=<]+) ([A-Za-z0-9_]*)/) {
 419       my($const) = $1;
 420       my($op) = $2;
 421       my($value) = $3;
 422       my($res) = $missing;
 423
 424       # Remember that this name is allowed.
 425       push @allow, $const;
 426
 427       # Generate a program to test for the availability of this constant.
 428       open (TESTFILE, ">$fnamebase.c");
 429       print TESTFILE "$prepend";
 430       print TESTFILE "#include <$h>\n";
 431       print TESTFILE "__typeof__ ($const) a = $const;\n";
 432       close (TESTFILE);
 433
 434       $res = compiletest ($fnamebase, "Testing for constant $const",
 435                           "Constant \"$const\" not available.", $res, 0);
 436
 437       if ($value ne "") {
 438         # Generate a program to test for the value of this constant.
 439         open (TESTFILE, ">$fnamebase.c");
 440         print TESTFILE "$prepend";
 441         print TESTFILE "#include <$h>\n";
 442         # Negate the value since 0 means ok
 443         print TESTFILE "int main (void) { return !($const $op $value); }\n";
 444         close (TESTFILE);
 445
 446         $res = runtest ($fnamebase, "Testing for value of constant $const",
 447                         "Constant \"$const\" has not the right value.", $res);
 448       }
 449     } elsif (/^typed-constant *([a-zA-Z0-9_]*) *({([^}]*)}|([^ ]*)) *([A-Za-z0-9_]*)?/) {
 450       my($const) = $1;
 451       my($type) = "$3$4";
 452       my($value) = $5;
 453       my($res) = $missing;
 454
 455       # Remember that this name is allowed.
 456       push @allow, $const;
 457
 458       # Generate a program to test for the availability of this constant.
 459       open (TESTFILE, ">$fnamebase.c");
 460       print TESTFILE "$prepend";
 461       print TESTFILE "#include <$h>\n";
 462       print TESTFILE "__typeof__ ($const) a = $const;\n";
 463       close (TESTFILE);
 464
 465       $res = compiletest ($fnamebase, "Testing for constant $const",
 466                           "Constant \"$const\" not available.", $res, 0);
 467
 468       # Test the types of the members.
 469       open (TESTFILE, ">$fnamebase.c");
 470       print TESTFILE "$prepend";
 471       print TESTFILE "#include <$h>\n";
 472       print TESTFILE "__typeof__ (($type) 0) a;\n";
 473       print TESTFILE "extern __typeof__ ($const) a;\n";
 474       close (TESTFILE);
 475
 476       compiletest ($fnamebase, "Testing for type of constant $const",
 477                    "Constant \"$const\" does not have the correct type.",
 478                    $res, 0);
 479
 480       if ($value ne "") {
 481         # Generate a program to test for the value of this constant.
 482         open (TESTFILE, ">$fnamebase.c");
 483         print TESTFILE "$prepend";
 484         print TESTFILE "#include <$h>\n";
 485         print TESTFILE "int main (void) { return $const != $value; }\n";
 486         close (TESTFILE);
 487
 488         $res = runtest ($fnamebase, "Testing for value of constant $const",
 489                         "Constant \"$const\" has not the right value.", $res);
 490       }
 491     } elsif (/^optional-constant *([a-zA-Z0-9_]*) *([A-Za-z0-9_]*)?/) {
 492       my($const) = $1;
 493       my($value) = $2;
 494       my($res) = $missing;
 495
 496       # Remember that this name is allowed.
 497       push @allow, $const;
 498
 499       # Generate a program to test for the availability of this constant.
 500       open (TESTFILE, ">$fnamebase.c");
 501       print TESTFILE "$prepend";
 502       print TESTFILE "#include <$h>\n";
 503       print TESTFILE "__typeof__ ($const) a = $const;\n";
 504       close (TESTFILE);
 505
 506       $res = compiletest ($fnamebase, "Testing for constant $const",
 507                           "NOT PRESENT", $res, 1);
 508
 509       if ($value ne "" && $res == 0) {
 510         # Generate a program to test for the value of this constant.
 511         open (TESTFILE, ">$fnamebase.c");
 512         print TESTFILE "$prepend";
 513         print TESTFILE "#include <$h>\n";
 514         print TESTFILE "int main (void) { return $const != $value; }\n";
 515         close (TESTFILE);
 516
 517         $res = runtest ($fnamebase, "Testing for value of constant $const",
 518                         "Constant \"$const\" has not the right value.", $res);
 519       }
 520     } elsif (/^constant *([a-zA-Z0-9_]*) *([A-Za-z0-9_]*)?/) {
 521       my($const) = $1;
 522       my($value) = $2;
 523       my($res) = $missing;
 524
 525       # Remember that this name is allowed.
 526       push @allow, $const;
 527
 528       # Generate a program to test for the availability of this constant.
 529       open (TESTFILE, ">$fnamebase.c");
 530       print TESTFILE "$prepend";
 531       print TESTFILE "#include <$h>\n";
 532       print TESTFILE "__typeof__ ($const) a = $const;\n";
 533       close (TESTFILE);
 534
 535       $res = compiletest ($fnamebase, "Testing for constant $const",
 536                           "Constant \"$const\" not available.", $res, 0);
 537
 538       if ($value ne "") {
 539         # Generate a program to test for the value of this constant.
 540         open (TESTFILE, ">$fnamebase.c");
 541         print TESTFILE "$prepend";
 542         print TESTFILE "#include <$h>\n";
 543         print TESTFILE "int main (void) { return $const != $value; }\n";
 544         close (TESTFILE);
 545
 546         $res = runtest ($fnamebase, "Testing for value of constant $const",
 547                         "Constant \"$const\" has not the right value.", $res);
 548       }
 549     } elsif (/^typed-constant *([a-zA-Z0-9_]*) *({([^}]*)}|([^ ]*)) *([A-Za-z0-9_]*)?/) {
 550       my($const) = $1;
 551       my($type) = "$3$4";
 552       my($value) = $5;
 553       my($res) = $missing;
 554
 555       # Remember that this name is allowed.
 556       push @allow, $const;
 557
 558       # Generate a program to test for the availability of this constant.
 559       open (TESTFILE, ">$fnamebase.c");
 560       print TESTFILE "$prepend";
 561       print TESTFILE "#include <$h>\n";
 562       print TESTFILE "__typeof__ ($const) a = $const;\n";
 563       close (TESTFILE);
 564
 565       $res = compiletest ($fnamebase, "Testing for constant $const",
 566                           "Constant \"$const\" not available.", $res, 0);
 567
 568       # Test the types of the members.
 569       open (TESTFILE, ">$fnamebase.c");
 570       print TESTFILE "$prepend";
 571       print TESTFILE "#include <$h>\n";
 572       print TESTFILE "__typeof__ (($type) 0) a;\n";
 573       print TESTFILE "extern __typeof__ ($const) a;\n";
 574       close (TESTFILE);
 575
 576       compiletest ($fnamebase, "Testing for type of constant $const",
 577                    "Constant \"$const\" does not have the correct type.",
 578                    $res, 0);
 579
 580       if ($value ne "") {
 581         # Generate a program to test for the value of this constant.
 582         open (TESTFILE, ">$fnamebase.c");
 583         print TESTFILE "$prepend";
 584         print TESTFILE "#include <$h>\n";
 585         print TESTFILE "int main (void) { return $const != $value; }\n";
 586         close (TESTFILE);
 587
 588         $res = runtest ($fnamebase, "Testing for value of constant $const",
 589                         "Constant \"$const\" has not the right value.", $res);
 590       }
 591     } elsif (/^optional-type *({([^}]*)|([a-zA-Z0-9_]*))/) {
 592       my($type) = "$2$3";
 593
 594       # Remember that this name is allowed.
 595       if ($type =~ /^struct *(.*)/) {
 596         push @allow, $1;
 597       } elsif ($type =~ /^union *(.*)/) {
 598         push @allow, $1;
 599       } else {
 600         push @allow, $type;
 601       }
 602
 603       # Remember that this name is allowed.
 604       push @allow, $type;
 605
 606       # Generate a program to test for the availability of this constant.
 607       open (TESTFILE, ">$fnamebase.c");
 608       print TESTFILE "$prepend";
 609       print TESTFILE "#include <$h>\n";
 610       print TESTFILE "$type *a;\n";
 611       close (TESTFILE);
 612
 613       compiletest ($fnamebase, "Testing for type $type",
 614                    "Type \"$type\" not available.", $missing, 1);
 615     } elsif (/^type *({([^}]*)|([a-zA-Z0-9_]*))/) {
 616       my($type) = "$2$3";
 617
 618       # Remember that this name is allowed.
 619       if ($type =~ /^struct *(.*)/) {
 620         push @allow, $1;
 621       } elsif ($type =~ /^union *(.*)/) {
 622         push @allow, $1;
 623       } else {
 624         push @allow, $type;
 625       }
 626
 627       # Remember that this name is allowed.
 628       push @allow, $type;
 629
 630       # Generate a program to test for the availability of this constant.
 631       open (TESTFILE, ">$fnamebase.c");
 632       print TESTFILE "$prepend";
 633       print TESTFILE "#include <$h>\n";
 634       print TESTFILE "$type *a;\n";
 635       close (TESTFILE);
 636
 637       compiletest ($fnamebase, "Testing for type $type",
 638                    "Type \"$type\" not available.", $missing, 0);
 639     } elsif (/^function *({([^}]*)}|([a-zA-Z0-9_]*)) [(][*]([a-zA-Z0-9_]*) ([(].*[)])/) {
 640       my($rettype) = "$2$3";
 641       my($fname) = "$4";
 642       my($args) = "$5";
 643       my($res) = $missing;
 644
 645       # Remember that this name is allowed.
 646       push @allow, $fname;
 647
 648       # Generate a program to test for availability of this function.
 649       open (TESTFILE, ">$fnamebase.c");
 650       print TESTFILE "$prepend";
 651       print TESTFILE "#include <$h>\n";
 652       # print TESTFILE "#undef $fname\n";
 653       print TESTFILE "$rettype (*(*foobarbaz) $args = $fname;\n";
 654       close (TESTFILE);
 655
 656       $res = compiletest ($fnamebase, "Test availability of function $fname",
 657                           "Function \"$fname\" is not available.", $res, 0);
 658
 659       # Generate a program to test for the type of this function.
 660       open (TESTFILE, ">$fnamebase.c");
 661       print TESTFILE "$prepend";
 662       print TESTFILE "#include <$h>\n";
 663       # print TESTFILE "#undef $fname\n";
 664       print TESTFILE "extern $rettype (*(*foobarbaz) $args;\n";
 665       print TESTFILE "extern __typeof__ (&$fname) foobarbaz;\n";
 666       close (TESTFILE);
 667
 668       compiletest ($fnamebase, "Test for type of function $fname",
 669                    "Function \"$fname\" has incorrect type.", $res, 0);
 670     } elsif (/^function *({([^}]*)}|([a-zA-Z0-9_]*)) ([a-zA-Z0-9_]*) ([(].*[)])/) {
 671       my($rettype) = "$2$3";
 672       my($fname) = "$4";
 673       my($args) = "$5";
 674       my($res) = $missing;
 675
 676       # Remember that this name is allowed.
 677       push @allow, $fname;
 678
 679       # Generate a program to test for availability of this function.
 680       open (TESTFILE, ">$fnamebase.c");
 681       print TESTFILE "$prepend";
 682       print TESTFILE "#include <$h>\n";
 683       # print TESTFILE "#undef $fname\n";
 684       print TESTFILE "$rettype (*foobarbaz) $args = $fname;\n";
 685       close (TESTFILE);
 686
 687       $res = compiletest ($fnamebase, "Test availability of function $fname",
 688                           "Function \"$fname\" is not available.", $res, 0);
 689
 690       # Generate a program to test for the type of this function.
 691       open (TESTFILE, ">$fnamebase.c");
 692       print TESTFILE "$prepend";
 693       print TESTFILE "#include <$h>\n";
 694       # print TESTFILE "#undef $fname\n";
 695       print TESTFILE "extern $rettype (*foobarbaz) $args;\n";
 696       print TESTFILE "extern __typeof__ (&$fname) foobarbaz;\n";
 697       close (TESTFILE);
 698
 699       compiletest ($fnamebase, "Test for type of function $fname",
 700                    "Function \"$fname\" has incorrect type.", $res, 0);
 701     } elsif (/^variable *({([^}]*)}|([a-zA-Z0-9_]*)) ([a-zA-Z0-9_]*)/) {
 702       my($type) = "$2$3";
 703       my($vname) = "$4";
 704       my($res) = $missing;
 705
 706       # Remember that this name is allowed.
 707       push @allow, $vname;
 708
 709       # Generate a program to test for availability of this function.
 710       open (TESTFILE, ">$fnamebase.c");
 711       print TESTFILE "$prepend";
 712       print TESTFILE "#include <$h>\n";
 713       # print TESTFILE "#undef $fname\n";
 714       print TESTFILE "$type *foobarbaz = &$vname;\n";
 715       close (TESTFILE);
 716
 717       $res = compiletest ($fnamebase, "Test availability of variable $vname",
 718                           "Variable \"$vname\" is not available.", $res, 0);
 719
 720       # Generate a program to test for the type of this function.
 721       open (TESTFILE, ">$fnamebase.c");
 722       print TESTFILE "$prepend";
 723       print TESTFILE "#include <$h>\n";
 724       # print TESTFILE "#undef $fname\n";
 725       print TESTFILE "extern $type $vname;\n";
 726       close (TESTFILE);
 727
 728       compiletest ($fnamebase, "Test for type of variable $fname",
 729                    "Variable \"$vname\" has incorrect type.", $res, 0);
 730     } elsif (/^macro-function *({([^}]*)}|([a-zA-Z0-9_]*)) ([a-zA-Z0-9_]*) ([(].*[)])/) {
 731       my($rettype) = "$2$3";
 732       my($fname) = "$4";
 733       my($args) = "$5";
 734       my($res) = $missing;
 735
 736       # Remember that this name is allowed.
 737       push @allow, $fname;
 738
 739       # Generate a program to test for availability of this function.
 740       open (TESTFILE, ">$fnamebase.c");
 741       print TESTFILE "$prepend";
 742       print TESTFILE "#include <$h>\n";
 743       print TESTFILE "#ifndef $fname\n";
 744       print TESTFILE "$rettype (*foobarbaz) $args = $fname;\n";
 745       print TESTFILE "#endif\n";
 746       close (TESTFILE);
 747
 748       $res = compiletest ($fnamebase, "Test availability of function $fname",
 749                           "Function \"$fname\" is not available.", $res, 0);
 750
 751       # Generate a program to test for the type of this function.
 752       open (TESTFILE, ">$fnamebase.c");
 753       print TESTFILE "$prepend";
 754       print TESTFILE "#include <$h>\n";
 755       print TESTFILE "#ifndef $fname\n";
 756       print TESTFILE "extern $rettype (*foobarbaz) $args;\n";
 757       print TESTFILE "extern __typeof__ (&$fname) foobarbaz;\n";
 758       print TESTFILE "#endif\n";
 759       close (TESTFILE);
 760
 761       compiletest ($fnamebase, "Test for type of function $fname",
 762                    "Function \"$fname\" has incorrect type.", $res, 0);
 763     } elsif (/^macro-str *([^    ]*) *(\".*\")/) {
 764       # The above regex doesn't handle a \" in a string.
 765       my($macro) = "$1";
 766       my($string) = "$2";
 767       my($res) = $missing;
 768
 769       # Remember that this name is allowed.
 770       push @allow, $macro;
 771
 772       # Generate a program to test for availability of this macro.
 773       open (TESTFILE, ">$fnamebase.c");
 774       print TESTFILE "$prepend";
 775       print TESTFILE "#include <$h>\n";
 776       print TESTFILE "#ifndef $macro\n";
 777       print TESTFILE "# error \"Macro $macro not defined\"\n";
 778       print TESTFILE "#endif\n";
 779       close (TESTFILE);
 780
 781       compiletest ($fnamebase, "Test availability of macro $macro",
 782                    "Macro \"$macro\" is not available.", $missing, 0);
 783
 784       # Generate a program to test for the value of this macro.
 785       open (TESTFILE, ">$fnamebase.c");
 786       print TESTFILE "$prepend";
 787       print TESTFILE "#include <$h>\n";
 788       # We can't include <string.h> here.
 789       print TESTFILE "extern int (strcmp)(const char *, const char *);\n";
 790       print TESTFILE "int main (void) { return (strcmp) ($macro, $string) != 0;}\n";
 791       close (TESTFILE);
 792
 793       $res = runtest ($fnamebase, "Testing for value of macro $macro",
 794                       "Macro \"$macro\" has not the right value.", $res);
 795     } elsif (/^optional-macro *([^      ]*)/) {
 796       my($macro) = "$1";
 797
 798       # Remember that this name is allowed.
 799       push @allow, $macro;
 800
 801       # Generate a program to test for availability of this macro.
 802       open (TESTFILE, ">$fnamebase.c");
 803       print TESTFILE "$prepend";
 804       print TESTFILE "#include <$h>\n";
 805       print TESTFILE "#ifndef $macro\n";
 806       print TESTFILE "# error \"Macro $macro not defined\"\n";
 807       print TESTFILE "#endif\n";
 808       close (TESTFILE);
 809
 810       compiletest ($fnamebase, "Test availability of macro $macro",
 811                    "NOT PRESENT", $missing, 1);
 812     } elsif (/^macro *([a-zA-Z0-9_]*) *([>=<]+) ([A-Za-z0-9_]*)/) {
 813       my($macro) = "$1";
 814       my($op) = $2;
 815       my($value) = $3;
 816       my($res) = $missing;
 817
 818       # Remember that this name is allowed.
 819       push @allow, $macro;
 820
 821       # Generate a program to test for availability of this macro.
 822       open (TESTFILE, ">$fnamebase.c");
 823       print TESTFILE "$prepend";
 824       print TESTFILE "#include <$h>\n";
 825       print TESTFILE "#ifndef $macro\n";
 826       print TESTFILE "# error \"Macro $macro not defined\"\n";
 827       print TESTFILE "#endif\n";
 828       close (TESTFILE);
 829
 830       $res = compiletest ($fnamebase, "Test availability of macro $macro",
 831                           "Macro \"$macro\" is not available.", $res, 0);
 832
 833       if ($value ne "") {
 834         # Generate a program to test for the value of this constant.
 835         open (TESTFILE, ">$fnamebase.c");
 836         print TESTFILE "$prepend";
 837         print TESTFILE "#include <$h>\n";
 838         # Negate the value since 0 means ok
 839         print TESTFILE "int main (void) { return !($macro $op $value); }\n";
 840         close (TESTFILE);
 841
 842         $res = runtest ($fnamebase, "Testing for value of constant $macro",
 843                         "Macro \"$macro\" has not the right value.", $res);
 844       }
 845     } elsif (/^macro *([^       ]*)/) {
 846       my($macro) = "$1";
 847
 848       # Remember that this name is allowed.
 849       push @allow, $macro;
 850
 851       # Generate a program to test for availability of this macro.
 852       open (TESTFILE, ">$fnamebase.c");
 853       print TESTFILE "$prepend";
 854       print TESTFILE "#include <$h>\n";
 855       print TESTFILE "#ifndef $macro\n";
 856       print TESTFILE "# error \"Macro $macro not defined\"\n";
 857       print TESTFILE "#endif\n";
 858       close (TESTFILE);
 859
 860       compiletest ($fnamebase, "Test availability of macro $macro",
 861                    "Macro \"$macro\" is not available.", $missing, 0);
 862     } elsif (/^allow-header *(.*)/) {
 863       my($pattern) = $1;
 864       if ($seenheader{$pattern} != 1) {
 865         push @allowheader, $pattern;
 866         $seenheader{$pattern} = 1;
 867       }
 868       next control;
 869     } elsif (/^allow *(.*)/) {
 870       my($pattern) = $1;
 871       push @allow, $pattern;
 872       next control;
 873     } else {
 874       # printf ("line is `%s'\n", $_);
 875       next control;
 876     }
 877
 878     printf ("\n");
 879   }
 880   close (CONTROL);
 881
 882   # Read the data files for the header files which are allowed to be included.
 883   while ($#allowheader >= 0) {
 884     my($ah) = pop @allowheader;
 885
 886     open (ALLOW, "$CC -E -D$dialect - < data/$ah-data |");
 887     acontrol: while (<ALLOW>) {
 888       next acontrol if (/^#/);
 889       next acontrol if (/^[     ]*$/);
 890
 891       if (/^element *({([^}]*)}|([^ ]*)) *({([^}]*)}|([^ ]*)) *([A-Za-z0-9_]*) *(.*)/) {
 892         push @allow, $7;
 893       } elsif (/^constant *([a-zA-Z0-9_]*) *([A-Za-z0-9_]*)?/) {
 894         push @allow, $1;
 895       } elsif (/^typed-constant *([a-zA-Z0-9_]*) *({([^}]*)}|([^ ]*)) *([A-Za-z0-9_]*)?/) {
 896         push @allow, 1;
 897       } elsif (/^type *({([^}]*)|([a-zA-Z0-9_]*))/) {
 898         my($type) = "$2$3";
 899
 900         # Remember that this name is allowed.
 901         if ($type =~ /^struct *(.*)/) {
 902           push @allow, $1;
 903         } elsif ($type =~ /^union *(.*)/) {
 904           push @allow, $1;
 905         } else {
 906           push @allow, $type;
 907         }
 908       } elsif (/^function *({([^}]*)}|([a-zA-Z0-9_]*)) [(][*]([a-zA-Z0-9_]*) ([(].*[)])/) {
 909         push @allow, $4;
 910       } elsif (/^function *({([^}]*)}|([a-zA-Z0-9_]*)) ([a-zA-Z0-9_]*) ([(].*[)])/) {
 911         push @allow, $4;
 912       } elsif (/^variable *({([^}]*)}|([a-zA-Z0-9_]*)) ([a-zA-Z0-9_]*)/) {
 913         push @allow, $4;
 914       } elsif (/^macro-function *({([^}]*)}|([a-zA-Z0-9_]*)) ([a-zA-Z0-9_]*) ([(].*[)])/) {
 915         push @allow, $4;
 916       } elsif (/^macro *([^     ]*)/) {
 917         push @allow, $1;
 918       } elsif (/^allow-header *(.*)/) {
 919         if ($seenheader{$1} != 1) {
 920           push @allowheader, $1;
 921           $seenheader{$1} = 1;
 922         }
 923       } elsif (/^allow *(.*)/) {
 924         push @allow, $1;
 925       }
 926     }
 927     close (ALLOW);
 928   }
 929
 930   # Now check the namespace.
 931   printf ("  Checking the namespace of \"%s\"... ", $h);
 932   if ($missing) {
 933     ++$skipped;
 934     printf ("SKIP\n");
 935   } else {
 936     checknamespace ($h, $fnamebase, @allow);
 937   }
 938
 939   printf ("\n\n");
 940 }
 941
 942 printf "-" x 76 . "\n";
 943 printf ("  Total number of tests   : %4d\n", $total);
 944
 945 printf ("  Number of known failures: %4d (", $known);
 946 $percent = ($known * 100) / $total;
 947 if ($known > 0 && $percent < 1.0) {
 948   printf (" <1%%)\n");
 949 } else {
 950   printf ("%3d%%)\n", $percent);
 951 }
 952
 953 printf ("  Number of failed tests  : %4d (", $errors);
 954 $percent = ($errors * 100) / $total;
 955 if ($errors > 0 && $percent < 1.0) {
 956   printf (" <1%%)\n");
 957 } else {
 958   printf ("%3d%%)\n", $percent);
 959 }
 960
 961 printf ("  Number of skipped tests : %4d (", $skipped);
 962 $percent = ($skipped * 100) / $total;
 963 if ($skipped > 0 && $percent < 1.0) {
 964   printf (" <1%%)\n");
 965 } else {
 966   printf ("%3d%%)\n", $percent);
 967 }
 968
 969 exit $errors != 0;