Define COBJMACROS. Fixes compilation on Windows.
[wine] / tools / winapi / winapi_test
1 #!/usr/bin/perl -w
2
3 # Copyright 2002 Patrik Stridvall
4 #
5 # This library is free software; you can redistribute it and/or
6 # modify it under the terms of the GNU Lesser General Public
7 # License as published by the Free Software Foundation; either
8 # version 2.1 of the License, or (at your option) any later version.
9 #
10 # This library is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13 # Lesser General Public License for more details.
14 #
15 # You should have received a copy of the GNU Lesser General Public
16 # License along with this library; if not, write to the Free Software
17 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
18 #
19
20 use strict;
21
22 BEGIN {
23     $0 =~ m%^(.*?/?tools)/winapi/winapi_test$%;
24     require "$1/winapi/setup.pm";
25 }
26
27 use config qw(
28     &file_type &files_skip &files_filter
29     $current_dir $wine_dir $winapi_dir $winapi_check_dir
30 );
31 use output qw($output);
32 use winapi_test_options qw($options);
33
34 if($options->progress) {
35     $output->enable_progress;
36 } else {
37     $output->disable_progress;
38 }
39
40 use c_parser;
41 use tests qw($tests);
42 use type;
43 use util qw(replace_file);
44
45 my @tests = ();
46 if ($options->pack) {
47     push @tests, "pack";
48 }
49
50 my @files = ();
51 {
52     my %files;
53
54     my %test_dirs;
55     foreach my $test (@tests) {
56         my @test_dirs = $tests->get_test_dirs($test);
57         foreach my $test_dir (@test_dirs) {
58             my @headers = $tests->get_section($test_dir, $test, "header");
59             foreach my $header (@headers) {
60                 $files{"include/$header"} = 1;
61             }
62         }
63     }
64
65     foreach my $test (@tests) {
66         my @test_dirs = $tests->get_test_dirs($test);
67         foreach my $test_dir (@test_dirs) {
68             my @headers = $tests->get_section($test_dir, $test, "header");
69             foreach my $header (@headers) {
70                 if($files{"include/$header"}) {
71                     push @files, "include/$header";
72                     $files{"include/$header"} = 0;
73                 }
74             }
75         }
76     }
77 }
78
79 if (0) {
80     my $file = "tests.dat";
81
82     $file .= "2"; # FIXME: For tests
83
84     open(OUT, "> $winapi_dir/$file") || die "$winapi_dir/$file: $!\n";
85
86     my $x = 0;
87     my @test_dirs = $tests->get_test_dirs();
88     foreach my $test_dir (@test_dirs) {
89         print OUT "\n" if $x++;
90         print OUT "%%%$test_dir\n";
91         print OUT "\n";
92
93         my $y = 0;
94         my @tests = $tests->get_tests($test_dir);
95         foreach my $test (@tests) {
96             print OUT "\n" if $y++;
97             print OUT "%%$test\n";
98             print OUT "\n";
99
100             my @types;
101
102             my $z = 0;
103             my @sections = $tests->get_sections($test_dir, $test);
104             foreach my $section (@sections) {
105                 my @lines = $tests->get_section($test_dir, $test, $section);
106
107                 if ($section =~ /^(?:struct|type)$/) {
108                     foreach my $line (@lines) {
109                         push @types, $line;
110                     }
111                     next;
112                 }
113
114                 print OUT "\n" if $z++;
115                 print OUT "%$section\n";
116                 print OUT "\n";
117                 foreach my $line (@lines) {
118                         print OUT "$line\n";
119                 }
120             }
121
122             @types = sort { $x = $a; $y = $b; $x =~ s/^!//;  $y =~ s/^!//; $x cmp $y } @types;
123
124             print OUT "\n" if $z++;
125             print OUT "%type\n";
126             print OUT "\n";
127             foreach my $type (@types) {
128                 print OUT "$type\n";
129             }
130         }
131     }
132
133     close(OUT);
134     exit(0);
135 }
136
137
138 my %file2types;
139
140 my $progress_output;
141 my $progress_current = 0;
142 my $progress_max = scalar(@files);
143
144 ########################################################################
145 # find_type
146
147 my %type_name2type;
148
149 my %defines = (
150     "ANYSIZE_ARRAY" => 1,
151     "CCHDEVICENAME" => 32,
152     "CCHILDREN_TITLEBAR+1" => 6,
153     "ELF_VENDOR_SIZE" => 4,
154     "EXCEPTION_MAXIMUM_PARAMETERS" => 15,
155     "HW_PROFILE_GUIDLEN" => 39,
156     "IMAGE_NUMBEROF_DIRECTORY_ENTRIES" => 16,
157     "IMAGE_SIZEOF_SHORT_NAME" => 8,
158     "LF_FACESIZE" => 32,
159     "LF_FULLFACESIZE" => 64,
160     "MAXIMUM_SUPPORTED_EXTENSION" => 512,
161     "MAX_GOPHER_DISPLAY_TEXT + 1" => 129,
162     "MAX_GOPHER_LOCATOR_LENGTH + 1" => 654,
163     "MAX_PATH" => 260,
164     "MAX_PROFILE_LEN" => 80,
165     "NUM_POINTS" => 3,
166     "OFS_MAXPATHNAME" => 128,
167     "SIZE_OF_80387_REGISTERS" => 80,
168     "TOKEN_SOURCE_LENGTH" => 8,
169 );
170
171 my %align_kludge_reported = ("FILETIME" => 1, "LARGE_INTEGER" => 1);
172 my %size_kludge_reported = ("FILETIME" => 1, "LARGE_INTEGER" => 1);
173 my %size_parse_reported;
174
175 sub _find_align_kind_size {
176     my $type_name = shift;
177
178     local $_ = $type_name;
179
180     my $count;
181     my $bits;
182     if (s/^(.*?)\s*(?:\[\s*(.*?)\s*\]|:(\d+))?$/$1/) {
183         $count = $2;
184         $bits = $3;
185     }
186
187     my $align;
188     my $kind;
189     my $size;
190     if (0) {
191         # Nothing
192     } elsif (/\*+$/) {
193         $align = 4;
194         $kind = "pointer";
195         $size = 4;
196     } elsif(/^(?:(signed|unsigned)\s+)?(?:__int8|char|byte)$/) {
197         $align = 1;
198         $kind = defined($1) ? $1 : "signed";
199         $size = 1;
200     } elsif (/^(?:(signed|unsigned)\s+)?(?:__int16|short(?:\s+int)?)$/) {
201         $align = 2;
202         $kind = defined($1) ? $1 : "signed";
203         $size = 2;
204     } elsif (/^(?:wchar_t)$/) {
205         $align = 2;
206         $kind = "signed";
207         $size = 2;
208     } elsif (/^(signed|unsigned)$/) {
209         $align = 4;
210         $kind = defined($1) ? $1 : "signed";
211         $size = 4;
212     } elsif (/^(?:(signed|unsigned)\s+)?(?:__int32|int|long(?:\s+int)?)$/) {
213         $align = 4;
214         $kind = defined($1) ? $1 : "signed";
215         $size = 4;
216     } elsif (/^(?:float)$/) {
217         $align = 4;
218         $kind = "float";
219         $size = 4;
220     } elsif (/^(?:(signed|unsigned)\s+)?__int64$/) {
221         $align = 8;
222         $kind = defined($1) ? $1 : "signed";
223         $size = 8;
224     } elsif (/^(?:double|DOUBLE|DATE)$/) {
225         $align = 8;
226         $kind = "float";
227         $size = 8;
228     } elsif (/^(?:long\s+double)$/) {
229         $align = 4;
230         $kind = "float";
231         $size = 12;
232     } elsif (/^H(?:DC|BITMAP|BRUSH|ICON|INSTANCE|KEY|MENU|METAFILE|RESULT|WND)$/) {
233         $align = 4;
234         $kind = "unsigned";
235         $size = 4;
236     } elsif (/^LP(?:BYTE|CSTR|CWSTR|DWORD|STR|VOID|WSTR)$/) {
237         $align = 4;
238         $kind = "pointer";
239         $size = 4;
240     } elsif (/^(?:FILETIME)$/) {
241         $align = 4;
242         $kind = "struct";
243         $size = 8;
244     } elsif (/^(?:VOID)$/) {
245         $align = 4;
246         $kind = "signed";
247         $size = 4;
248     } elsif (/^(?:SHORT)$/) {
249         $align = 2;
250         $kind = "unsigned";
251         $size = 2;
252     } elsif (/^(?:BYTE)$/) {
253         $align = 1;
254         $kind = "unsigned";
255         $size = 1;
256     } elsif (/^(?:DWORD)$/) {
257         $align = 4;
258         $kind = "unsigned";
259         $size = 4;
260     } elsif (/^(?:WORD)$/) {
261         $align = 2;
262         $kind = "unsigned";
263         $size = 2;
264     } elsif (/^(?:INT64|LONG64|LONGLONG)$/) {
265         $align = 8;
266         $kind = "signed";
267         $size = 8;
268     } elsif (/^(?:UINT64|ULONG64|DWORD64|ULONGLONG|DWORDLONG)$/) {
269         $align = 8;
270         $kind = "unsigned";
271         $size = 8;
272     } elsif (/^(?:LARGE_INTEGER)$/) {
273         $align = 8;
274         $kind = "union";
275         $size = 8;
276     } elsif (/^(struct|union)$/) {
277         $kind = $1;
278         if (!$size_parse_reported{$_}) {
279             $output->write("$type_name: can't parse type\n");
280             $size_parse_reported{$_} = 1;
281         }
282     } elsif (/^\w+\s*\((?:\s*CALLBACK|\s*NTAPI|\s*WINAPI)?\s*\*\s*\)\s*\(.*?\)$/) {
283         $align = 4;
284         $kind = "pointer";
285         $size = 4;
286     }
287
288     my $align2;
289     if (defined(my $type = $type_name2type{$_})) {
290         $align2 = $type->align;
291     }
292
293     if (!defined($align)) {
294         $align = $align2;
295     } elsif (defined($align2) && !$align_kludge_reported{$_}) {
296         $align_kludge_reported{$_} = 1;
297         $output->write("$type_name: type needn't be kludged\n");
298     }
299
300     if (!defined($align)) {
301         # $output->write("$type_name: can't find type\n");
302     }
303
304     my $size2;
305     if (defined(my $type = $type_name2type{$_})) {
306         $size2 = $type->size;
307     }
308
309     if (!defined($size)) {
310         $size = $size2;
311     } elsif (defined($size2) && !$size_kludge_reported{$_}) {
312         $size_kludge_reported{$_} = 1;
313         $output->write("$type_name: type needn't be kludged\n");
314     }
315
316     if (!defined($size)) {
317         # $output->write("$type_name: can't find type\n");
318     } elsif (defined($count)) {
319         if ($count =~ /^\d+$/) {
320             $size *= int($count);
321         } elsif (defined(my $count2 = $defines{$count})) {
322             $size *= int($count2);
323         } else {
324             $output->write("$type_name: can't parse type ('$_') ('$count')\n");
325             $size = undef;
326         }
327     } elsif (defined($bits)) {
328         $size = -$bits;
329     }
330
331     return ($align, $kind, $size);
332 }
333
334 sub find_align {
335     my $type_name = shift;
336     (my $align, my $kind, my $size) = _find_align_kind_size($type_name);
337     return $align;
338 }
339
340 sub find_kind {
341     my $type_name = shift;
342     (my $align, my $kind, my $size) = _find_align_kind_size($type_name);
343
344     return $kind;
345 }
346
347 sub find_size {
348     my $type_name = shift;
349     (my $align, my $kind, my $size) = _find_align_kind_size($type_name);
350     return $size;
351 }
352
353 foreach my $file (@files) {
354     $progress_current++;
355
356     {
357         open(IN, "< $wine_dir/$file");
358         local $/ = undef;
359         $_ = <IN>;
360         close(IN);
361     }
362
363     my $max_line = 0;
364     {
365       local $_ = $_;
366       while(s/^.*?\n//) { $max_line++; }
367       if($_) { $max_line++; }
368     }
369
370     my $parser = new c_parser($file);
371
372     my $line;
373     my $type;
374     my @packs = (4);
375
376     my $update_output = sub {
377         my $progress = "";
378         my $prefix = "";
379
380         $progress .= "$file (file $progress_current of $progress_max)";
381         $prefix .= "$file: ";
382
383         if(defined($line)) {
384             $progress .= ": line $line of $max_line";
385         }
386
387         $output->progress($progress);
388         $output->prefix($prefix);
389     };
390
391     &$update_output();
392
393     my $found_line = sub {
394         $line = shift;
395
396         &$update_output;
397     };
398     $parser->set_found_line_callback($found_line);
399
400     my $found_preprocessor = sub {
401         my $begin_line = shift;
402         my $begin_column = shift;
403         my $preprocessor = shift;
404
405         #print "found_preprocessor: $begin_line: [$_]\n";
406         if ($preprocessor =~ /^\#\s*include\s+[\"<]pshpack(\d+)\.h[\">]$/) {
407             push @packs, $1;
408             #print "found pack $1 on line $begin_line\n";
409         } elsif($preprocessor =~ /^\#\s*include\s+[\"<]poppack\.h[\">]$/) {
410             pop @packs;
411             #print "found poppack on line $begin_line\n";
412         }
413
414         return 1;
415     };
416     $parser->set_found_preprocessor_callback($found_preprocessor);
417
418     my $found_type = sub {
419         $type = shift;
420
421         &$update_output();
422
423         my $name = $type->name;
424         $file2types{$file}{$name} = $type;
425
426         $type->set_find_align_callback(\&find_align);
427         $type->set_find_kind_callback(\&find_kind);
428         $type->set_find_size_callback(\&find_size);
429
430         my $pack = $packs[$#packs];
431         if (!defined($type->pack) && $type->kind =~ /^(?:struct|union)$/) {
432             $type->pack($pack);
433         }
434         my $size = $type->size();
435         if (defined($size)) {
436             my $max_field_base_size = 0;
437
438             foreach my $field ($type->fields()) {
439                 my $field_type_name = $field->type_name;
440                 my $field_name = $field->name;
441                 my $field_size = $field->size;
442                 my $field_base_size = $field->base_size;
443                 my $field_offset = $field->offset;
444                 my $field_align = $field->align;
445
446                 # $output->write("$name: $field_type_name: $field_name: $field_offset: $field_size($field_base_size): $field_align\n");
447             }
448             # $output->write("$name: $size\n");
449
450             $type_name2type{$name} = $type;
451         } else {
452             # $output->write("$name: can't find size\n");
453         }
454
455         return 1;
456     };
457     $parser->set_found_type_callback($found_type);
458
459     {
460         my $line = 1;
461         my $column = 0;
462         if(!$parser->parse_c_file(\$_, \$line, \$column)) {
463             $output->write("can't parse file\n");
464         }
465     }
466
467     $output->prefix("");
468 }
469
470 ########################################################################
471 # output_header
472
473 sub output_header {
474     local *OUT = shift; 
475
476     my $test_dir = shift;
477     my @tests = @{(shift)};
478
479     print OUT "/* File generated automatically from tools/winapi/test.dat; do not edit! */\n";
480     print OUT "/* This file can be copied, modified and distributed without restriction. */\n";
481     print OUT "\n";
482
483     print OUT "/*\n";
484     foreach my $test (@tests) {
485         my @description = $tests->get_section($test_dir, $test, "description");
486         foreach my $description (@description) {
487             print OUT " * $description\n";
488         }
489     }
490     print OUT " */\n";
491     print OUT "\n";
492
493     print OUT "#define WINVER 0x0501\n";
494     print OUT "#define _WIN32_IE 0x0501\n";
495     print OUT "#define _WIN32_WINNT 0x0501\n";
496     print OUT "\n";
497     print OUT "#define WINE_NOWINSOCK\n";
498     print OUT "\n";
499     foreach my $test (@tests) {
500         my @includes = $tests->get_section($test_dir, $test, "include");
501         foreach my $include (@includes) {
502             print OUT "#include $include\n";
503         }
504     }
505     print OUT "\n";
506     print OUT "#include \"wine/test.h\"\n";
507     print OUT "\n";
508
509     print OUT "/***********************************************************************\n";
510     print OUT " * Compability macros\n";
511     print OUT " */\n";
512     print OUT "\n";
513     print OUT "#define DWORD_PTR UINT_PTR\n";
514     print OUT "#define LONG_PTR INT_PTR\n";
515     print OUT "#define ULONG_PTR UINT_PTR\n";
516     print OUT "\n";
517
518     print OUT "/***********************************************************************\n";
519     print OUT " * Windows API extension\n";
520     print OUT " */\n";
521     print OUT "\n";
522     print OUT "#if defined(_MSC_VER) && (_MSC_VER >= 1300) && defined(__cplusplus)\n";
523     print OUT "# define FIELD_ALIGNMENT(type, field) __alignof(((type*)0)->field)\n";
524     print OUT "#elif defined(__GNUC__)\n";
525     print OUT "# define FIELD_ALIGNMENT(type, field) __alignof__(((type*)0)->field)\n";
526     print OUT "#else\n";
527     print OUT "/* FIXME: Not sure if is possible to do without compiler extension */\n";
528     print OUT "#endif\n";
529     print OUT "\n";
530     print OUT "#if defined(_MSC_VER) && (_MSC_VER >= 1300) && defined(__cplusplus)\n";
531     print OUT "# define _TYPE_ALIGNMENT(type) __alignof(type)\n";
532     print OUT "#elif defined(__GNUC__)\n";
533     print OUT "# define _TYPE_ALIGNMENT(type) __alignof__(type)\n";
534     print OUT "#else\n";
535     print OUT "/*\n";
536     print OUT " * FIXME: Not sure if is possible to do without compiler extension\n";
537     print OUT " *        (if type is not just a name that is, if so the normal)\n";
538     print OUT " *         TYPE_ALIGNMENT can be used)\n";
539     print OUT " */\n";
540     print OUT "#endif\n";
541     print OUT "\n";
542     print OUT "#if !defined(TYPE_ALIGNMENT) && defined(_TYPE_ALIGNMENT)\n";
543     print OUT "# define TYPE_ALIGNMENT _TYPE_ALIGNMENT\n";
544     print OUT "#endif\n";
545     print OUT "\n";
546
547     print OUT "/***********************************************************************\n";
548     print OUT " * Test helper macros\n";
549     print OUT " */\n";
550     print OUT "\n";
551     print OUT "#ifdef FIELD_ALIGNMENT\n";
552     print OUT "# define TEST_FIELD_ALIGNMENT(type, field, align) \\\n";
553     print OUT "   ok(FIELD_ALIGNMENT(type, field) == align, \\\n";
554     print OUT "       \"FIELD_ALIGNMENT(\" #type \", \" #field \") == %d (expected \" #align \")\\n\", \\\n";
555     print OUT "           FIELD_ALIGNMENT(type, field))\n";
556     print OUT "#else\n";
557     print OUT "# define TEST_FIELD_ALIGNMENT(type, field, align) do { } while (0)\n";
558     print OUT "#endif\n";
559     print OUT "\n";
560     print OUT "#define TEST_FIELD_OFFSET(type, field, offset) \\\n";
561     print OUT "    ok(FIELD_OFFSET(type, field) == offset, \\\n";
562     print OUT "        \"FIELD_OFFSET(\" #type \", \" #field \") == %ld (expected \" #offset \")\\n\", \\\n";
563     print OUT "             FIELD_OFFSET(type, field))\n";
564     print OUT "\n";
565     print OUT "#ifdef _TYPE_ALIGNMENT\n";
566     print OUT "#define TEST__TYPE_ALIGNMENT(type, align) \\\n";
567     print OUT "    ok(_TYPE_ALIGNMENT(type) == align, \"TYPE_ALIGNMENT(\" #type \") == %d (expected \" #align \")\\n\", _TYPE_ALIGNMENT(type))\n";
568     print OUT "#else\n";
569     print OUT "# define TEST__TYPE_ALIGNMENT(type, align) do { } while (0)\n";
570     print OUT "#endif\n";
571     print OUT "\n";
572     print OUT "#ifdef TYPE_ALIGNMENT\n";
573     print OUT "#define TEST_TYPE_ALIGNMENT(type, align) \\\n";
574     print OUT "    ok(TYPE_ALIGNMENT(type) == align, \"TYPE_ALIGNMENT(\" #type \") == %d (expected \" #align \")\\n\", TYPE_ALIGNMENT(type))\n";
575     print OUT "#else\n";
576     print OUT "# define TEST_TYPE_ALIGNMENT(type, align) do { } while (0)\n";
577     print OUT "#endif\n";
578     print OUT "\n";
579     print OUT "#define TEST_TYPE_SIZE(type, size) \\\n";
580     print OUT "    ok(sizeof(type) == size, \"sizeof(\" #type \") == %d (expected \" #size \")\\n\", sizeof(type))\n";
581     print OUT "\n";
582     print OUT "/***********************************************************************\n";
583     print OUT " * Test macros\n";
584     print OUT " */\n";
585     print OUT "\n";
586     print OUT "#define TEST_FIELD(type, field_type, field_name, field_offset, field_size, field_align) \\\n";
587     print OUT "  TEST_TYPE_SIZE(field_type, field_size); \\\n";
588     print OUT "  TEST_FIELD_ALIGNMENT(type, field_name, field_align); \\\n";
589     print OUT "  TEST_FIELD_OFFSET(type, field_name, field_offset); \\\n";
590     print OUT "\n";
591     print OUT "#define TEST_TYPE(type, size, align) \\\n";
592     print OUT "  TEST_TYPE_ALIGNMENT(type, align); \\\n";
593     print OUT "  TEST_TYPE_SIZE(type, size)\n";
594     print OUT "\n";
595     print OUT "#define TEST_TYPE_POINTER(type, size, align) \\\n";
596     print OUT "    TEST__TYPE_ALIGNMENT(*(type)0, align); \\\n";
597     print OUT "    TEST_TYPE_SIZE(*(type)0, size)\n";
598     print OUT "\n";
599     print OUT "#define TEST_TYPE_SIGNED(type) \\\n";
600     print OUT "    ok((type) -1 < 0, \"(\" #type \") -1 < 0\\n\");\n";
601     print OUT "\n";
602     print OUT "#define TEST_TYPE_UNSIGNED(type) \\\n";
603     print OUT "     ok((type) -1 > 0, \"(\" #type \") -1 > 0\\n\");\n";
604     print OUT "\n";
605 }
606
607 ########################################################################
608 # output_footer
609
610 sub output_footer {
611     local *OUT = shift; 
612
613     my $test_dir = shift;
614     my @tests = @{(shift)};
615
616     print OUT "START_TEST(generated)\n";
617     print OUT "{\n";
618     foreach my $test (@tests) {
619         print OUT "    test_$test();\n";
620     }
621     print OUT "}\n";
622 }
623
624 ########################################################################
625 # output_test_pack_type
626
627 sub output_test_pack_type {
628     local *OUT = shift;
629
630     my $type_name2type = shift;
631     my $type_name2optional = shift;
632     my $type_name2optional_fields = shift;
633     my $type_name = shift;
634     my $type = shift;
635
636     my $optional_fields = $$type_name2optional_fields{$type_name};
637
638     my $type_align = $type->align;
639     my $type_pack = $type->pack;
640     my $type_size = $type->size;
641     my $type_kind = $type->kind;
642
643     if (defined($type_pack)) {
644         print OUT "    /* $type_name (pack $type_pack) */\n";
645     } else {
646         print OUT "    /* $type_name */\n";
647     }
648
649     if (!scalar(keys(%$optional_fields)) && defined($type_align) && defined($type_size)) {
650         print OUT "    TEST_TYPE($type_name, $type_size, $type_align);\n";
651     }
652
653     if ($type_kind eq "float") {
654         # Nothing
655     } elsif ($type_kind eq "pointer") {
656         my $dereference_type;
657         $dereference_type = sub {
658             my $type = shift;
659
660             my @fields = $type->fields;
661             my $type_name2 =$fields[0]->type_name;
662
663             if ($type_name2 =~ s/\s*\*$//) {
664                 my $type2 = $$type_name2type{$type_name2};
665                 if (defined($type2)) {
666                     return $type2;
667                 } else {
668                     if ($type_name2 !~ /^(?:PVOID|VOID|void)$/) {
669                         $output->write("$type_name2: warning: type not found 1\n");
670                     }
671                     return undef;
672                 }
673             } elsif ($type_name2 =~ /^\w+$/) {
674                 my $type2 = $$type_name2type{$type_name2};
675                 if (defined($type2)) {
676                     return &$dereference_type($type2);
677                 } else {
678                     $output->write("$type_name2: warning: type not found\n");
679                     return undef;
680                 }
681             } elsif ($type_name2 =~ /^\w+\s*\((?:\s*CALLBACK|\s*NTAPI|\s*WINAPI)?\s*\*\s*\)\s*\(.*?\)$/) {
682                 return undef;
683             } else {
684                 $output->write("$type_name2: warning: type can't be parsed\n");
685                 return undef;
686             }
687         };
688
689         my $type2 = &$dereference_type($type);
690         if (defined($type2)) {
691             my $type_name2 = $type2->name;
692             my $type_align2 = $type2->align;
693             my $type_size2 = $type2->size;
694
695             my $optional = $$type_name2optional{$type_name};
696             my $optional_fields2 = $$type_name2optional_fields{$type_name2};
697
698             if (!$optional && !scalar(keys(%$optional_fields2)) && defined($type_align2) && defined($type_size2)) {
699                 print OUT "    TEST_TYPE_POINTER($type_name, $type_size2, $type_align2);\n";
700             } else {
701                 # $output->write("$type_name: warning: type size not found\n");
702             }
703         }
704     } elsif ($type_kind eq "signed") {
705         print OUT "    TEST_TYPE_SIGNED($type_name);\n";
706     } elsif ($type_kind eq "unsigned") {
707         print OUT "    TEST_TYPE_UNSIGNED($type_name);\n";
708     }
709 }
710
711 sub output_test_pack_fields {
712     local *OUT = shift;
713
714     my $type_name2type = shift;
715     my $type_name2optional = shift;
716     my $type_name2optional_fields = shift;
717     my $type_name = shift;
718     my $type = shift;
719     my $offset = shift;
720
721     my $optional_fields = $$type_name2optional_fields{$type_name};
722
723     foreach my $field ($type->fields()) {
724         my $field_type_name = $field->type_name;
725         my $field_name = $field->name;
726         my $field_size = $field->size;
727         my $field_offset = $field->offset;
728         my $field_align = $field->align;
729
730         next if $field_name eq "" || (defined($field_size) && $field_size < 0);
731
732         if ($$optional_fields{$field_name}) {
733             # Nothing
734         } elsif (defined($field_size) && defined($field_offset)) {
735             $field_offset += $offset;
736             if ($field_name eq "DUMMYSTRUCTNAME") {
737                 print OUT "#ifdef NONAMELESSSTRUCT\n";
738                 print OUT "    TEST_FIELD($type_name, $field_type_name, $field_name, ";
739                 print OUT "$field_offset, $field_size, $field_align);\n";
740                 print OUT "#else\n";
741                 output_test_pack_fields(\*OUT, $type_name2type, $type_name2optional, $type_name2optional_fields,
742                                         $type_name, $$type_name2type{$field_type_name}, $field_offset); 
743                 print OUT "#endif\n";
744             } else {
745                 print OUT "    TEST_FIELD($type_name, $field_type_name, $field_name, ";
746                 print OUT "$field_offset, $field_size, $field_align);\n";
747             }
748         } else {
749             # $output->write("$type_name: $field_type_name: $field_name: test not generated (offset not defined)\n");
750         }
751     }
752 }
753
754 ########################################################################
755 # output_test_pack
756
757 sub output_test_pack {
758     local *OUT = shift;
759
760     my $test_dir = shift;
761     my $test = shift;
762
763     my $type_names_used = shift;
764
765     $output->prefix("$test_dir: $test: ");
766
767     my @headers = $tests->get_section($test_dir, $test, "header");
768     my @type_names = $tests->get_section($test_dir, $test, "type");
769
770     my %type_name2optional;
771     my %type_name2optional_fields;
772
773     foreach my $_type_name (@type_names) {
774         my $type_name = $_type_name;
775
776         if ($type_name =~ s/^!//) {
777             $type_name2optional{$type_name}++;
778         }
779
780         my $optional_fields = {};
781         if ($type_name =~ s/:\s*(.*?)$//) {
782             my @fields = split /\s+/, $1;
783             foreach my $field (@fields) {
784                 if ($field =~ s/^!//) {
785                     $$optional_fields{$field}++;
786                 }
787             }
788         } 
789
790         $type_name2optional_fields{$type_name} = $optional_fields;
791     }
792
793     foreach my $header (@headers) {
794         my $type_name2type = $file2types{"include/$header"};
795         
796         foreach my $_type_name (@type_names) {
797             my $type_name = $_type_name;
798
799             my $skip = ($type_name =~ s/^!//);
800             $type_name =~ s/:.*?$//;
801             my $type = $$type_name2type{$type_name};
802             if (!defined($type)) {
803                 next;
804             }
805             $$type_names_used{$type_name} = $skip ? -1 : 1;
806             next if $skip;
807
808             print OUT "static void test_${test}_$type_name(void)\n";
809             print OUT "{\n";
810             output_test_pack_type(\*OUT, $type_name2type, \%type_name2optional, \%type_name2optional_fields,
811                                   $type_name, $type);
812             output_test_pack_fields(\*OUT, $type_name2type, \%type_name2optional, \%type_name2optional_fields, 
813                                     $type_name, $type, 0);
814             print OUT "}\n";
815             print OUT "\n";
816         }
817     }
818 }
819
820
821 ########################################################################
822 # output_file
823
824 sub output_file {
825     local *OUT = shift;
826
827     my $test_dir = shift;
828     my @tests = @{(shift)};
829
830     my $type_names_used = shift;
831
832     output_header(\*OUT, $test_dir, \@tests);
833
834     foreach my $test (@tests) {
835         my %type_names_used2;
836
837         if ($test eq "pack") {
838             output_test_pack(\*OUT, $test_dir, $test, \%type_names_used2);
839         } else {
840             die "no such test ($test)\n";
841         }
842
843         print OUT "static void test_$test(void)\n";
844         print OUT "{\n";
845         foreach my $type_name (sort(keys(%type_names_used2))) {
846             $$type_names_used{$type_name} = $type_names_used2{$type_name};
847             if ($type_names_used2{$type_name} > 0) {
848                 print OUT "    test_${test}_$type_name();\n";
849             }
850         }
851         print OUT "}\n";
852         print OUT "\n";
853     }
854
855     output_footer(\*OUT, $test_dir, \@tests);
856
857     return 1;
858 }
859
860 ########################################################################
861 # main
862
863 my %type_names_used = ();
864
865 my @test_dirs = $tests->get_test_dirs();
866 foreach my $test_dir (@test_dirs) {
867     my $file = "$wine_dir/$test_dir/generated.c";
868     replace_file($file, \&output_file, $test_dir, \@tests, \%type_names_used);
869 }
870
871 foreach my $header (sort(keys(%file2types))) {
872     $output->prefix("$header: ");
873     $header =~ s%^include/%%;
874     my $type_name2type = $file2types{"include/$header"};
875     foreach my $_type_name (sort(keys(%$type_name2type))) {
876         my $type_name = $_type_name;
877
878         if (!exists($type_names_used{$type_name})) {
879             $output->write("$type_name: type not used\n");
880         }
881     }
882 }
883
884 $output->prefix("$winapi_dir/tests.dat: ");
885 foreach my $type_name (sort(keys(%type_names_used))) {
886     my $found = 0;
887     foreach my $header (sort(keys(%file2types))) {
888         my $type_name2type = $file2types{"include/$header"};
889         if (exists($type_name2type{$type_name})) {
890             $found = 1;
891         }
892     }
893
894     if (!$found) {
895         $output->write("$type_name: type not used\n");
896     }
897 }