conform/conformtest.pl

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