conform/conformtest.pl

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