Removed some direct accesses to GDI internal pen/brush/font
[wine/dcerpc.git] / tools / examine-relay
blob8330d1abe762f7e567b7eca42276124dfed41131
1 #!/usr/bin/perl -w
2 # -----------------------------------------------------------------------------
4 # Relay-checker.
6 # This program will inspect a log file with relay information and tell you
7 # whether calls and returns match. If not, this suggests that the parameter
8 # list might be incorrect. (It could be something else also.)
10 # Copyright 1997-1998 Morten Welinder (terra@diku.dk)
11 # 2001 Eric Pouech
13 # -----------------------------------------------------------------------------
15 use strict;
17 my $srcfile = $ARGV[0];
18 my %tid_callstack = ();
19 my $newlineerror = 0;
20 my $indentp = 1;
22 open (IN, "<$srcfile") || die "Cannot open $srcfile for reading: $!\n";
23 LINE:
24 while (<IN>) {
26 if (/^([0-9a-f]+):Call ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\((.*\)) .*/) {
27 my $tid = $1;
28 my $func = $2;
30 if (/ ret=(........)$/ ||
31 / ret=(....:....) (ds=....)$/) {
32 my $retaddr = $1;
33 my $segreg = $2;
35 $segreg = "none" unless defined $segreg;
37 push @{$tid_callstack{$tid}}, [$func, $retaddr, $segreg];
38 next;
39 } else {
40 # Assume a line got cut by a line feed in a string.
41 $_ .= scalar (<IN>);
42 if (!$newlineerror) {
43 print "Err[$tid] string probably cut by newline.\n";
44 $newlineerror = 1;
46 # print "[$_]";
47 redo;
51 if (/^([0-9a-f]+):Ret ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\(.*\) .* ret=(........)$/ ||
52 /^([0-9a-f]+):Ret ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\(.*\) .* ret=(....:....) (ds=....)$/) {
53 my $tid = $1;
54 my $func = $2;
55 my $retaddr = $3;
56 my $segreg = $4;
57 my ($topfunc,$topaddr,$topseg);
59 if (!defined($tid_callstack{$tid}))
61 print "Err[$tid]: unknown tid\n";
62 next;
65 $segreg = "none" unless defined $segreg;
67 POP:
68 while (1) {
69 if ($#{$tid_callstack{$tid}} == -1) {
70 print "Err[$tid]: Return from $func to $retaddr with empty stack.\n";
71 next LINE;
74 ($topfunc,$topaddr,$topseg) = @{pop @{$tid_callstack{$tid}}};
76 if ($topfunc ne $func) {
77 print "Err[$tid]: Return from $topfunc, but call from $func.\n";
78 next POP;
80 last POP;
83 my $addrok = ($topaddr eq $retaddr);
84 my $segok = ($topseg eq $segreg);
85 if ($addrok && $segok) {
86 print "Ok [$tid]: ", ($indentp ? (' ' x (1 + $#{$tid_callstack{$tid}})) : '');
87 print "$func from $retaddr with $segreg.\n";
88 } else {
89 print "Err[$tid]: Return from $func is to $retaddr, not $topaddr.\n"
90 if !$addrok;
91 print "Err[$tid]: Return from $func with segreg $segreg, not $topseg.\n"
92 if !$segok;
97 foreach my $tid (keys %tid_callstack) {
98 while ($#{$tid_callstack{$tid}} != -1) {
99 my ($topfunc,$topaddr,$topseg) = @{pop @{$tid_callstack{$tid}}};
100 print "Err[$tid]: leftover call to $topfunc from $topaddr.\n";
104 close (IN);