conform/conformtest.pl

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