conform/conformtest.pl

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