2000-05-02 Andreas Jaeger <aj@suse.de>
[kopensolaris-gnu/glibc.git] / 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;