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/select.h", "sys/resource.h",
  19               "sys/msg.h", "sys/mman.h", "sys/ipc.h", "syslog.h", "stropts.h",
  20               "strings.h", "string.h", "stdlib.h", "stdio.h", "stdint.h",
  21               "stddef.h", "stdarg.h", "spawn.h", "signal.h", "setjmp.h",
  22               "semaphore.h", "search.h", "sched.h", "regex.h", "pwd.h",
  23               "pthread.h", "poll.h", "nl_types.h", "netinet/tcp.h",
  24               "netinet/in.h", "net/if.h", "netdb.h", "ndbm.h", "mqueue.h",
  25               "monetary.h", "math.h", "locale.h", "libgen.h", "limits.h",
  26               "langinfo.h", "iso646.h", "inttypes.h", "iconv.h", "grp.h",
  27               "glob.h", "ftw.h", "fnmatch.h", "fmtmsg.h", "float.h", "fcntl.h",
  28               "errno.h", "dlfcn.h", "dirent.h", "ctype.h", "cpio.h",
  29               "assert.h", "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       my($maybe_opaque) = 0;
 594
 595       # Remember that this name is allowed.
 596       if ($type =~ /^struct *(.*)/) {
 597         push @allow, $1;
 598       } elsif ($type =~ /^union *(.*)/) {
 599         push @allow, $1;
 600       } else {
 601         push @allow, $type;
 602         $maybe_opaque = 1;
 603       }
 604
 605       # Remember that this name is allowed.
 606       push @allow, $type;
 607
 608       # Generate a program to test for the availability of this constant.
 609       open (TESTFILE, ">$fnamebase.c");
 610       print TESTFILE "$prepend";
 611       print TESTFILE "#include <$h>\n";
 612       if ($maybe_opaque == 1) {
 613         print TESTFILE "$type *a;\n";
 614       } else {
 615         print TESTFILE "$type a;\n";
 616       }
 617       close (TESTFILE);
 618
 619       compiletest ($fnamebase, "Testing for type $type",
 620                    "NOT AVAILABLE", $missing, 1);
 621     } elsif (/^type *({([^}]*)|([a-zA-Z0-9_]*))/) {
 622       my($type) = "$2$3";
 623       my($maybe_opaque) = 0;
 624
 625       # Remember that this name is allowed.
 626       if ($type =~ /^struct *(.*)/) {
 627         push @allow, $1;
 628       } elsif ($type =~ /^union *(.*)/) {
 629         push @allow, $1;
 630       } else {
 631         push @allow, $type;
 632         $maybe_opaque = 1;
 633       }
 634
 635       # Remember that this name is allowed.
 636       push @allow, $type;
 637
 638       # Generate a program to test for the availability of this constant.
 639       open (TESTFILE, ">$fnamebase.c");
 640       print TESTFILE "$prepend";
 641       print TESTFILE "#include <$h>\n";
 642       if ($maybe_opaque == 1) {
 643         print TESTFILE "$type *a;\n";
 644       } else {
 645         print TESTFILE "$type a;\n";
 646       }
 647       close (TESTFILE);
 648
 649       compiletest ($fnamebase, "Testing for type $type",
 650                    "Type \"$type\" not available.", $missing, 0);
 651     } elsif (/^optional-function *({([^}]*)}|([a-zA-Z0-9_]*)) [(][*]([a-zA-Z0-9_]*) ([(].*[)])/) {
 652       my($rettype) = "$2$3";
 653       my($fname) = "$4";
 654       my($args) = "$5";
 655       my($res) = $missing;
 656
 657       # Remember that this name is allowed.
 658       push @allow, $fname;
 659
 660       # Generate a program to test for availability of this function.
 661       open (TESTFILE, ">$fnamebase.c");
 662       print TESTFILE "$prepend";
 663       print TESTFILE "#include <$h>\n";
 664       # print TESTFILE "#undef $fname\n";
 665       print TESTFILE "$rettype (*(*foobarbaz) $args = $fname;\n";
 666       close (TESTFILE);
 667
 668       $res = compiletest ($fnamebase, "Test availability of function $fname",
 669                           "NOT AVAILABLE", $res, 1);
 670
 671       if ($res == 0 || $missing == 1) {
 672         # Generate a program to test for the type of this function.
 673         open (TESTFILE, ">$fnamebase.c");
 674         print TESTFILE "$prepend";
 675         print TESTFILE "#include <$h>\n";
 676         # print TESTFILE "#undef $fname\n";
 677         print TESTFILE "extern $rettype (*(*foobarbaz) $args;\n";
 678         print TESTFILE "extern __typeof__ (&$fname) foobarbaz;\n";
 679         close (TESTFILE);
 680
 681         compiletest ($fnamebase, "Test for type of function $fname",
 682                      "Function \"$fname\" has incorrect type.", $res, 0);
 683       }
 684     } elsif (/^function *({([^}]*)}|([a-zA-Z0-9_]*)) [(][*]([a-zA-Z0-9_]*) ([(].*[)])/) {
 685       my($rettype) = "$2$3";
 686       my($fname) = "$4";
 687       my($args) = "$5";
 688       my($res) = $missing;
 689
 690       # Remember that this name is allowed.
 691       push @allow, $fname;
 692
 693       # Generate a program to test for availability of this function.
 694       open (TESTFILE, ">$fnamebase.c");
 695       print TESTFILE "$prepend";
 696       print TESTFILE "#include <$h>\n";
 697       # print TESTFILE "#undef $fname\n";
 698       print TESTFILE "$rettype (*(*foobarbaz) $args = $fname;\n";
 699       close (TESTFILE);
 700
 701       $res = compiletest ($fnamebase, "Test availability of function $fname",
 702                           "Function \"$fname\" is not available.", $res, 0);
 703
 704       # Generate a program to test for the type of this function.
 705       open (TESTFILE, ">$fnamebase.c");
 706       print TESTFILE "$prepend";
 707       print TESTFILE "#include <$h>\n";
 708       # print TESTFILE "#undef $fname\n";
 709       print TESTFILE "extern $rettype (*(*foobarbaz) $args;\n";
 710       print TESTFILE "extern __typeof__ (&$fname) foobarbaz;\n";
 711       close (TESTFILE);
 712
 713       compiletest ($fnamebase, "Test for type of function $fname",
 714                    "Function \"$fname\" has incorrect type.", $res, 0);
 715     } elsif (/^optional-function *({([^}]*)}|([a-zA-Z0-9_]*)) ([a-zA-Z0-9_]*) ([(].*[)])/) {
 716       my($rettype) = "$2$3";
 717       my($fname) = "$4";
 718       my($args) = "$5";
 719       my($res) = $missing;
 720
 721       # Remember that this name is allowed.
 722       push @allow, $fname;
 723
 724       # Generate a program to test for availability of this function.
 725       open (TESTFILE, ">$fnamebase.c");
 726       print TESTFILE "$prepend";
 727       print TESTFILE "#include <$h>\n";
 728       # print TESTFILE "#undef $fname\n";
 729       print TESTFILE "$rettype (*foobarbaz) $args = $fname;\n";
 730       close (TESTFILE);
 731
 732       $res = compiletest ($fnamebase, "Test availability of function $fname",
 733                           "NOT AVAILABLE", $res, 1);
 734
 735       if ($res == 0 || $missing != 0) {
 736         # Generate a program to test for the type of this function.
 737         open (TESTFILE, ">$fnamebase.c");
 738         print TESTFILE "$prepend";
 739         print TESTFILE "#include <$h>\n";
 740         # print TESTFILE "#undef $fname\n";
 741         print TESTFILE "extern $rettype (*foobarbaz) $args;\n";
 742         print TESTFILE "extern __typeof__ (&$fname) foobarbaz;\n";
 743         close (TESTFILE);
 744
 745         compiletest ($fnamebase, "Test for type of function $fname",
 746                      "Function \"$fname\" has incorrect type.", $res, 0);
 747       }
 748     } elsif (/^function *({([^}]*)}|([a-zA-Z0-9_]*)) ([a-zA-Z0-9_]*) ([(].*[)])/) {
 749       my($rettype) = "$2$3";
 750       my($fname) = "$4";
 751       my($args) = "$5";
 752       my($res) = $missing;
 753
 754       # Remember that this name is allowed.
 755       push @allow, $fname;
 756
 757       # Generate a program to test for availability of this function.
 758       open (TESTFILE, ">$fnamebase.c");
 759       print TESTFILE "$prepend";
 760       print TESTFILE "#include <$h>\n";
 761       # print TESTFILE "#undef $fname\n";
 762       print TESTFILE "$rettype (*foobarbaz) $args = $fname;\n";
 763       close (TESTFILE);
 764
 765       $res = compiletest ($fnamebase, "Test availability of function $fname",
 766                           "Function \"$fname\" is not available.", $res, 0);
 767
 768       # Generate a program to test for the type of this function.
 769       open (TESTFILE, ">$fnamebase.c");
 770       print TESTFILE "$prepend";
 771       print TESTFILE "#include <$h>\n";
 772       # print TESTFILE "#undef $fname\n";
 773       print TESTFILE "extern $rettype (*foobarbaz) $args;\n";
 774       print TESTFILE "extern __typeof__ (&$fname) foobarbaz;\n";
 775       close (TESTFILE);
 776
 777       compiletest ($fnamebase, "Test for type of function $fname",
 778                    "Function \"$fname\" has incorrect type.", $res, 0);
 779     } elsif (/^variable *({([^}]*)}|([a-zA-Z0-9_]*)) ([a-zA-Z0-9_]*)/) {
 780       my($type) = "$2$3";
 781       my($vname) = "$4";
 782       my($res) = $missing;
 783
 784       # Remember that this name is allowed.
 785       push @allow, $vname;
 786
 787       # Generate a program to test for availability of this function.
 788       open (TESTFILE, ">$fnamebase.c");
 789       print TESTFILE "$prepend";
 790       print TESTFILE "#include <$h>\n";
 791       # print TESTFILE "#undef $fname\n";
 792       print TESTFILE "$type *foobarbaz = &$vname;\n";
 793       close (TESTFILE);
 794
 795       $res = compiletest ($fnamebase, "Test availability of variable $vname",
 796                           "Variable \"$vname\" is not available.", $res, 0);
 797
 798       # Generate a program to test for the type of this function.
 799       open (TESTFILE, ">$fnamebase.c");
 800       print TESTFILE "$prepend";
 801       print TESTFILE "#include <$h>\n";
 802       # print TESTFILE "#undef $fname\n";
 803       print TESTFILE "extern $type $vname;\n";
 804       close (TESTFILE);
 805
 806       compiletest ($fnamebase, "Test for type of variable $fname",
 807                    "Variable \"$vname\" has incorrect type.", $res, 0);
 808     } elsif (/^macro-function *({([^}]*)}|([a-zA-Z0-9_]*)) ([a-zA-Z0-9_]*) ([(].*[)])/) {
 809       my($rettype) = "$2$3";
 810       my($fname) = "$4";
 811       my($args) = "$5";
 812       my($res) = $missing;
 813
 814       # Remember that this name is allowed.
 815       push @allow, $fname;
 816
 817       # Generate a program to test for availability of this function.
 818       open (TESTFILE, ">$fnamebase.c");
 819       print TESTFILE "$prepend";
 820       print TESTFILE "#include <$h>\n";
 821       print TESTFILE "#ifndef $fname\n";
 822       print TESTFILE "$rettype (*foobarbaz) $args = $fname;\n";
 823       print TESTFILE "#endif\n";
 824       close (TESTFILE);
 825
 826       $res = compiletest ($fnamebase, "Test availability of function $fname",
 827                           "Function \"$fname\" is not available.", $res, 0);
 828
 829       # Generate a program to test for the type of this function.
 830       open (TESTFILE, ">$fnamebase.c");
 831       print TESTFILE "$prepend";
 832       print TESTFILE "#include <$h>\n";
 833       print TESTFILE "#ifndef $fname\n";
 834       print TESTFILE "extern $rettype (*foobarbaz) $args;\n";
 835       print TESTFILE "extern __typeof__ (&$fname) foobarbaz;\n";
 836       print TESTFILE "#endif\n";
 837       close (TESTFILE);
 838
 839       compiletest ($fnamebase, "Test for type of function $fname",
 840                    "Function \"$fname\" has incorrect type.", $res, 0);
 841     } elsif (/^macro-str *([^    ]*) *(\".*\")/) {
 842       # The above regex doesn't handle a \" in a string.
 843       my($macro) = "$1";
 844       my($string) = "$2";
 845       my($res) = $missing;
 846
 847       # Remember that this name is allowed.
 848       push @allow, $macro;
 849
 850       # Generate a program to test for availability of this macro.
 851       open (TESTFILE, ">$fnamebase.c");
 852       print TESTFILE "$prepend";
 853       print TESTFILE "#include <$h>\n";
 854       print TESTFILE "#ifndef $macro\n";
 855       print TESTFILE "# error \"Macro $macro not defined\"\n";
 856       print TESTFILE "#endif\n";
 857       close (TESTFILE);
 858
 859       compiletest ($fnamebase, "Test availability of macro $macro",
 860                    "Macro \"$macro\" is not available.", $missing, 0);
 861
 862       # Generate a program to test for the value of this macro.
 863       open (TESTFILE, ">$fnamebase.c");
 864       print TESTFILE "$prepend";
 865       print TESTFILE "#include <$h>\n";
 866       # We can't include <string.h> here.
 867       print TESTFILE "extern int (strcmp)(const char *, const char *);\n";
 868       print TESTFILE "int main (void) { return (strcmp) ($macro, $string) != 0;}\n";
 869       close (TESTFILE);
 870
 871       $res = runtest ($fnamebase, "Testing for value of macro $macro",
 872                       "Macro \"$macro\" has not the right value.", $res);
 873     } elsif (/^optional-macro *([^      ]*)/) {
 874       my($macro) = "$1";
 875
 876       # Remember that this name is allowed.
 877       push @allow, $macro;
 878
 879       # Generate a program to test for availability of this macro.
 880       open (TESTFILE, ">$fnamebase.c");
 881       print TESTFILE "$prepend";
 882       print TESTFILE "#include <$h>\n";
 883       print TESTFILE "#ifndef $macro\n";
 884       print TESTFILE "# error \"Macro $macro not defined\"\n";
 885       print TESTFILE "#endif\n";
 886       close (TESTFILE);
 887
 888       compiletest ($fnamebase, "Test availability of macro $macro",
 889                    "NOT PRESENT", $missing, 1);
 890     } elsif (/^macro *([a-zA-Z0-9_]*) *([>=<]+) ([A-Za-z0-9_]*)/) {
 891       my($macro) = "$1";
 892       my($op) = $2;
 893       my($value) = $3;
 894       my($res) = $missing;
 895
 896       # Remember that this name is allowed.
 897       push @allow, $macro;
 898
 899       # Generate a program to test for availability of this macro.
 900       open (TESTFILE, ">$fnamebase.c");
 901       print TESTFILE "$prepend";
 902       print TESTFILE "#include <$h>\n";
 903       print TESTFILE "#ifndef $macro\n";
 904       print TESTFILE "# error \"Macro $macro not defined\"\n";
 905       print TESTFILE "#endif\n";
 906       close (TESTFILE);
 907
 908       $res = compiletest ($fnamebase, "Test availability of macro $macro",
 909                           "Macro \"$macro\" is not available.", $res, 0);
 910
 911       if ($value ne "") {
 912         # Generate a program to test for the value of this constant.
 913         open (TESTFILE, ">$fnamebase.c");
 914         print TESTFILE "$prepend";
 915         print TESTFILE "#include <$h>\n";
 916         # Negate the value since 0 means ok
 917         print TESTFILE "int main (void) { return !($macro $op $value); }\n";
 918         close (TESTFILE);
 919
 920         $res = runtest ($fnamebase, "Testing for value of constant $macro",
 921                         "Macro \"$macro\" has not the right value.", $res);
 922       }
 923     } elsif (/^macro *([^       ]*)/) {
 924       my($macro) = "$1";
 925
 926       # Remember that this name is allowed.
 927       push @allow, $macro;
 928
 929       # Generate a program to test for availability of this macro.
 930       open (TESTFILE, ">$fnamebase.c");
 931       print TESTFILE "$prepend";
 932       print TESTFILE "#include <$h>\n";
 933       print TESTFILE "#ifndef $macro\n";
 934       print TESTFILE "# error \"Macro $macro not defined\"\n";
 935       print TESTFILE "#endif\n";
 936       close (TESTFILE);
 937
 938       compiletest ($fnamebase, "Test availability of macro $macro",
 939                    "Macro \"$macro\" is not available.", $missing, 0);
 940     } elsif (/^allow-header *(.*)/) {
 941       my($pattern) = $1;
 942       if ($seenheader{$pattern} != 1) {
 943         push @allowheader, $pattern;
 944         $seenheader{$pattern} = 1;
 945       }
 946       next control;
 947     } elsif (/^allow *(.*)/) {
 948       my($pattern) = $1;
 949       push @allow, $pattern;
 950       next control;
 951     } else {
 952       # printf ("line is `%s'\n", $_);
 953       next control;
 954     }
 955
 956     printf ("\n");
 957   }
 958   close (CONTROL);
 959
 960   # Read the data files for the header files which are allowed to be included.
 961   while ($#allowheader >= 0) {
 962     my($ah) = pop @allowheader;
 963
 964     open (ALLOW, "$CC -E -D$dialect - < data/$ah-data |");
 965     acontrol: while (<ALLOW>) {
 966       next acontrol if (/^#/);
 967       next acontrol if (/^[     ]*$/);
 968
 969       if (/^element *({([^}]*)}|([^ ]*)) *({([^}]*)}|([^ ]*)) *([A-Za-z0-9_]*) *(.*)/) {
 970         push @allow, $7;
 971       } elsif (/^constant *([a-zA-Z0-9_]*) *([A-Za-z0-9_]*)?/) {
 972         push @allow, $1;
 973       } elsif (/^typed-constant *([a-zA-Z0-9_]*) *({([^}]*)}|([^ ]*)) *([A-Za-z0-9_]*)?/) {
 974         push @allow, 1;
 975       } elsif (/^type *({([^}]*)|([a-zA-Z0-9_]*))/) {
 976         my($type) = "$2$3";
 977
 978         # Remember that this name is allowed.
 979         if ($type =~ /^struct *(.*)/) {
 980           push @allow, $1;
 981         } elsif ($type =~ /^union *(.*)/) {
 982           push @allow, $1;
 983         } else {
 984           push @allow, $type;
 985         }
 986       } elsif (/^function *({([^}]*)}|([a-zA-Z0-9_]*)) [(][*]([a-zA-Z0-9_]*) ([(].*[)])/) {
 987         push @allow, $4;
 988       } elsif (/^function *({([^}]*)}|([a-zA-Z0-9_]*)) ([a-zA-Z0-9_]*) ([(].*[)])/) {
 989         push @allow, $4;
 990       } elsif (/^variable *({([^}]*)}|([a-zA-Z0-9_]*)) ([a-zA-Z0-9_]*)/) {
 991         push @allow, $4;
 992       } elsif (/^macro-function *({([^}]*)}|([a-zA-Z0-9_]*)) ([a-zA-Z0-9_]*) ([(].*[)])/) {
 993         push @allow, $4;
 994       } elsif (/^macro *([^     ]*)/) {
 995         push @allow, $1;
 996       } elsif (/^allow-header *(.*)/) {
 997         if ($seenheader{$1} != 1) {
 998           push @allowheader, $1;
 999           $seenheader{$1} = 1;
1000         }
1001       } elsif (/^allow *(.*)/) {
1002         push @allow, $1;
1003       }
1004     }
1005     close (ALLOW);
1006   }
1007
1008   # Now check the namespace.
1009   printf ("  Checking the namespace of \"%s\"... ", $h);
1010   if ($missing) {
1011     ++$skipped;
1012     printf ("SKIP\n");
1013   } else {
1014     checknamespace ($h, $fnamebase, @allow);
1015   }
1016
1017   printf ("\n\n");
1018 }
1019
1020 printf "-" x 76 . "\n";
1021 printf ("  Total number of tests   : %4d\n", $total);
1022
1023 printf ("  Number of known failures: %4d (", $known);
1024 $percent = ($known * 100) / $total;
1025 if ($known > 0 && $percent < 1.0) {
1026   printf (" <1%%)\n");
1027 } else {
1028   printf ("%3d%%)\n", $percent);
1029 }
1030
1031 printf ("  Number of failed tests  : %4d (", $errors);
1032 $percent = ($errors * 100) / $total;
1033 if ($errors > 0 && $percent < 1.0) {
1034   printf (" <1%%)\n");
1035 } else {
1036   printf ("%3d%%)\n", $percent);
1037 }
1038
1039 printf ("  Number of skipped tests : %4d (", $skipped);
1040 $percent = ($skipped * 100) / $total;
1041 if ($skipped > 0 && $percent < 1.0) {
1042   printf (" <1%%)\n");
1043 } else {
1044   printf ("%3d%%)\n", $percent);
1045 }
1046
1047 exit $errors != 0;