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 # These are the ISO C99 keywords.
  26 @keywords = ('auto', 'break', 'case', 'char', 'const', 'continue', 'default',
  27              'do', 'double', 'else', 'enum', 'extern', 'float', 'for', 'goto',
  28              'if', 'inline', 'int', 'long', 'register', 'restrict', 'return',
  29              'short', 'signed', 'sizeof', 'static', 'struct', 'switch',
  30              'typedef', 'union', 'unsigned', 'void', 'volatile', 'while');
  31
  32 # Some headers need a bit more attention.
  33 $mustprepend{'regex.h'} = "#include <sys/types.h>\n";
  34
  35 # Make an hash table from this information.
  36 while ($#keywords) {
  37   $iskeyword{pop (@keywords)} = 1;
  38 }
  39
  40 $tmpdir = "/tmp";
  41
  42 $verbose = 1;
  43
  44 $total = 0;
  45 $skipped = 0;
  46 $errors = 0;
  47
  48 #$dialect = "ISO";
  49 #$dialect = "POSIX";
  50 #$dialect = "XPG3";
  51 #$dialect = "XPG4";
  52 $dialect = "UNIX98";
  53
  54
  55 sub poorfnmatch {
  56   my($pattern, $string) = @_;
  57   my($strlen) = length ($string);
  58   my($res);
  59
  60   if (substr ($pattern, 0, 1) eq '*') {
  61     my($patlen) = length ($pattern) - 1;
  62     $res = ($strlen >= $patlen
  63             && substr ($pattern, -$patlen, $patlen) eq substr ($string, -$patlen, $patlen));
  64   } elsif (substr ($pattern, -1, 1) eq '*') {
  65     my($patlen) = length ($pattern) - 1;
  66     $res = ($strlen >= $patlen
  67             && substr ($pattern, 0, $patlen) eq substr ($string, 0, $patlen));
  68   } else {
  69     $res = $pattern eq $string;
  70   }
  71   return $res;
  72 }
  73
  74
  75 sub compiletest
  76 {
  77   my($fnamebase, $msg, $errmsg, $skip) = @_;
  78   my($result) = $skip;
  79   my($printlog) = 0;
  80
  81   ++$total;
  82   printf ("  $msg...");
  83
  84   if ($skip != 0) {
  85     ++$skipped;
  86     printf (" SKIP\n");
  87   } else {
  88     $ret = system "$CC $CFLAGS -c $fnamebase.c -o $fnamebase.o > $fnamebase.out 2>&1";
  89     if ($ret != 0) {
  90       printf (" FAIL\n");
  91       if ($verbose != 0) {
  92         printf ("    $errmsg  Compiler message:\n");
  93         $printlog = 1;
  94       }
  95       ++$errors;
  96       $result = 1;
  97     } else {
  98       printf (" OK\n");
  99       if ($verbose > 1 && -s "$fnamebase.out") {
 100         # We print all warnings issued.
 101         $printlog = 1;
 102       }
 103     }
 104     if ($printlog != 0) {
 105       printf ("    " . "-" x 71 . "\n");
 106       open (MESSAGE, "< $fnamebase.out");
 107       while (<MESSAGE>) {
 108         printf ("    %s", $_);
 109       }
 110       close (MESSAGE);
 111       printf ("    " . "-" x 71 . "\n");
 112     }
 113   }
 114   unlink "$fnamebase.c";
 115   unlink "$fnamebase.o";
 116   unlink "$fnamebase.out";
 117
 118   $result;
 119 }
 120
 121
 122 sub runtest
 123 {
 124   my($fnamebase, $msg, $errmsg, $skip) = @_;
 125   my($result) = $skip;
 126   my($printlog) = 0;
 127
 128   ++$total;
 129   printf ("  $msg...");
 130
 131   if ($skip != 0) {
 132     ++$skipped;
 133     printf (" SKIP\n");
 134   } else {
 135     $ret = system "$CC $CFLAGS -o $fnamebase $fnamebase.c > $fnamebase.out 2>&1";
 136     if ($ret != 0) {
 137       printf (" FAIL\n");
 138       if ($verbose != 0) {
 139         printf ("    $errmsg  Compiler message:\n");
 140         $printlog = 1;
 141       }
 142       ++$errors;
 143       $result = 1;
 144     } else {
 145       # Now run the program.  If the exit code is not zero something is wrong.
 146       $result = system "$fnamebase > $fnamebase.out2 2>&1";
 147       if ($result == 0) {
 148         printf (" OK\n");
 149         if ($verbose > 1 && -s "$fnamebase.out") {
 150           # We print all warnings issued.
 151           $printlog = 1;
 152           system "cat $fnamebase.out2 >> $fnamebase.out";
 153         }
 154       } else {
 155         printf (" FAIL\n");
 156         $printlog = 1;
 157         unlink "$fnamebase.out";
 158         rename "$fnamebase.out2", "$fnamebase.out";
 159       }
 160     }
 161     if ($printlog != 0) {
 162       printf ("    " . "-" x 71 . "\n");
 163       open (MESSAGE, "< $fnamebase.out");
 164       while (<MESSAGE>) {
 165         printf ("    %s", $_);
 166       }
 167       close (MESSAGE);
 168       printf ("    " . "-" x 71 . "\n");
 169     }
 170   }
 171   unlink "$fnamebase";
 172   unlink "$fnamebase.c";
 173   unlink "$fnamebase.o";
 174   unlink "$fnamebase.out";
 175   unlink "$fnamebase.out2";
 176
 177   $result;
 178 }
 179
 180
 181 sub newtoken {
 182   my($token, $nerrors, @allow) = @_;
 183   my($idx);
 184
 185   if ($token =~ /^[0-9_]/ || $iskeyword{$token}) {
 186     return $nerrors;
 187   }
 188
 189   for ($idx = 0; $idx <= $#allow; ++$idx) {
 190     if (poorfnmatch ($allow[$idx], $token)) {
 191       return $nerrors;
 192     }
 193   }
 194
 195   ++$nerrors;
 196   if ($nerrors == 1) {
 197     printf ("FAIL\n    " . "-" x 72 . "\n");
 198   }
 199   printf ("    Namespace violation: \"%s\"\n", $token);
 200   return $nerrors;
 201 }
 202
 203
 204 sub checknamespace {
 205   my($h, $fnamebase, @allow) = @_;
 206   my($nerrors) = 0;
 207
 208   ++$total;
 209
 210   # Generate a program to get the contents of this header.
 211   open (TESTFILE, ">$fnamebase.c");
 212   print TESTFILE "#include <$h>\n";
 213   close (TESTFILE);
 214
 215   open (CONTENT, "$CC $CFLAGS -E $fnamebase.c -P -Wp,-dN | sed -e '/^# [1-9]/d' -e '/^[[:space:]]*\$/d' |");
 216   loop: while (<CONTENT>) {
 217     next loop if (/^#undef /);
 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-header *(.*)/) {
 654       my($pattern) = $1;
 655       push @allowheader, $pattern;
 656       next control;
 657     } elsif (/^allow *(.*)/) {
 658       my($pattern) = $1;
 659       push @allow, $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         # XXX We should have a test for recursive dependencies here.
 710         push @allowheader, $1;
 711       }
 712     }
 713     close (ALLOW);
 714   }
 715
 716   # Now check the namespace.
 717   printf ("  Checking the namespace of \"%s\"... ", $h);
 718   if ($missing) {
 719     ++$skipped;
 720     printf ("SKIP\n");
 721   } else {
 722     checknamespace ($h, $fnamebase, @allow);
 723   }
 724
 725   printf ("\n\n");
 726 }
 727
 728 printf "-" x 76 . "\n";
 729 printf ("  Total number of tests  : %4d\n", $total);
 730 printf ("  Number of failed tests : %4d (%3d%%)\n", $errors, ($errors * 100) / $total);
 731 printf ("  Number of skipped tests: %4d (%3d%%)\n", $skipped, ($skipped * 100) / $total);
 732
 733 exit $errors != 0;