twain_32/tests: Add a trailing '\n' to ok() calls.
[wine/gsoc-2012-control.git] / tools / winapi / make_parser.pm
blob885f77a65f2e45e9988e40f86686c71db17b321c
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 my $arg = $1;
351 my $name = $2;
352 if(defined($name) && $name =~ /^GDI_AllocObject$/) {
353 $suppress = 1;
354 } else {
355 $suppress = 0;
357 } elsif(/^passing arg (\d+) of (?:pointer to function|\`(\S+)\') makes integer from pointer without a cast$/) {
358 $suppress = 0;
359 } elsif(/^passing arg (\d+) of (?:pointer to function|\`(\S+)\') makes pointer from integer without a cast$/) {
360 $suppress = 0;
361 } elsif(/^return makes integer from pointer without a cast$/) {
362 $suppress = 0;
363 } elsif(/^return makes pointer from integer without a cast$/) {
364 $suppress = 0;
365 } elsif(/^type of \`(.*?)\' defaults to \`(.*?)\'$/) {
366 $suppress = 0;
367 } elsif(/^unused variable \`(.*?)\'$/) {
368 $suppress = 0;
369 } elsif(!$options->pedantic) {
370 $suppress = 0;
371 } else {
372 error("gcc_output");
375 if(!$suppress) {
376 if($function) {
377 $message = "function $function: warning: $_";
378 } else {
379 $message = "warning: $_";
381 } else {
382 $message = "";
384 } elsif(/^\`(.*?)\' undeclared \(first use in this function\)$/) {
385 $message = "$_";
386 } elsif(/^\(Each undeclared identifier is reported only once$/) {
387 $message = "$_";
388 } elsif(/^conflicting types for \`(.*?)\'$/) {
389 $message = "$_";
390 } elsif(/^for each function it appears in.\)$/) {
391 $message = "$_";
392 } elsif(/^too many arguments to function$/) {
393 $message = "$_";
394 } elsif(/^previous declaration of \`(.*?)\'$/) {
395 $message = "$_";
396 } elsif(/^parse error before `(.*?)'$/) {
397 $message = "$_";
398 } elsif(!$options->pedantic) {
399 $message = "$_";
400 } else {
401 error("gcc_output");
403 } elsif(/^In function \`(.*?)\':$/) {
404 $function = $1;
405 } elsif(/^At top level:$/) {
406 $function = "";
407 } else {
408 error("gcc_output");
412 ########################################################################
413 # install_command
414 ########################################################################
416 sub install_command($) {
417 local $_ = shift;
419 return ([], []);
422 ########################################################################
423 # ld_command
424 ########################################################################
426 sub ld_command($) {
427 local $_ = shift;
429 my $read_files;
430 my $write_files;
432 if(/-r\s+(.*?)\s+-o\s+(\S+)$/) {
433 $write_files = [$2];
434 $read_files = [split(/\s+/, $1)];
435 } else {
436 error("ld_command");
439 return ($read_files, $write_files);
442 ########################################################################
443 # ld_output
444 ########################################################################
446 sub ld_output($$) {
447 $file = shift;
448 local $_ = shift;
450 if(/^In function \`(.*?)\':$/) {
451 $function = $1;
452 } elsif(/^more undefined references to \`(.*?)\' follow$/) {
453 # Nothing
454 } elsif(/^the use of \`(.+?)\' is dangerous, better use \`(.+?)\'$/) {
455 # Nothing
456 } elsif(/^undefined reference to \`(.*?)\'$/) {
457 # Nothing
458 } elsif(/^warning: (.*?)\(\) possibly used unsafely; consider using (.*?)\(\)$/) {
459 # Nothing
460 } elsif(/^warning: type and size of dynamic symbol \`(.*?)\' are not defined$/) {
461 $message = "$_";
462 } else {
463 $message = "$_";
467 ########################################################################
468 # ldconfig_command
469 ########################################################################
471 sub ldconfig_command($) {
472 local $_ = shift;
474 return ([], []);
477 ########################################################################
478 # makedep_command
479 ########################################################################
481 sub makedep_command($) {
482 local $_ = shift;
484 return ([], []);
487 ########################################################################
488 # mkdir_command
489 ########################################################################
491 sub mkdir_command($) {
492 local $_ = shift;
494 return ([], []);
497 ########################################################################
498 # ranlib_command
499 ########################################################################
501 sub ranlib_command($) {
502 local $_ = shift;
504 my $read_files;
505 my $write_files;
507 $read_files = [split(/\s+/)];
508 $write_files = [];
510 return ($read_files, $write_files);
513 ########################################################################
514 # rm_command
515 ########################################################################
517 sub rm_command($) {
518 local $_ = shift;
519 s/^-f\s*//;
520 return ([], [], [split(/\s+/, $_)]);
523 ########################################################################
524 # sed_command
525 ########################################################################
527 sub sed_command($) {
528 local $_ = shift;
530 return ([], []);
533 ########################################################################
534 # strip_command
535 ########################################################################
537 sub strip_command($) {
538 local $_ = shift;
540 return ([], []);
543 ########################################################################
544 # winebuild_command
545 ########################################################################
547 sub winebuild_command($) {
548 local $_ = shift;
550 return ([], []);
553 ########################################################################
554 # winebuild_output
555 ########################################################################
557 sub winebuild_output($$) {
558 $file = shift;
559 local $_ = shift;
561 $message = $_;
564 ########################################################################
565 # wmc_command
566 ########################################################################
568 sub wmc_command($) {
569 local $_ = shift;
571 my $read_files;
572 my $write_files;
574 if(/\s+(\S+)$/) {
575 my $mc_file = $1;
577 my $rc_file = $mc_file;
578 $rc_file =~ s/\.mc$/.rc/;
580 $write_files = [$rc_file];
581 $read_files = [$mc_file];
582 } else {
583 error("wmc_command");
586 return ($read_files, $write_files);
589 ########################################################################
590 # wmc_output
591 ########################################################################
593 sub wmc_output($$) {
594 $file = shift;
595 local $_ = shift;
598 ########################################################################
599 # wrc_command
600 ########################################################################
602 sub wrc_command($) {
603 local $_ = shift;
605 my $read_files;
606 my $write_files;
608 if(/\s+(\S+)$/) {
609 my $rc_file = $1;
611 my $o_file = $rc_file;
612 $o_file =~ s/\.rc$/.o/;
614 $write_files = [$o_file];
615 $read_files = [$rc_file];
616 } else {
617 error("wrc_command");
620 return ($read_files, $write_files);
623 ########################################################################
624 # wrc_output
625 ########################################################################
627 sub wrc_output($$) {
628 $file = shift;
629 local $_ = shift;
632 ########################################################################
633 # command
634 ########################################################################
636 sub command($) {
637 local $_ = shift;
639 my $tool;
640 my $file;
641 my $read_files = ["<???>"];
642 my $write_files = ["<???>"];
643 my $remove_files = [];
645 s/^\s*(.*?)\s*$/$1/;
647 if(s/^\[\s+-d\s+(.*?)\s+\]\s+\|\|\s+//) {
648 # Nothing
651 if(s/^ar\s+//) {
652 $tool = "ar";
653 ($read_files, $write_files) = ar_command($_);
654 } elsif(s/^as\s+//) {
655 $tool = "as";
656 ($read_files, $write_files) = as_command($_);
657 } elsif(s/^bison\s+//) {
658 $tool = "bison";
659 ($read_files, $write_files) = bison_command($_);
660 } elsif(s/^cd\s+//) {
661 $tool = "cd";
662 ($read_files, $write_files) = cd_command($_);
663 } elsif(s/^flex\s+//) {
664 $tool = "flex";
665 ($read_files, $write_files) = flex_command($_);
666 } elsif(s/^for\s+//) {
667 $tool = "for";
668 ($read_files, $write_files) = for_command($_);
669 } elsif(s/^\/usr\/bin\/install\s+//) {
670 $tool = "install";
671 ($read_files, $write_files) = install_command($_);
672 } elsif(s/^ld\s+//) {
673 $tool = "ld";
674 ($read_files, $write_files) = ld_command($_);
675 } elsif(s/^\/sbin\/ldconfig\s+//) {
676 $tool = "ldconfig";
677 ($read_files, $write_files) = ldconfig_command();
678 } elsif(s/^gcc\s+//) {
679 $tool = "gcc";
680 ($read_files, $write_files) = gcc_command($_);
681 } elsif(s/^(?:(?:\.\.\/)+|\.\/)tools\/makedep\s+//) {
682 $tool = "makedep";
683 ($read_files, $write_files) = makedep_command($_);
684 } elsif(s/^mkdir\s+//) {
685 $tool = "mkdir";
686 ($read_files, $write_files) = mkdir_command($_);
687 } elsif(s/^ranlib\s+//) {
688 $tool = "ranlib";
689 ($read_files, $write_files) = ranlib_command($_);
690 } elsif(s/^rm\s+//) {
691 $tool = "rm";
692 ($read_files, $write_files, $remove_files) = rm_command($_);
693 } elsif(s/^sed\s+//) {
694 $tool = "sed";
695 ($read_files, $write_files) = sed_command($_);
696 } elsif(s/^strip\s+//) {
697 $tool = "sed";
698 ($read_files, $write_files) = strip_command($_);
699 } elsif(s/^LD_LIBRARY_PATH="(?:(?:\.\.\/)*unicode)?:\$LD_LIBRARY_PATH"\s+(?:\.\.\/)*tools\/winebuild\/winebuild\s+//) {
700 $tool = "winebuild";
701 ($read_files, $write_files) = winebuild_command($_);
702 } elsif(s/^LD_LIBRARY_PATH="(?:(?:\.\.\/)*unicode)?:\$LD_LIBRARY_PATH"\s+(?:\.\.\/)*tools\/wmc\/wmc\s+//) {
703 $tool = "wmc";
704 ($read_files, $write_files) = wmc_command($_);
705 } elsif(s/^LD_LIBRARY_PATH="(?:(?:\.\.\/)*unicode)?:\$LD_LIBRARY_PATH"\s+(?:\.\.\/)*tools\/wrc\/wrc\s+//) {
706 $tool = "wrc";
707 ($read_files, $write_files) = wrc_command($_);
710 return ($tool, $read_files, $write_files, $remove_files);
713 ########################################################################
714 # line
715 ########################################################################
717 sub line($) {
718 local $_ = shift;
720 $file = "";
721 $line = "";
722 $message = "";
724 $current = $_;
726 my ($new_tool, $read_files, $write_files, $remove_files) = command($_);
727 if(defined($new_tool)) {
728 $tool = $new_tool;
730 $function = "";
732 my $progress = "";
733 if($directory && $directory ne ".") {
734 $progress .= "$directory: ";
736 if($tool) {
737 $progress .= "$tool: ";
740 if($tool =~ /^(?:cd|make)$/) {
741 # Nothing
742 } elsif($tool eq "ld"/) {
743 foreach my $file (@{$read_files}) {
744 $output->lazy_progress("${progress}reading '$file'");
746 my $file = $$write_files[0];
747 $output->progress("$progress: writing '$file'");
748 } elsif($tool eq "rm") {
749 foreach my $file (@{$remove_files}) {
750 $output->lazy_progress("${progress}removing '$file'");
752 } else {
753 if($#$read_files >= 0) {
754 $progress .= "read[" . join(" ", @{$read_files}) . "]";
756 if($#$write_files >= 0) {
757 if($#$read_files >= 0) {
758 $progress .= ", ";
760 $progress .= "write[" . join(" ", @{$write_files}) . "]";
762 if($#$remove_files >= 0) {
763 if($#$read_files >= 0 || $#$write_files >= 0) {
764 $progress .= ", ";
766 $progress .= "remove[" . join(" ", @{$remove_files}) . "]";
769 $output->progress($progress);
772 return 0;
775 my $make = $options->make;
777 if(/^Wine build complete\.$/) {
778 # Nothing
779 } elsif(/^(.*?) is newer than (.*?), please rerun (.*?)\!$/) {
780 $message = "$_";
781 } elsif(/^(.*?) is older than (.*?), please rerun (.*?)$/) {
782 $message = "$_";
783 } elsif(/^\`(.*?)\' is up to date.$/) {
784 $tool = "make";
785 make_output($1, $_);
786 } elsif(s/^$make(?:\[(\d+)\])?:\s*//) {
787 $tool = "make";
788 make_output($1, $_);
789 } elsif(!defined($tool)) {
790 error("line");
791 } elsif($tool eq "make") {
792 make_output($1, $_);
793 } elsif($tool eq "bison" && /^conflicts:\s+\d+\s+shift\/reduce$/) {
794 # Nothing
795 } elsif($tool eq "gcc" && /^(?:In file included |\s*)from (.+?):(\d+)[,:]$/) {
796 # Nothing
797 } elsif($tool =~ /^(?:gcc|ld)$/ && s/^(.+?\.s?o)(?:\(.*?\))?:\s*//) {
798 $tool = "ld";
799 ld_output($1, $_)
800 } elsif($tool =~ /^(?:gcc|ld)$/ && s/^(.*?)ld:\s*//) {
801 $tool = "ld";
802 ld_output("", $_)
803 } elsif($tool =~ /^(?:gcc|ld)$/ && s/^collect2:\s*//) {
804 $tool = "ld";
805 ld_output("collect2", $_);
806 } elsif($tool eq "gcc" && s/^(.+?\.[chly]):\s*//) {
807 gcc_output($1, $_);
808 } elsif($tool eq "ld" && s/^(.+?\.c):(?:\d+:)?\s*//) {
809 ld_output($1, $_);
810 } elsif($tool eq "winebuild" && s/^(.+?\.spec):\s*//) {
811 winebuild_output($1, $_);
812 } elsif($tool eq "wmc" && s/^(.+?\.mc):\s*//) {
813 wmc_output($1, $_);
814 } elsif($tool eq "wrc" && s/^(.+?\.rc):\s*//) {
815 wrc_output($1, $_);
816 } elsif($tool eq "cd" && s/^\/bin\/sh:\s*cd:\s*//) {
817 parse_cd_output($_);
818 } elsif(/^\s*$/) {
819 # Nothing
820 } else {
821 error("line");
824 $file =~ s/^\.\///;
826 return 1;