shlwapi/tests: Fix some test failures on Win2000.
[wine/hramrach.git] / tools / winapi / make_parser.pm
blob773c5f30fdee660f8803ab3f1cc35dd2229490b7
2 # Copyright 1999, 2000, 2001 Patrik Stridvall
4 # This library is free software; you can redistribute it and/or
5 # modify it under the terms of the GNU Lesser General Public
6 # License as published by the Free Software Foundation; either
7 # version 2.1 of the License, or (at your option) any later version.
9 # This library is distributed in the hope that it will be useful,
10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 # Lesser General Public License for more details.
14 # You should have received a copy of the GNU Lesser General Public
15 # License along with this library; if not, write to the Free Software
16 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
19 package make_parser;
21 use strict;
23 use setup qw($current_dir $wine_dir $winapi_dir);
25 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
26 require Exporter;
28 @ISA = qw(Exporter);
29 @EXPORT = qw();
30 @EXPORT_OK = qw($directory $tool $file $line $message);
32 use vars qw($directory $tool $file $line $message);
34 use output qw($output);
35 use options qw($options);
38 #sub command($);
39 #sub gcc_output($$);
40 #sub ld_output($$);
41 #sub make_output($$);
42 #sub winebuild_output($$);
43 #sub wmc_output($$);
44 #sub wrc_output($$);
47 ########################################################################
48 # global
49 ########################################################################
51 my $current;
52 my $function;
54 ########################################################################
55 # error
56 ########################################################################
58 sub error($) {
59 my $where = shift;
61 if(!defined($where)) {
62 $where = "";
65 my $context;
66 if($tool) {
67 $context = "$tool";
68 if($where) {
69 $context .= "<$where>";
71 } else {
72 if($where) {
73 $context = "<$where>";
74 } else {
75 $context = "<>";
79 if(defined($tool)) {
80 $output->write("$directory: $context: can't parse output: '$current'\n");
81 } else {
82 $output->write("$directory: $context: can't parse output: '$current'\n");
84 exit 1;
87 ########################################################################
88 # make_output
89 ########################################################################
91 sub make_output($$) {
92 my $level = shift;
93 local $_ = shift;
95 $file = "";
96 $message = "";
98 if(/^\*\*\* \[(.*?)\] Error (\d+)$/) {
99 # Nothing
100 } elsif(/^\*\*\* Error code (\d+)$/) {
101 # Nothing
102 } elsif(/^\*\*\* Warning:\s+/) { #
103 if(/^File \`(.+?)\' has modification time in the future \((.+?) > \(.+?\)\)$/) {
104 # Nothing
105 } else {
106 error("make_output");
108 } elsif(/^\`(.*?)\' is up to date.$/) {
109 # Nothing
110 } elsif(/^\[(.*?)\] Error (\d+) \(ignored\)$/) {
111 # Nothing
112 } elsif(/^don\'t know how to make (.*?)\. Stop$/) {
113 $message = "$_";
114 } elsif(/^(Entering|Leaving) directory \`(.*?)\'$/) {
115 if($1 eq "Entering") {
116 $directory = $2;
117 } else {
118 $directory = "";
121 my @components;
122 foreach my $component (split(/\//, $directory)) {
123 if($component eq "wine") {
124 @components = ();
125 } else {
126 push @components, $component;
129 $directory = join("/", @components);
130 } elsif(/^(.*?) is older than (.*?), please rerun (.*?)\$/) {
131 # Nothing
132 } elsif(/^Nothing to be done for \`(.*?)\'\.$/) {
133 # Nothing
134 } elsif(s/^warning:\s+//) {
135 if(/^Clock skew detected. Your build may be incomplete.$/) {
136 # Nothing
137 } else {
138 error("make_output");
140 } elsif(/^Stop in (.*?)\.$/) {
141 # Nothing
142 } elsif(/^\s*$/) {
143 # Nothing
144 } else {
145 error("make_output");
150 ########################################################################
151 # ar_command
152 ########################################################################
154 sub ar_command($) {
155 local $_ = shift;
157 my $read_files;
158 my $write_files;
160 if(/rc\s+(\S+)(\s+\S+)+$/) {
161 $write_files = [$1];
162 $read_files = $2;
163 $read_files =~ s/^\s*//;
164 $read_files = [split(/\s+/, $read_files)];
165 } else {
166 error("ar_command");
169 return ($read_files, $write_files);
172 ########################################################################
173 # as_command
174 ########################################################################
176 sub as_command($) {
177 local $_ = shift;
179 my $read_files;
180 my $write_files;
182 if(/-o\s+(\S+)\s+(\S+)$/) {
183 $write_files = [$1];
184 $read_files = [$2];
185 } else {
186 error("as_command");
189 return ($read_files, $write_files);
192 ########################################################################
193 # bision_command
194 ########################################################################
196 sub bison_command($) {
197 local $_ = shift;
199 return ([], []);
202 ########################################################################
203 # cd_command
204 ########################################################################
206 sub cd_command($) {
207 local $_ = shift;
209 return ([], []);
212 ########################################################################
213 # cd_output
214 ########################################################################
216 sub cd_output($) {
217 local $_ = shift;
219 if(/^(.*?): No such file or directory/) {
220 $message = "directory '$1' doesn't exist";
224 ########################################################################
225 # flex_command
226 ########################################################################
228 sub flex_command($) {
229 local $_ = shift;
231 return ([], []);
234 ########################################################################
235 # for_command
236 ########################################################################
238 sub for_command($) {
239 local $_ = shift;
241 return ([], []);
244 ########################################################################
245 # gcc_command
246 ########################################################################
248 sub gcc_command($) {
249 my $read_files;
250 my $write_files;
252 if(/-o\s+(\S+)\s+(\S+)$/) {
253 my $write_file = $1;
254 my $read_file = $2;
256 $write_file =~ s%^\./%%;
257 $read_file =~ s%^\./%%;
259 $write_files = [$write_file];
260 $read_files = [$read_file];
261 } elsif(/-o\s+(\S+)/) {
262 my $write_file = $1;
264 $write_file =~ s%^\./%%;
266 $write_files = [$write_file];
267 $read_files = ["<???>"];
268 } elsif(/^-shared.*?-o\s+(\S+)/) {
269 my $write_file = $1;
271 $write_file =~ s%^\./%%;
273 $write_files = [$write_file];
274 $read_files = ["<???>"];
275 } else {
276 error("gcc_command");
279 return ($read_files, $write_files);
282 ########################################################################
283 # gcc_output
284 ########################################################################
286 sub gcc_output($$) {
287 $file = shift;
288 local $_ = shift;
290 if(s/^(\d+):\s+//) {
291 $line = $1;
292 if(s/^warning:\s+//) {
293 my $suppress = 0;
295 if(/^((?:signed |unsigned )?(?:int|long)) format, (different type|\S+) arg \(arg (\d+)\)$/) {
296 my $type = $2;
297 if($type =~ /^(?:
298 HACCEL|HACMDRIVER|HANDLE|HBITMAP|HBRUSH|HCALL|HCURSOR|HDC|HDRVR|HDESK|HDRAWDIB
299 HGDIOBJ|HKL|HGLOBAL|HIMC|HINSTANCE|HKEY|HLOCAL|
300 HMENU|HMIDISTRM|HMIDIIN|HMIDIOUT|HMIXER|HMIXEROBJ|HMMIO|HMODULE|
301 HLINE|HPEN|HPHONE|HPHONEAPP|
302 HRASCONN|HRGN|HRSRC|HWAVEIN|HWAVEOUT|HWINSTA|HWND|
303 SC_HANDLE|WSAEVENT|handle_t|pointer)$/x)
305 $suppress = 1;
306 } else {
307 $suppress = 0;
309 } elsif(/^\(near initialization for \`(.*?)\'\)$/) {
310 $suppress = 0;
311 } elsif(/^\`(.*?)\' defined but not used$/) {
312 $suppress = 0;
313 } elsif(/^\`(.*?)\' is not at beginning of declaration$/) {
314 $suppress = 0;
315 } elsif(/^\`%x\' yields only last 2 digits of year in some locales$/) {
316 $suppress = 1;
317 } elsif(/^assignment makes integer from pointer without a cast$/) {
318 $suppress = 0;
319 } elsif(/^assignment makes pointer from integer without a cast$/) {
320 $suppress = 0;
321 } elsif(/^assignment from incompatible pointer type$/) {
322 $suppress = 0;
323 } elsif(/^cast from pointer to integer of different size$/) {
324 $suppress = 0;
325 } elsif(/^comparison between pointer and integer$/) {
326 $suppress = 0;
327 } elsif(/^comparison between signed and unsigned$/) {
328 $suppress = 0;
329 } elsif(/^comparison of unsigned expression < 0 is always false$/) {
330 $suppress = 0;
331 } elsif(/^comparison of unsigned expression >= 0 is always true$/) {
332 $suppress = 0;
333 } elsif(/^conflicting types for built-in function \`(.*?)\'$/) {
334 $suppress = 0;
335 } elsif(/^empty body in an if-statement$/) {
336 $suppress = 0;
337 } elsif(/^empty body in an else-statement$/) {
338 $suppress = 0;
339 } elsif(/^implicit declaration of function \`(.*?)\'$/) {
340 $suppress = 0;
341 } elsif(/^initialization from incompatible pointer type$/) {
342 $suppress = 0;
343 } elsif(/^initialization makes pointer from integer without a cast$/) {
344 $suppress = 0;
345 } elsif(/^missing initializer$/) {
346 $suppress = 0;
347 } elsif(/^ordered comparison of pointer with integer zero$/) {
348 $suppress = 0;
349 } elsif(/^passing arg (\d+) of (?:pointer to function|\`(\S+)\') from incompatible pointer type$/) {
350 $suppress = 0;
351 } elsif(/^passing arg (\d+) of (?:pointer to function|\`(\S+)\') makes integer from pointer without a cast$/) {
352 $suppress = 0;
353 } elsif(/^passing arg (\d+) of (?:pointer to function|\`(\S+)\') makes pointer from integer without a cast$/) {
354 $suppress = 0;
355 } elsif(/^return makes integer from pointer without a cast$/) {
356 $suppress = 0;
357 } elsif(/^return makes pointer from integer without a cast$/) {
358 $suppress = 0;
359 } elsif(/^type of \`(.*?)\' defaults to \`(.*?)\'$/) {
360 $suppress = 0;
361 } elsif(/^unused variable \`(.*?)\'$/) {
362 $suppress = 0;
363 } elsif(!$options->pedantic) {
364 $suppress = 0;
365 } else {
366 error("gcc_output");
369 if(!$suppress) {
370 if($function) {
371 $message = "function $function: warning: $_";
372 } else {
373 $message = "warning: $_";
375 } else {
376 $message = "";
378 } elsif(/^\`(.*?)\' undeclared \(first use in this function\)$/) {
379 $message = "$_";
380 } elsif(/^\(Each undeclared identifier is reported only once$/) {
381 $message = "$_";
382 } elsif(/^conflicting types for \`(.*?)\'$/) {
383 $message = "$_";
384 } elsif(/^for each function it appears in.\)$/) {
385 $message = "$_";
386 } elsif(/^too many arguments to function$/) {
387 $message = "$_";
388 } elsif(/^previous declaration of \`(.*?)\'$/) {
389 $message = "$_";
390 } elsif(/^parse error before `(.*?)'$/) {
391 $message = "$_";
392 } elsif(!$options->pedantic) {
393 $message = "$_";
394 } else {
395 error("gcc_output");
397 } elsif(/^In function \`(.*?)\':$/) {
398 $function = $1;
399 } elsif(/^At top level:$/) {
400 $function = "";
401 } else {
402 error("gcc_output");
406 ########################################################################
407 # install_command
408 ########################################################################
410 sub install_command($) {
411 local $_ = shift;
413 return ([], []);
416 ########################################################################
417 # ld_command
418 ########################################################################
420 sub ld_command($) {
421 local $_ = shift;
423 my $read_files;
424 my $write_files;
426 if(/-r\s+(.*?)\s+-o\s+(\S+)$/) {
427 $write_files = [$2];
428 $read_files = [split(/\s+/, $1)];
429 } else {
430 error("ld_command");
433 return ($read_files, $write_files);
436 ########################################################################
437 # ld_output
438 ########################################################################
440 sub ld_output($$) {
441 $file = shift;
442 local $_ = shift;
444 if(/^In function \`(.*?)\':$/) {
445 $function = $1;
446 } elsif(/^more undefined references to \`(.*?)\' follow$/) {
447 # Nothing
448 } elsif(/^the use of \`(.+?)\' is dangerous, better use \`(.+?)\'$/) {
449 # Nothing
450 } elsif(/^undefined reference to \`(.*?)\'$/) {
451 # Nothing
452 } elsif(/^warning: (.*?)\(\) possibly used unsafely; consider using (.*?)\(\)$/) {
453 # Nothing
454 } elsif(/^warning: type and size of dynamic symbol \`(.*?)\' are not defined$/) {
455 $message = "$_";
456 } else {
457 $message = "$_";
461 ########################################################################
462 # ldconfig_command
463 ########################################################################
465 sub ldconfig_command($) {
466 local $_ = shift;
468 return ([], []);
471 ########################################################################
472 # makedep_command
473 ########################################################################
475 sub makedep_command($) {
476 local $_ = shift;
478 return ([], []);
481 ########################################################################
482 # mkdir_command
483 ########################################################################
485 sub mkdir_command($) {
486 local $_ = shift;
488 return ([], []);
491 ########################################################################
492 # ranlib_command
493 ########################################################################
495 sub ranlib_command($) {
496 local $_ = shift;
498 my $read_files;
499 my $write_files;
501 $read_files = [split(/\s+/)];
502 $write_files = [];
504 return ($read_files, $write_files);
507 ########################################################################
508 # rm_command
509 ########################################################################
511 sub rm_command($) {
512 local $_ = shift;
513 s/^-f\s*//;
514 return ([], [], [split(/\s+/, $_)]);
517 ########################################################################
518 # sed_command
519 ########################################################################
521 sub sed_command($) {
522 local $_ = shift;
524 return ([], []);
527 ########################################################################
528 # strip_command
529 ########################################################################
531 sub strip_command($) {
532 local $_ = shift;
534 return ([], []);
537 ########################################################################
538 # winebuild_command
539 ########################################################################
541 sub winebuild_command($) {
542 local $_ = shift;
544 return ([], []);
547 ########################################################################
548 # winebuild_output
549 ########################################################################
551 sub winebuild_output($$) {
552 $file = shift;
553 local $_ = shift;
555 $message = $_;
558 ########################################################################
559 # wmc_command
560 ########################################################################
562 sub wmc_command($) {
563 local $_ = shift;
565 my $read_files;
566 my $write_files;
568 if(/\s+(\S+)$/) {
569 my $mc_file = $1;
571 my $rc_file = $mc_file;
572 $rc_file =~ s/\.mc$/.rc/;
574 $write_files = [$rc_file];
575 $read_files = [$mc_file];
576 } else {
577 error("wmc_command");
580 return ($read_files, $write_files);
583 ########################################################################
584 # wmc_output
585 ########################################################################
587 sub wmc_output($$) {
588 $file = shift;
589 local $_ = shift;
592 ########################################################################
593 # wrc_command
594 ########################################################################
596 sub wrc_command($) {
597 local $_ = shift;
599 my $read_files;
600 my $write_files;
602 if(/\s+(\S+)$/) {
603 my $rc_file = $1;
605 my $o_file = $rc_file;
606 $o_file =~ s/\.rc$/.o/;
608 $write_files = [$o_file];
609 $read_files = [$rc_file];
610 } else {
611 error("wrc_command");
614 return ($read_files, $write_files);
617 ########################################################################
618 # wrc_output
619 ########################################################################
621 sub wrc_output($$) {
622 $file = shift;
623 local $_ = shift;
626 ########################################################################
627 # command
628 ########################################################################
630 sub command($) {
631 local $_ = shift;
633 my $tool;
634 my $file;
635 my $read_files = ["<???>"];
636 my $write_files = ["<???>"];
637 my $remove_files = [];
639 s/^\s*(.*?)\s*$/$1/;
641 if(s/^\[\s+-d\s+(.*?)\s+\]\s+\|\|\s+//) {
642 # Nothing
645 if(s/^ar\s+//) {
646 $tool = "ar";
647 ($read_files, $write_files) = ar_command($_);
648 } elsif(s/^as\s+//) {
649 $tool = "as";
650 ($read_files, $write_files) = as_command($_);
651 } elsif(s/^bison\s+//) {
652 $tool = "bison";
653 ($read_files, $write_files) = bison_command($_);
654 } elsif(s/^cd\s+//) {
655 $tool = "cd";
656 ($read_files, $write_files) = cd_command($_);
657 } elsif(s/^flex\s+//) {
658 $tool = "flex";
659 ($read_files, $write_files) = flex_command($_);
660 } elsif(s/^for\s+//) {
661 $tool = "for";
662 ($read_files, $write_files) = for_command($_);
663 } elsif(s/^\/usr\/bin\/install\s+//) {
664 $tool = "install";
665 ($read_files, $write_files) = install_command($_);
666 } elsif(s/^ld\s+//) {
667 $tool = "ld";
668 ($read_files, $write_files) = ld_command($_);
669 } elsif(s/^\/sbin\/ldconfig\s+//) {
670 $tool = "ldconfig";
671 ($read_files, $write_files) = ldconfig_command();
672 } elsif(s/^gcc\s+//) {
673 $tool = "gcc";
674 ($read_files, $write_files) = gcc_command($_);
675 } elsif(s/^(?:(?:\.\.\/)+|\.\/)tools\/makedep\s+//) {
676 $tool = "makedep";
677 ($read_files, $write_files) = makedep_command($_);
678 } elsif(s/^mkdir\s+//) {
679 $tool = "mkdir";
680 ($read_files, $write_files) = mkdir_command($_);
681 } elsif(s/^ranlib\s+//) {
682 $tool = "ranlib";
683 ($read_files, $write_files) = ranlib_command($_);
684 } elsif(s/^rm\s+//) {
685 $tool = "rm";
686 ($read_files, $write_files, $remove_files) = rm_command($_);
687 } elsif(s/^sed\s+//) {
688 $tool = "sed";
689 ($read_files, $write_files) = sed_command($_);
690 } elsif(s/^strip\s+//) {
691 $tool = "sed";
692 ($read_files, $write_files) = strip_command($_);
693 } elsif(s/^LD_LIBRARY_PATH="(?:(?:\.\.\/)*unicode)?:\$LD_LIBRARY_PATH"\s+(?:\.\.\/)*tools\/winebuild\/winebuild\s+//) {
694 $tool = "winebuild";
695 ($read_files, $write_files) = winebuild_command($_);
696 } elsif(s/^LD_LIBRARY_PATH="(?:(?:\.\.\/)*unicode)?:\$LD_LIBRARY_PATH"\s+(?:\.\.\/)*tools\/wmc\/wmc\s+//) {
697 $tool = "wmc";
698 ($read_files, $write_files) = wmc_command($_);
699 } elsif(s/^LD_LIBRARY_PATH="(?:(?:\.\.\/)*unicode)?:\$LD_LIBRARY_PATH"\s+(?:\.\.\/)*tools\/wrc\/wrc\s+//) {
700 $tool = "wrc";
701 ($read_files, $write_files) = wrc_command($_);
704 return ($tool, $read_files, $write_files, $remove_files);
707 ########################################################################
708 # line
709 ########################################################################
711 sub line($) {
712 local $_ = shift;
714 $file = "";
715 $line = "";
716 $message = "";
718 $current = $_;
720 my ($new_tool, $read_files, $write_files, $remove_files) = command($_);
721 if(defined($new_tool)) {
722 $tool = $new_tool;
724 $function = "";
726 my $progress = "";
727 if($directory && $directory ne ".") {
728 $progress .= "$directory: ";
730 if($tool) {
731 $progress .= "$tool: ";
734 if($tool =~ /^(?:cd|make)$/) {
735 # Nothing
736 } elsif($tool eq "ld"/) {
737 foreach my $file (@{$read_files}) {
738 $output->lazy_progress("${progress}reading '$file'");
740 my $file = $$write_files[0];
741 $output->progress("$progress: writing '$file'");
742 } elsif($tool eq "rm") {
743 foreach my $file (@{$remove_files}) {
744 $output->lazy_progress("${progress}removing '$file'");
746 } else {
747 if($#$read_files >= 0) {
748 $progress .= "read[" . join(" ", @{$read_files}) . "]";
750 if($#$write_files >= 0) {
751 if($#$read_files >= 0) {
752 $progress .= ", ";
754 $progress .= "write[" . join(" ", @{$write_files}) . "]";
756 if($#$remove_files >= 0) {
757 if($#$read_files >= 0 || $#$write_files >= 0) {
758 $progress .= ", ";
760 $progress .= "remove[" . join(" ", @{$remove_files}) . "]";
763 $output->progress($progress);
766 return 0;
769 my $make = $options->make;
771 if(/^Wine build complete\.$/) {
772 # Nothing
773 } elsif(/^(.*?) is newer than (.*?), please rerun (.*?)\!$/) {
774 $message = "$_";
775 } elsif(/^(.*?) is older than (.*?), please rerun (.*?)$/) {
776 $message = "$_";
777 } elsif(/^\`(.*?)\' is up to date.$/) {
778 $tool = "make";
779 make_output($1, $_);
780 } elsif(s/^$make(?:\[(\d+)\])?:\s*//) {
781 $tool = "make";
782 make_output($1, $_);
783 } elsif(!defined($tool)) {
784 error("line");
785 } elsif($tool eq "make") {
786 make_output($1, $_);
787 } elsif($tool eq "bison" && /^conflicts:\s+\d+\s+shift\/reduce$/) {
788 # Nothing
789 } elsif($tool eq "gcc" && /^(?:In file included |\s*)from (.+?):(\d+)[,:]$/) {
790 # Nothing
791 } elsif($tool =~ /^(?:gcc|ld)$/ && s/^(.+?\.s?o)(?:\(.*?\))?:\s*//) {
792 $tool = "ld";
793 ld_output($1, $_)
794 } elsif($tool =~ /^(?:gcc|ld)$/ && s/^(.*?)ld:\s*//) {
795 $tool = "ld";
796 ld_output("", $_)
797 } elsif($tool =~ /^(?:gcc|ld)$/ && s/^collect2:\s*//) {
798 $tool = "ld";
799 ld_output("collect2", $_);
800 } elsif($tool eq "gcc" && s/^(.+?\.[chly]):\s*//) {
801 gcc_output($1, $_);
802 } elsif($tool eq "ld" && s/^(.+?\.c):(?:\d+:)?\s*//) {
803 ld_output($1, $_);
804 } elsif($tool eq "winebuild" && s/^(.+?\.spec):\s*//) {
805 winebuild_output($1, $_);
806 } elsif($tool eq "wmc" && s/^(.+?\.mc):\s*//) {
807 wmc_output($1, $_);
808 } elsif($tool eq "wrc" && s/^(.+?\.rc):\s*//) {
809 wrc_output($1, $_);
810 } elsif($tool eq "cd" && s/^\/bin\/sh:\s*cd:\s*//) {
811 parse_cd_output($_);
812 } elsif(/^\s*$/) {
813 # Nothing
814 } else {
815 error("line");
818 $file =~ s/^\.\///;
820 return 1;