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