]>
Commit | Line | Data |
---|---|---|
f6f30f34 | 1 | # Expect script for creating PDB files when linking. |
fd67aa11 | 2 | # Copyright (C) 2022-2024 Free Software Foundation, Inc. |
f6f30f34 MH |
3 | # |
4 | # This file is part of the GNU Binutils. | |
5 | # | |
6 | # This program is free software; you can redistribute it and/or modify | |
7 | # it under the terms of the GNU General Public License as published by | |
8 | # the Free Software Foundation; either version 3 of the License, or | |
9 | # (at your option) any later version. | |
10 | # | |
11 | # This program is distributed in the hope that it will be useful, | |
12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | # GNU General Public License for more details. | |
15 | # | |
16 | # You should have received a copy of the GNU General Public License | |
17 | # along with this program; if not, write to the Free Software | |
18 | # Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, | |
19 | # MA 02110-1301, USA. | |
20 | ||
21 | if {![istarget i*86-*-mingw*] | |
0f97abf0 MH |
22 | && ![istarget i*86-*-cygwin*] |
23 | && ![istarget i*86-*-winnt] | |
24 | && ![istarget i*86-*-pe] | |
9a02fbd1 | 25 | && ![istarget x86_64-*-mingw*] |
0f97abf0 MH |
26 | && ![istarget x86_64-*-pe*] |
27 | && ![istarget x86_64-*-cygwin] | |
28 | && ![istarget aarch64-*-mingw*] | |
29 | && ![istarget aarch64-*-pe*]} { | |
f6f30f34 MH |
30 | return |
31 | } | |
32 | ||
33 | proc get_pdb_name { pe } { | |
34 | global OBJDUMP | |
35 | ||
36 | set exec_output [run_host_cmd "$OBJDUMP" "-p $pe"] | |
37 | ||
38 | if ![regexp -line "^\\(format RSDS signature (\[0-9a-fA-F\]{32}) age 1 pdb (.*)\\)$" $exec_output full sig pdb] { | |
39 | return "" | |
40 | } | |
41 | ||
42 | return $pdb | |
43 | } | |
44 | ||
b41a6533 MH |
45 | proc get_pdb_guid { pe } { |
46 | global OBJDUMP | |
47 | ||
48 | set exec_output [run_host_cmd "$OBJDUMP" "-p $pe"] | |
49 | ||
50 | if ![regexp -line "^\\(format RSDS signature (\[0-9a-fA-F\]{32}) age 1 pdb (.*)\\)$" $exec_output full sig pdb] { | |
51 | return "" | |
52 | } | |
53 | ||
54 | return $sig | |
55 | } | |
56 | ||
57 | proc check_pdb_info_stream { pdb guid } { | |
58 | global ar | |
59 | ||
60 | set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb 0001"] | |
61 | ||
62 | if ![string match "" $exec_output] { | |
63 | return 0 | |
64 | } | |
65 | ||
66 | set fi [open tmpdir/0001] | |
67 | fconfigure $fi -translation binary | |
68 | ||
69 | # check version | |
70 | ||
71 | set data [read $fi 4] | |
72 | binary scan $data i version | |
73 | ||
74 | if { $version != 20000404 } { | |
75 | close $fi | |
76 | return 0 | |
77 | } | |
78 | ||
79 | # skip signature (timestamp) | |
80 | read $fi 4 | |
81 | ||
82 | # check age | |
83 | ||
84 | set data [read $fi 4] | |
85 | binary scan $data i age | |
86 | ||
87 | if { $age != 1 } { | |
88 | close $fi | |
89 | return 0 | |
90 | } | |
91 | ||
92 | # check GUID | |
93 | ||
94 | set data [read $fi 16] | |
95 | binary scan $data H2H2H2H2H2H2H2H2H* guid1 guid2 guid3 guid4 guid5 guid6 guid7 guid8 guid9 | |
96 | ||
97 | set data "$guid4$guid3$guid2$guid1$guid6$guid5$guid8$guid7$guid9" | |
98 | ||
99 | if { $data ne $guid } { | |
100 | close $fi | |
101 | return 0 | |
102 | } | |
103 | ||
104 | # skip names string | |
105 | ||
106 | set data [read $fi 4] | |
107 | binary scan $data i names_length | |
108 | read $fi $names_length | |
109 | ||
110 | # read number of names entries | |
111 | ||
112 | set data [read $fi 4] | |
113 | binary scan $data i num_entries | |
114 | ||
115 | # skip number of buckets | |
116 | read $fi 4 | |
117 | ||
118 | # skip present bitmap | |
119 | ||
120 | set data [read $fi 4] | |
121 | binary scan $data i bitmap_length | |
122 | read $fi [expr $bitmap_length * 4] | |
123 | ||
124 | # skip deleted bitmap | |
125 | ||
126 | set data [read $fi 4] | |
127 | binary scan $data i bitmap_length | |
128 | read $fi [expr $bitmap_length * 4] | |
129 | ||
130 | # skip names entries | |
131 | read $fi [expr $num_entries * 8] | |
132 | ||
133 | # skip uint32_t | |
134 | read $fi 4 | |
135 | ||
136 | # read second version | |
137 | ||
138 | set data [read $fi 4] | |
139 | binary scan $data i version2 | |
140 | ||
141 | if { $version2 != 20140508 } { | |
142 | close $fi | |
143 | return 0 | |
144 | } | |
145 | ||
146 | close $fi | |
147 | ||
148 | return 1 | |
149 | } | |
150 | ||
151 | proc check_type_stream { pdb stream } { | |
152 | global ar | |
153 | ||
154 | set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb $stream"] | |
155 | ||
156 | if ![string match "" $exec_output] { | |
157 | return 0 | |
158 | } | |
159 | ||
160 | set fi [open tmpdir/$stream] | |
161 | fconfigure $fi -translation binary | |
162 | ||
163 | # check version | |
164 | ||
165 | set data [read $fi 4] | |
166 | binary scan $data i version | |
167 | ||
168 | if { $version != 20040203 } { | |
169 | close $fi | |
170 | return 0 | |
171 | } | |
172 | ||
173 | # check header size | |
174 | ||
175 | set data [read $fi 4] | |
176 | binary scan $data i header_size | |
177 | ||
178 | if { $header_size != 0x38 } { | |
179 | close $fi | |
180 | return 0 | |
181 | } | |
182 | ||
183 | # skip type_index_begin and type_index_end | |
184 | read $fi 8 | |
185 | ||
186 | # read type_record_bytes | |
187 | ||
188 | set data [read $fi 4] | |
189 | binary scan $data i type_record_bytes | |
190 | ||
191 | close $fi | |
192 | ||
193 | # check stream length | |
194 | ||
195 | set stream_length [file size tmpdir/$stream] | |
196 | ||
197 | if { $stream_length != [ expr $header_size + $type_record_bytes ] } { | |
198 | return 0 | |
199 | } | |
200 | ||
201 | return 1 | |
202 | } | |
203 | ||
204 | proc check_dbi_stream { pdb } { | |
205 | global ar | |
206 | ||
207 | set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb 0003"] | |
208 | ||
209 | if ![string match "" $exec_output] { | |
210 | return 0 | |
211 | } | |
212 | ||
213 | set fi [open tmpdir/0003] | |
214 | fconfigure $fi -translation binary | |
215 | ||
216 | # check signature | |
217 | ||
218 | set data [read $fi 4] | |
219 | binary scan $data i signature | |
220 | ||
221 | if { $signature != -1 } { | |
222 | close $fi | |
223 | return 0 | |
224 | } | |
225 | ||
226 | # check version | |
227 | ||
228 | set data [read $fi 4] | |
229 | binary scan $data i version | |
230 | ||
231 | if { $version != 19990903 } { | |
232 | close $fi | |
233 | return 0 | |
234 | } | |
235 | ||
236 | # check age | |
237 | ||
238 | set data [read $fi 4] | |
239 | binary scan $data i age | |
240 | ||
241 | if { $age != 1 } { | |
242 | close $fi | |
243 | return 0 | |
244 | } | |
245 | ||
246 | # skip fields | |
247 | read $fi 12 | |
248 | ||
249 | # read substream sizes | |
250 | ||
251 | set data [read $fi 4] | |
252 | binary scan $data i mod_info_size | |
253 | ||
254 | set data [read $fi 4] | |
255 | binary scan $data i section_contribution_size | |
256 | ||
257 | set data [read $fi 4] | |
258 | binary scan $data i section_map_size | |
259 | ||
260 | set data [read $fi 4] | |
261 | binary scan $data i source_info_size | |
262 | ||
263 | set data [read $fi 4] | |
264 | binary scan $data i type_server_map_size | |
265 | ||
a667697f MH |
266 | # skip MFC type server index |
267 | seek $fi 4 current | |
b41a6533 MH |
268 | |
269 | set data [read $fi 4] | |
270 | binary scan $data i optional_dbg_header_size | |
271 | ||
272 | set data [read $fi 4] | |
273 | binary scan $data i ec_substream_size | |
274 | ||
275 | close $fi | |
276 | ||
277 | # check stream length | |
278 | ||
279 | set stream_length [file size tmpdir/0003] | |
280 | ||
a667697f | 281 | if { $stream_length != [expr 0x40 + $mod_info_size + $section_contribution_size + $section_map_size + $source_info_size + $type_server_map_size + $optional_dbg_header_size + $ec_substream_size] } { |
b41a6533 MH |
282 | return 0 |
283 | } | |
284 | ||
285 | return 1 | |
286 | } | |
287 | ||
a7267222 MH |
288 | proc get_section_stream_index { pdb } { |
289 | global ar | |
290 | ||
291 | set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb 0003"] | |
292 | ||
293 | if ![string match "" $exec_output] { | |
294 | return -1 | |
295 | } | |
296 | ||
297 | set fi [open tmpdir/0003] | |
298 | fconfigure $fi -translation binary | |
299 | ||
300 | # skip fields | |
301 | seek $fi 24 | |
302 | ||
303 | # read substream sizes | |
304 | ||
305 | set data [read $fi 4] | |
306 | binary scan $data i mod_info_size | |
307 | ||
308 | set data [read $fi 4] | |
309 | binary scan $data i section_contribution_size | |
310 | ||
311 | set data [read $fi 4] | |
312 | binary scan $data i section_map_size | |
313 | ||
314 | set data [read $fi 4] | |
315 | binary scan $data i source_info_size | |
316 | ||
317 | set data [read $fi 4] | |
318 | binary scan $data i type_server_map_size | |
319 | ||
320 | # skip type server index | |
321 | seek $fi 4 current | |
322 | ||
323 | set data [read $fi 4] | |
324 | binary scan $data i optional_dbg_header_size | |
325 | ||
326 | if { $optional_dbg_header_size < 12 } { | |
327 | close $fi | |
328 | return -1 | |
329 | } | |
330 | ||
331 | # skip data | |
332 | seek $fi [expr 12 + $mod_info_size + $section_contribution_size + $section_map_size + $source_info_size + $type_server_map_size + 10] current | |
333 | ||
334 | set data [read $fi 2] | |
335 | binary scan $data s section_stream_index | |
336 | ||
337 | close $fi | |
338 | ||
339 | return $section_stream_index | |
340 | } | |
341 | ||
342 | proc check_section_stream { img pdb } { | |
343 | global ar | |
344 | ||
345 | # read sections stream | |
346 | ||
347 | set index [get_section_stream_index $pdb] | |
348 | ||
349 | if { $index == -1 } { | |
350 | return 0 | |
351 | } | |
352 | ||
353 | set index_str [format "%04x" $index] | |
354 | ||
355 | set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb $index_str"] | |
356 | ||
357 | if ![string match "" $exec_output] { | |
358 | return 0 | |
359 | } | |
360 | ||
361 | set stream_length [file size tmpdir/$index_str] | |
362 | ||
363 | set fi [open tmpdir/$index_str] | |
364 | fconfigure $fi -translation binary | |
365 | ||
366 | set stream_data [read $fi $stream_length] | |
367 | ||
368 | close $fi | |
369 | ||
370 | # read sections from PE file | |
371 | ||
372 | set fi [open $img] | |
373 | fconfigure $fi -translation binary | |
374 | ||
375 | # read PE offset | |
376 | read $fi 0x3c | |
377 | set data [read $fi 4] | |
378 | binary scan $data i pe_offset | |
379 | ||
380 | # read number of sections | |
381 | seek $fi [expr $pe_offset + 6] | |
382 | set data [read $fi 2] | |
383 | binary scan $data s num_sections | |
384 | ||
385 | # read size of optional header | |
386 | seek $fi 12 current | |
387 | set data [read $fi 2] | |
388 | binary scan $data s opt_header_size | |
389 | ||
390 | # read section headers | |
391 | seek $fi [expr $opt_header_size + 2] current | |
392 | set section_data [read $fi [expr $num_sections * 40]] | |
393 | ||
394 | close $fi | |
395 | ||
396 | # compare | |
397 | ||
398 | if { $stream_data ne $section_data} { | |
399 | return 0 | |
400 | } | |
401 | ||
402 | return 1 | |
403 | } | |
404 | ||
08827105 MH |
405 | proc get_publics_stream_index { pdb } { |
406 | global ar | |
407 | ||
408 | set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb 0003"] | |
409 | ||
410 | if ![string match "" $exec_output] { | |
411 | return -1 | |
412 | } | |
413 | ||
414 | set fi [open tmpdir/0003] | |
415 | fconfigure $fi -translation binary | |
416 | ||
417 | # skip fields | |
418 | seek $fi 16 | |
419 | ||
420 | # read substream sizes | |
421 | ||
422 | set data [read $fi 2] | |
423 | binary scan $data s index | |
424 | ||
425 | close $fi | |
426 | ||
427 | return $index | |
428 | } | |
429 | ||
430 | proc get_sym_record_stream_index { pdb } { | |
431 | global ar | |
432 | ||
433 | set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb 0003"] | |
434 | ||
435 | if ![string match "" $exec_output] { | |
436 | return -1 | |
437 | } | |
438 | ||
439 | set fi [open tmpdir/0003] | |
440 | fconfigure $fi -translation binary | |
441 | ||
442 | # skip fields | |
443 | seek $fi 20 | |
444 | ||
445 | # read substream sizes | |
446 | ||
447 | set data [read $fi 2] | |
448 | binary scan $data s index | |
449 | ||
450 | close $fi | |
451 | ||
452 | return $index | |
453 | } | |
454 | ||
455 | proc check_publics_stream { pdb } { | |
456 | global ar | |
457 | global objdump | |
458 | global srcdir | |
459 | global subdir | |
460 | ||
461 | set publics_index [get_publics_stream_index $pdb] | |
462 | ||
463 | if { $publics_index == -1 } { | |
464 | return 0 | |
465 | } | |
466 | ||
467 | set index_str [format "%04x" $publics_index] | |
468 | ||
469 | set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb $index_str"] | |
470 | ||
471 | if ![string match "" $exec_output] { | |
472 | return 0 | |
473 | } | |
474 | ||
475 | set exp [file_contents "$srcdir/$subdir/pdb1-publics.d"] | |
476 | set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"] | |
477 | if ![string match $exp $got] { | |
478 | return 0 | |
479 | } | |
480 | ||
481 | set sym_record_index [get_sym_record_stream_index $pdb] | |
482 | ||
483 | if { $sym_record_index == -1 } { | |
484 | return 0 | |
485 | } | |
486 | ||
487 | set index_str [format "%04x" $sym_record_index] | |
488 | ||
489 | set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb $index_str"] | |
490 | ||
491 | if ![string match "" $exec_output] { | |
492 | return 0 | |
493 | } | |
494 | ||
495 | set exp [file_contents "$srcdir/$subdir/pdb1-sym-record.d"] | |
496 | set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"] | |
497 | if ![string match $exp $got] { | |
498 | return 0 | |
499 | } | |
500 | ||
501 | return 1 | |
502 | } | |
503 | ||
5967ca92 MH |
504 | proc test1 { } { |
505 | global as | |
506 | global ld | |
507 | global srcdir | |
508 | global subdir | |
f6f30f34 | 509 | |
5967ca92 MH |
510 | if ![ld_assemble $as $srcdir/$subdir/pdb1.s tmpdir/pdb1.o] { |
511 | unsupported "Build pdb1.o" | |
512 | return | |
513 | } | |
f6f30f34 | 514 | |
5967ca92 MH |
515 | if ![ld_link $ld "tmpdir/pdb1.exe" "--pdb=tmpdir/pdb1.pdb --gc-sections -e foo tmpdir/pdb1.o"] { |
516 | fail "Could not create a PE image with a PDB file" | |
517 | return | |
518 | } | |
f6f30f34 | 519 | |
5967ca92 MH |
520 | if ![string equal [get_pdb_name "tmpdir/pdb1.exe"] "pdb1.pdb"] { |
521 | fail "PDB filename not found in CodeView debug info" | |
522 | return | |
523 | } | |
b41a6533 | 524 | |
5967ca92 | 525 | pass "PDB filename present in CodeView debug info" |
b41a6533 | 526 | |
5967ca92 MH |
527 | if [check_pdb_info_stream tmpdir/pdb1.pdb [get_pdb_guid "tmpdir/pdb1.exe"]] { |
528 | pass "Valid PDB info stream" | |
529 | } else { | |
530 | fail "Invalid PDB info stream" | |
531 | } | |
b41a6533 | 532 | |
5967ca92 MH |
533 | if [check_type_stream tmpdir/pdb1.pdb "0002"] { |
534 | pass "Valid TPI stream" | |
535 | } else { | |
536 | fail "Invalid TPI stream" | |
537 | } | |
538 | ||
539 | if [check_type_stream tmpdir/pdb1.pdb "0004"] { | |
540 | pass "Valid IPI stream" | |
541 | } else { | |
542 | fail "Invalid IPI stream" | |
543 | } | |
544 | ||
545 | if [check_dbi_stream tmpdir/pdb1.pdb] { | |
546 | pass "Valid DBI stream" | |
547 | } else { | |
548 | fail "Invalid DBI stream" | |
549 | } | |
b41a6533 | 550 | |
5967ca92 MH |
551 | if [check_section_stream tmpdir/pdb1.exe tmpdir/pdb1.pdb] { |
552 | pass "Valid section stream" | |
553 | } else { | |
554 | fail "Invalid section stream" | |
555 | } | |
556 | ||
557 | if [check_publics_stream tmpdir/pdb1.pdb] { | |
558 | pass "Valid publics stream" | |
559 | } else { | |
560 | fail "Invalid publics stream" | |
561 | } | |
b41a6533 | 562 | } |
a7267222 | 563 | |
5967ca92 MH |
564 | proc test_mod_info { mod_info } { |
565 | # check filenames in mod_info | |
566 | ||
567 | set off 64 | |
568 | ||
569 | set obj1 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]] | |
570 | incr off [expr [string length $obj1] + 1] | |
571 | ||
572 | set ar1 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]] | |
573 | incr off [expr [string length $ar1] + 1] | |
574 | ||
575 | if [string match "*pdb2a.o" $obj1] { | |
576 | pass "Correct name for first object file" | |
577 | } else { | |
578 | fail "Incorrect name for first object file" | |
579 | } | |
580 | ||
581 | if [string equal $obj1 $ar1] { | |
582 | pass "Correct archive name for first object file" | |
583 | } else { | |
584 | fail "Incorrect archive name for first object file" | |
585 | } | |
586 | ||
587 | if { [expr $off % 4] != 0 } { | |
588 | set off [expr $off + 4 - ($off % 4)] | |
589 | } | |
590 | ||
591 | incr off 64 | |
592 | ||
593 | set obj2 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]] | |
594 | incr off [expr [string length $obj2] + 1] | |
595 | ||
596 | set ar2 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]] | |
597 | incr off [expr [string length $ar2] + 1] | |
598 | ||
599 | if [string match "*pdb2b.o" $obj2] { | |
600 | pass "Correct name for second object file" | |
601 | } else { | |
602 | fail "Incorrect name for second object file" | |
603 | } | |
604 | ||
605 | if [string match "*pdb2b.a" $ar2] { | |
606 | pass "Correct archive name for second object file" | |
607 | } else { | |
608 | fail "Incorrect archive name for second object file" | |
609 | } | |
610 | ||
611 | if { [expr $off % 4] != 0 } { | |
612 | set off [expr $off + 4 - ($off % 4)] | |
613 | } | |
614 | ||
615 | incr off 64 | |
616 | ||
617 | set obj3 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]] | |
618 | incr off [expr [string length $obj3] + 1] | |
619 | ||
620 | set ar3 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]] | |
621 | incr off [expr [string length $ar3] + 1] | |
622 | ||
623 | if [string equal $obj3 "* Linker *"] { | |
624 | pass "Correct name for dummy object file" | |
625 | } else { | |
626 | fail "Incorrect name for dummy object file" | |
627 | } | |
628 | ||
629 | if [string equal $ar3 ""] { | |
630 | pass "Correct archive name for dummy object file" | |
631 | } else { | |
632 | fail "Incorrect archive name for dummy object file" | |
633 | } | |
a7267222 | 634 | } |
08827105 | 635 | |
e2a1b0a0 MH |
636 | proc test_section_contrib { section_contrib } { |
637 | global objdump | |
638 | global srcdir | |
639 | global subdir | |
640 | ||
641 | set fi [open tmpdir/pdb2-sc w] | |
642 | fconfigure $fi -translation binary | |
643 | puts -nonewline $fi $section_contrib | |
644 | close $fi | |
645 | ||
646 | set exp [file_contents "$srcdir/$subdir/pdb2-section-contrib.d"] | |
647 | set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb2-sc"] | |
648 | ||
649 | if [string equal $exp $got] { | |
650 | pass "Correct section contribution substream" | |
651 | } else { | |
652 | fail "Incorrect section contribution substream" | |
653 | } | |
654 | } | |
655 | ||
5967ca92 MH |
656 | proc test2 { } { |
657 | global as | |
658 | global ar | |
659 | global ld | |
660 | global srcdir | |
661 | global subdir | |
662 | ||
663 | if ![ld_assemble $as $srcdir/$subdir/pdb2a.s tmpdir/pdb2a.o] { | |
664 | unsupported "Build pdb2a.o" | |
665 | return | |
666 | } | |
667 | ||
668 | if ![ld_assemble $as $srcdir/$subdir/pdb2b.s tmpdir/pdb2b.o] { | |
669 | unsupported "Build pdb2b.o" | |
670 | return | |
671 | } | |
672 | ||
673 | set exec_output [run_host_cmd "$ar" "cr tmpdir/pdb2b.a tmpdir/pdb2b.o"] | |
674 | ||
675 | if ![string match "" $exec_output] { | |
676 | unsupported "Create pdb2b.a" | |
677 | return | |
678 | } | |
679 | ||
e2a1b0a0 | 680 | if ![ld_link $ld "tmpdir/pdb2.exe" "--pdb=tmpdir/pdb2.pdb --gc-sections -e foo tmpdir/pdb2a.o tmpdir/pdb2b.a"] { |
5967ca92 MH |
681 | unsupported "Create PE image with PDB file" |
682 | return | |
683 | } | |
684 | ||
685 | set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb2.pdb 0003"] | |
686 | ||
687 | if ![string match "" $exec_output] { | |
688 | return 0 | |
689 | } | |
690 | ||
691 | set fi [open tmpdir/0003] | |
692 | fconfigure $fi -translation binary | |
693 | ||
694 | seek $fi 24 | |
695 | ||
696 | set data [read $fi 4] | |
697 | binary scan $data i mod_info_size | |
698 | ||
e2a1b0a0 MH |
699 | set data [read $fi 4] |
700 | binary scan $data i section_contrib_size | |
701 | ||
702 | seek $fi 32 current | |
5967ca92 MH |
703 | |
704 | set mod_info [read $fi $mod_info_size] | |
e2a1b0a0 | 705 | set section_contrib [read $fi $section_contrib_size] |
5967ca92 MH |
706 | |
707 | close $fi | |
708 | ||
709 | test_mod_info $mod_info | |
e2a1b0a0 | 710 | test_section_contrib $section_contrib |
08827105 | 711 | } |
5967ca92 | 712 | |
f559276d MH |
713 | proc find_named_stream { pdb name } { |
714 | global ar | |
715 | ||
716 | set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb 0001"] | |
717 | ||
718 | if ![string match "" $exec_output] { | |
719 | return 0 | |
720 | } | |
721 | ||
722 | set fi [open tmpdir/0001] | |
723 | fconfigure $fi -translation binary | |
724 | ||
725 | seek $fi 0x1c | |
726 | ||
727 | set data [read $fi 4] | |
728 | binary scan $data i string_len | |
729 | ||
730 | set strings [read $fi $string_len] | |
731 | ||
732 | set string_off 0 | |
733 | ||
734 | while {[string first \000 $strings $string_off] != -1 } { | |
735 | set str [string range $strings $string_off [expr [string first \000 $strings $string_off] - 1]] | |
736 | ||
737 | if { $str eq $name } { | |
738 | break | |
739 | } | |
740 | ||
741 | incr string_off [expr [string length $str] + 1] | |
742 | } | |
743 | ||
744 | if { [string length $strings] == $string_off } { # string not found | |
745 | close $fi | |
746 | return 0 | |
747 | } | |
748 | ||
749 | set data [read $fi 4] | |
750 | binary scan $data i num_entries | |
751 | ||
752 | seek $fi 4 current | |
753 | ||
754 | set data [read $fi 4] | |
755 | binary scan $data i present_bitmap_len | |
756 | ||
757 | seek $fi [expr $present_bitmap_len * 4] current | |
758 | ||
759 | set data [read $fi 4] | |
760 | binary scan $data i deleted_bitmap_len | |
761 | ||
762 | seek $fi [expr $deleted_bitmap_len * 4] current | |
763 | ||
764 | for {set i 0} {$i < $num_entries} {incr i} { | |
765 | set data [read $fi 4] | |
766 | binary scan $data i offset | |
767 | ||
768 | if { $offset == $string_off } { | |
769 | set data [read $fi 4] | |
770 | binary scan $data i value | |
771 | close $fi | |
772 | ||
773 | return $value | |
774 | } | |
775 | ||
776 | seek $fi 4 current | |
777 | } | |
778 | ||
779 | close $fi | |
780 | ||
781 | return 0 | |
782 | } | |
783 | ||
784 | proc test3 { } { | |
785 | global as | |
786 | global ar | |
787 | global ld | |
788 | global objdump | |
789 | global srcdir | |
790 | global subdir | |
791 | ||
792 | if ![ld_assemble $as $srcdir/$subdir/pdb-strings1.s tmpdir/pdb-strings1.o] { | |
793 | unsupported "Build pdb-strings1.o" | |
794 | return | |
795 | } | |
796 | ||
797 | if ![ld_assemble $as $srcdir/$subdir/pdb-strings2.s tmpdir/pdb-strings2.o] { | |
798 | unsupported "Build pdb-strings2.o" | |
799 | return | |
800 | } | |
801 | ||
802 | if ![ld_link $ld "tmpdir/pdb-strings.exe" "--pdb=tmpdir/pdb-strings.pdb tmpdir/pdb-strings1.o tmpdir/pdb-strings2.o"] { | |
803 | unsupported "Create PE image with PDB file" | |
804 | return | |
805 | } | |
806 | ||
807 | set index [find_named_stream "tmpdir/pdb-strings.pdb" "/names"] | |
808 | ||
809 | if { $index == 0 } { | |
810 | fail "Could not find /names stream" | |
811 | return | |
812 | } else { | |
813 | pass "Found /names stream" | |
814 | } | |
815 | ||
816 | set index_str [format "%04x" $index] | |
817 | ||
818 | set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-strings.pdb $index_str"] | |
819 | ||
820 | if ![string match "" $exec_output] { | |
821 | return 0 | |
822 | } | |
823 | ||
824 | set exp [file_contents "$srcdir/$subdir/pdb-strings.d"] | |
825 | set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"] | |
826 | ||
827 | if ![string match $exp $got] { | |
828 | fail "Strings table was not as expected" | |
829 | } else { | |
830 | pass "Strings table was as expected" | |
831 | } | |
832 | } | |
833 | ||
803561cb MH |
834 | proc extract_c13_info { pdb mod_info } { |
835 | global ar | |
836 | ||
837 | binary scan [string range $mod_info 34 35] s module_sym_stream | |
838 | binary scan [string range $mod_info 36 39] i sym_byte_size | |
839 | binary scan [string range $mod_info 40 43] i c11_byte_size | |
840 | binary scan [string range $mod_info 44 47] i c13_byte_size | |
841 | ||
842 | set index_str [format "%04x" $module_sym_stream] | |
843 | ||
844 | set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb $index_str"] | |
845 | ||
846 | if ![string match "" $exec_output] { | |
847 | return "" | |
848 | } | |
849 | ||
850 | set fi [open tmpdir/$index_str] | |
851 | fconfigure $fi -translation binary | |
852 | ||
853 | seek $fi [expr $sym_byte_size + $c11_byte_size] | |
854 | ||
855 | set data [read $fi $c13_byte_size] | |
856 | ||
857 | close $fi | |
858 | ||
859 | return $data | |
860 | } | |
861 | ||
862 | proc test4 { } { | |
863 | global as | |
864 | global ar | |
865 | global ld | |
866 | global objdump | |
867 | global srcdir | |
868 | global subdir | |
869 | ||
870 | if ![ld_assemble $as $srcdir/$subdir/pdb3a.s tmpdir/pdb3a.o] { | |
871 | unsupported "Build pdb3a.o" | |
872 | return | |
873 | } | |
874 | ||
875 | if ![ld_assemble $as $srcdir/$subdir/pdb3b.s tmpdir/pdb3b.o] { | |
876 | unsupported "Build pdb3b.o" | |
877 | return | |
878 | } | |
879 | ||
598c1ae6 | 880 | if ![ld_link $ld "tmpdir/pdb3.exe" "--pdb=tmpdir/pdb3.pdb --gc-sections -e main tmpdir/pdb3a.o tmpdir/pdb3b.o"] { |
803561cb MH |
881 | unsupported "Create PE image with PDB file" |
882 | return | |
883 | } | |
884 | ||
885 | # read relevant bits from DBI stream | |
886 | ||
887 | set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb3.pdb 0003"] | |
888 | ||
889 | if ![string match "" $exec_output] { | |
890 | fail "Could not extract DBI stream" | |
891 | return | |
892 | } else { | |
893 | pass "Extracted DBI stream" | |
894 | } | |
895 | ||
896 | set fi [open tmpdir/0003] | |
897 | fconfigure $fi -translation binary | |
898 | ||
899 | seek $fi 24 | |
900 | ||
901 | # read substream sizes | |
902 | ||
903 | set data [read $fi 4] | |
904 | binary scan $data i mod_info_size | |
905 | ||
906 | set data [read $fi 4] | |
907 | binary scan $data i section_contribution_size | |
908 | ||
909 | set data [read $fi 4] | |
910 | binary scan $data i section_map_size | |
911 | ||
912 | set data [read $fi 4] | |
913 | binary scan $data i source_info_size | |
914 | ||
915 | seek $fi 24 current | |
916 | ||
917 | set mod_info [read $fi $mod_info_size] | |
918 | ||
919 | seek $fi [expr $section_contribution_size + $section_map_size] current | |
920 | ||
921 | set source_info [read $fi $source_info_size] | |
922 | ||
923 | close $fi | |
924 | ||
925 | # check source info substream | |
926 | ||
927 | set fi [open tmpdir/pdb3-source-info w] | |
928 | fconfigure $fi -translation binary | |
929 | puts -nonewline $fi $source_info | |
930 | close $fi | |
931 | ||
932 | set exp [file_contents "$srcdir/$subdir/pdb3-source-info.d"] | |
933 | set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb3-source-info"] | |
934 | ||
935 | if [string match $exp $got] { | |
936 | pass "Correct source info substream" | |
937 | } else { | |
938 | fail "Incorrect source info substream" | |
939 | } | |
940 | ||
941 | # check C13 info in first module | |
942 | ||
943 | set c13_info [extract_c13_info "tmpdir/pdb3.pdb" [string range $mod_info 0 63]] | |
944 | ||
945 | set fi [open tmpdir/pdb3-c13-info1 w] | |
946 | fconfigure $fi -translation binary | |
947 | puts -nonewline $fi $c13_info | |
948 | close $fi | |
949 | ||
950 | set exp [file_contents "$srcdir/$subdir/pdb3-c13-info1.d"] | |
951 | set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb3-c13-info1"] | |
952 | ||
953 | if [string match $exp $got] { | |
954 | pass "Correct C13 info for first module" | |
955 | } else { | |
956 | fail "Incorrect C13 info for first module" | |
957 | } | |
958 | ||
959 | # check C13 info in second module | |
960 | ||
961 | set fn1_end [string first \000 $mod_info 64] | |
962 | set fn2_end [string first \000 $mod_info [expr $fn1_end + 1]] | |
963 | ||
964 | set off [expr $fn2_end + 1] | |
965 | ||
966 | if { [expr $off % 4] != 0 } { | |
967 | set off [expr $off + 4 - ($off % 4)] | |
968 | } | |
969 | ||
970 | set c13_info [extract_c13_info "tmpdir/pdb3.pdb" [string range $mod_info $off [expr $off + 63]]] | |
971 | ||
972 | set fi [open tmpdir/pdb3-c13-info2 w] | |
973 | fconfigure $fi -translation binary | |
974 | puts -nonewline $fi $c13_info | |
975 | close $fi | |
976 | ||
977 | set exp [file_contents "$srcdir/$subdir/pdb3-c13-info2.d"] | |
978 | set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb3-c13-info2"] | |
979 | ||
980 | if [string match $exp $got] { | |
981 | pass "Correct C13 info for second module" | |
982 | } else { | |
983 | fail "Incorrect C13 info for second module" | |
984 | } | |
985 | } | |
986 | ||
d5b4c0dd MH |
987 | proc test5 { } { |
988 | global as | |
989 | global ar | |
990 | global ld | |
991 | global objdump | |
992 | global srcdir | |
993 | global subdir | |
994 | ||
995 | if ![ld_assemble $as $srcdir/$subdir/pdb-types1a.s tmpdir/pdb-types1a.o] { | |
996 | unsupported "Build pdb-types1a.o" | |
997 | return | |
998 | } | |
999 | ||
1000 | if ![ld_assemble $as $srcdir/$subdir/pdb-types1b.s tmpdir/pdb-types1b.o] { | |
1001 | unsupported "Build pdb-types1b.o" | |
1002 | return | |
1003 | } | |
1004 | ||
1005 | if ![ld_link $ld "tmpdir/pdb-types1.exe" "--pdb=tmpdir/pdb-types1.pdb tmpdir/pdb-types1a.o tmpdir/pdb-types1b.o"] { | |
1006 | unsupported "Create PE image with PDB file" | |
1007 | return | |
1008 | } | |
1009 | ||
1010 | set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-types1.pdb 0002"] | |
1011 | ||
1012 | if ![string match "" $exec_output] { | |
1013 | fail "Could not extract TPI stream" | |
1014 | return | |
1015 | } else { | |
1016 | pass "Extracted TPI stream" | |
1017 | } | |
1018 | ||
1019 | # check values in TPI header, and save anything interesting | |
1020 | ||
1021 | set fi [open tmpdir/0002] | |
1022 | fconfigure $fi -translation binary | |
1023 | ||
1024 | seek $fi 8 current | |
1025 | ||
1026 | set data [read $fi 4] | |
1027 | binary scan $data i first_type | |
1028 | ||
1029 | if { $first_type != 0x1000 } { | |
1030 | fail "Incorrect first type value in TPI stream." | |
1031 | } else { | |
1032 | pass "Correct first type value in TPI stream." | |
1033 | } | |
1034 | ||
1035 | set data [read $fi 4] | |
1036 | binary scan $data i end_type | |
1037 | ||
1038 | # end_type is one greater than the last type in the stream | |
5c9e42e0 | 1039 | if { $end_type != 0x102c } { |
d5b4c0dd MH |
1040 | fail "Incorrect end type value in TPI stream." |
1041 | } else { | |
1042 | pass "Correct end type value in TPI stream." | |
1043 | } | |
1044 | ||
1045 | set data [read $fi 4] | |
1046 | binary scan $data i type_list_size | |
1047 | ||
1048 | set data [read $fi 2] | |
1049 | binary scan $data s hash_stream_index | |
1050 | ||
1051 | seek $fi 2 current | |
1052 | ||
1053 | set data [read $fi 4] | |
1054 | binary scan $data i hash_size | |
1055 | ||
1056 | if { $hash_size != 4 } { | |
1057 | fail "Incorrect hash size in TPI stream." | |
1058 | } else { | |
1059 | pass "Correct hash size in TPI stream." | |
1060 | } | |
1061 | ||
1062 | set data [read $fi 4] | |
1063 | binary scan $data i num_buckets | |
1064 | ||
1065 | if { $num_buckets != 0x3ffff } { | |
1066 | fail "Incorrect number of buckets in TPI stream." | |
1067 | } else { | |
1068 | pass "Correct number of buckets in TPI stream." | |
1069 | } | |
1070 | ||
1071 | set data [read $fi 4] | |
1072 | binary scan $data i hash_list_offset | |
1073 | ||
1074 | set data [read $fi 4] | |
1075 | binary scan $data i hash_list_size | |
1076 | ||
1077 | set data [read $fi 4] | |
1078 | binary scan $data i skip_list_offset | |
1079 | ||
1080 | set data [read $fi 4] | |
1081 | binary scan $data i skip_list_size | |
1082 | ||
1083 | seek $fi 8 current | |
1084 | ||
1085 | set type_list [read $fi $type_list_size] | |
1086 | ||
1087 | close $fi | |
1088 | ||
1089 | set fi [open tmpdir/pdb-types1-typelist w] | |
1090 | fconfigure $fi -translation binary | |
1091 | puts -nonewline $fi $type_list | |
1092 | close $fi | |
1093 | ||
1094 | # check type list | |
1095 | ||
1096 | set exp [file_contents "$srcdir/$subdir/pdb-types1-typelist.d"] | |
1097 | set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types1-typelist"] | |
1098 | if ![string match $exp $got] { | |
1099 | fail "Incorrect type list in TPI stream." | |
1100 | } else { | |
1101 | pass "Correct type list in TPI stream." | |
1102 | } | |
1103 | ||
1104 | # extract hash list and skip list | |
1105 | ||
1106 | set index_str [format "%04x" $hash_stream_index] | |
1107 | ||
1108 | set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-types1.pdb $index_str"] | |
1109 | ||
1110 | if ![string match "" $exec_output] { | |
1111 | fail "Could not extract TPI hash stream." | |
1112 | } else { | |
1113 | pass "Extracted TPI hash stream." | |
1114 | } | |
1115 | ||
1116 | set fi [open tmpdir/$index_str] | |
1117 | fconfigure $fi -translation binary | |
1118 | ||
1119 | seek $fi $hash_list_offset | |
1120 | set hash_list [read $fi $hash_list_size] | |
1121 | ||
1122 | seek $fi $skip_list_offset | |
1123 | set skip_list [read $fi $skip_list_size] | |
1124 | ||
1125 | close $fi | |
1126 | ||
1127 | # check hash list | |
1128 | ||
1129 | set fi [open tmpdir/pdb-types1-hashlist w] | |
1130 | fconfigure $fi -translation binary | |
1131 | puts -nonewline $fi $hash_list | |
1132 | close $fi | |
1133 | ||
1134 | set exp [file_contents "$srcdir/$subdir/pdb-types1-hashlist.d"] | |
1135 | set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types1-hashlist"] | |
1136 | if ![string match $exp $got] { | |
1137 | fail "Incorrect hash list in TPI stream." | |
1138 | } else { | |
1139 | pass "Correct hash list in TPI stream." | |
1140 | } | |
1141 | ||
1142 | # check skip list | |
1143 | ||
1144 | set fi [open tmpdir/pdb-types1-skiplist w] | |
1145 | fconfigure $fi -translation binary | |
1146 | puts -nonewline $fi $skip_list | |
1147 | close $fi | |
1148 | ||
1149 | set exp [file_contents "$srcdir/$subdir/pdb-types1-skiplist.d"] | |
1150 | set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types1-skiplist"] | |
1151 | if ![string match $exp $got] { | |
1152 | fail "Incorrect skip list in TPI stream." | |
1153 | } else { | |
1154 | pass "Correct skip list in TPI stream." | |
1155 | } | |
1156 | } | |
1157 | ||
fca9096a MH |
1158 | proc test6 { } { |
1159 | global as | |
1160 | global ar | |
1161 | global ld | |
1162 | global objdump | |
1163 | global srcdir | |
1164 | global subdir | |
1165 | ||
1166 | if ![ld_assemble $as $srcdir/$subdir/pdb-types2a.s tmpdir/pdb-types2a.o] { | |
1167 | unsupported "Build pdb-types2a.o" | |
1168 | return | |
1169 | } | |
1170 | ||
1171 | if ![ld_assemble $as $srcdir/$subdir/pdb-types2b.s tmpdir/pdb-types2b.o] { | |
1172 | unsupported "Build pdb-types2b.o" | |
1173 | return | |
1174 | } | |
1175 | ||
1176 | if ![ld_link $ld "tmpdir/pdb-types2.exe" "--pdb=tmpdir/pdb-types2.pdb tmpdir/pdb-types2a.o tmpdir/pdb-types2b.o"] { | |
1177 | unsupported "Create PE image with PDB file" | |
1178 | return | |
1179 | } | |
1180 | ||
1181 | set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-types2.pdb 0004"] | |
1182 | ||
1183 | if ![string match "" $exec_output] { | |
1184 | fail "Could not extract IPI stream" | |
1185 | return | |
1186 | } else { | |
1187 | pass "Extracted IPI stream" | |
1188 | } | |
1189 | ||
1190 | # check values in IPI header, and save anything interesting | |
1191 | ||
1192 | set fi [open tmpdir/0004] | |
1193 | fconfigure $fi -translation binary | |
1194 | ||
1195 | seek $fi 8 current | |
1196 | ||
1197 | set data [read $fi 4] | |
1198 | binary scan $data i first_type | |
1199 | ||
1200 | if { $first_type != 0x1000 } { | |
1201 | fail "Incorrect first type value in IPI stream." | |
1202 | } else { | |
1203 | pass "Correct first type value in IPI stream." | |
1204 | } | |
1205 | ||
1206 | set data [read $fi 4] | |
1207 | binary scan $data i end_type | |
1208 | ||
1209 | # end_type is one greater than the last type in the stream | |
1210 | if { $end_type != 0x100f } { | |
1211 | fail "Incorrect end type value in IPI stream." | |
1212 | } else { | |
1213 | pass "Correct end type value in IPI stream." | |
1214 | } | |
1215 | ||
1216 | set data [read $fi 4] | |
1217 | binary scan $data i type_list_size | |
1218 | ||
1219 | set data [read $fi 2] | |
1220 | binary scan $data s hash_stream_index | |
1221 | ||
1222 | seek $fi 2 current | |
1223 | ||
1224 | set data [read $fi 4] | |
1225 | binary scan $data i hash_size | |
1226 | ||
1227 | if { $hash_size != 4 } { | |
1228 | fail "Incorrect hash size in IPI stream." | |
1229 | } else { | |
1230 | pass "Correct hash size in IPI stream." | |
1231 | } | |
1232 | ||
1233 | set data [read $fi 4] | |
1234 | binary scan $data i num_buckets | |
1235 | ||
1236 | if { $num_buckets != 0x3ffff } { | |
1237 | fail "Incorrect number of buckets in IPI stream." | |
1238 | } else { | |
1239 | pass "Correct number of buckets in IPI stream." | |
1240 | } | |
1241 | ||
1242 | set data [read $fi 4] | |
1243 | binary scan $data i hash_list_offset | |
1244 | ||
1245 | set data [read $fi 4] | |
1246 | binary scan $data i hash_list_size | |
1247 | ||
1248 | set data [read $fi 4] | |
1249 | binary scan $data i skip_list_offset | |
1250 | ||
1251 | set data [read $fi 4] | |
1252 | binary scan $data i skip_list_size | |
1253 | ||
1254 | seek $fi 8 current | |
1255 | ||
1256 | set type_list [read $fi $type_list_size] | |
1257 | ||
1258 | close $fi | |
1259 | ||
1260 | set fi [open tmpdir/pdb-types2-typelist w] | |
1261 | fconfigure $fi -translation binary | |
1262 | puts -nonewline $fi $type_list | |
1263 | close $fi | |
1264 | ||
1265 | # check type list | |
1266 | ||
1267 | set exp [file_contents "$srcdir/$subdir/pdb-types2-typelist.d"] | |
1268 | set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types2-typelist"] | |
1269 | if ![string match $exp $got] { | |
1270 | fail "Incorrect type list in IPI stream." | |
1271 | } else { | |
1272 | pass "Correct type list in IPI stream." | |
1273 | } | |
1274 | ||
1275 | # extract hash list and skip list | |
1276 | ||
1277 | set index_str [format "%04x" $hash_stream_index] | |
1278 | ||
1279 | set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-types2.pdb $index_str"] | |
1280 | ||
1281 | if ![string match "" $exec_output] { | |
1282 | fail "Could not extract IPI hash stream." | |
1283 | } else { | |
1284 | pass "Extracted IPI hash stream." | |
1285 | } | |
1286 | ||
1287 | set fi [open tmpdir/$index_str] | |
1288 | fconfigure $fi -translation binary | |
1289 | ||
1290 | seek $fi $hash_list_offset | |
1291 | set hash_list [read $fi $hash_list_size] | |
1292 | ||
1293 | seek $fi $skip_list_offset | |
1294 | set skip_list [read $fi $skip_list_size] | |
1295 | ||
1296 | close $fi | |
1297 | ||
1298 | # check hash list | |
1299 | ||
1300 | set fi [open tmpdir/pdb-types2-hashlist w] | |
1301 | fconfigure $fi -translation binary | |
1302 | puts -nonewline $fi $hash_list | |
1303 | close $fi | |
1304 | ||
1305 | set exp [file_contents "$srcdir/$subdir/pdb-types2-hashlist.d"] | |
1306 | set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types2-hashlist"] | |
1307 | if ![string match $exp $got] { | |
1308 | fail "Incorrect hash list in IPI stream." | |
1309 | } else { | |
1310 | pass "Correct hash list in IPI stream." | |
1311 | } | |
1312 | ||
1313 | # check skip list | |
1314 | ||
1315 | set fi [open tmpdir/pdb-types2-skiplist w] | |
1316 | fconfigure $fi -translation binary | |
1317 | puts -nonewline $fi $skip_list | |
1318 | close $fi | |
1319 | ||
1320 | set exp [file_contents "$srcdir/$subdir/pdb-types2-skiplist.d"] | |
1321 | set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types2-skiplist"] | |
1322 | if ![string match $exp $got] { | |
1323 | fail "Incorrect skip list in IPI stream." | |
1324 | } else { | |
1325 | pass "Correct skip list in IPI stream." | |
1326 | } | |
1327 | } | |
1328 | ||
81784004 MH |
1329 | proc test7 { } { |
1330 | global as | |
1331 | global ar | |
1332 | global ld | |
1333 | global objdump | |
1334 | global srcdir | |
1335 | global subdir | |
1336 | ||
1337 | if ![ld_assemble $as $srcdir/$subdir/pdb-types3a.s tmpdir/pdb-types3a.o] { | |
1338 | unsupported "Build pdb-types3a.o" | |
1339 | return | |
1340 | } | |
1341 | ||
1342 | if ![ld_assemble $as $srcdir/$subdir/pdb-types3b.s tmpdir/pdb-types3b.o] { | |
1343 | unsupported "Build pdb-types3b.o" | |
1344 | return | |
1345 | } | |
1346 | ||
1347 | if ![ld_link $ld "tmpdir/pdb-types3.exe" "--pdb=tmpdir/pdb-types3.pdb tmpdir/pdb-types3a.o tmpdir/pdb-types3b.o"] { | |
1348 | unsupported "Create PE image with PDB file" | |
1349 | return | |
1350 | } | |
1351 | ||
1352 | set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-types3.pdb 0004"] | |
1353 | ||
1354 | if ![string match "" $exec_output] { | |
1355 | fail "Could not extract IPI stream" | |
1356 | return | |
1357 | } else { | |
1358 | pass "Extracted IPI stream" | |
1359 | } | |
1360 | ||
1361 | set fi [open tmpdir/0004] | |
1362 | fconfigure $fi -translation binary | |
1363 | ||
1364 | seek $fi 16 current | |
1365 | ||
1366 | set data [read $fi 4] | |
1367 | binary scan $data i type_list_size | |
1368 | ||
1369 | set data [read $fi 2] | |
1370 | binary scan $data s hash_stream_index | |
1371 | ||
1372 | seek $fi 10 current | |
1373 | ||
1374 | set data [read $fi 4] | |
1375 | binary scan $data i hash_list_offset | |
1376 | ||
1377 | set data [read $fi 4] | |
1378 | binary scan $data i hash_list_size | |
1379 | ||
1380 | set data [read $fi 4] | |
1381 | binary scan $data i skip_list_offset | |
1382 | ||
1383 | set data [read $fi 4] | |
1384 | binary scan $data i skip_list_size | |
1385 | ||
1386 | seek $fi 8 current | |
1387 | ||
1388 | set type_list [read $fi $type_list_size] | |
1389 | ||
1390 | close $fi | |
1391 | ||
1392 | set fi [open tmpdir/pdb-types3-typelist w] | |
1393 | fconfigure $fi -translation binary | |
1394 | puts -nonewline $fi $type_list | |
1395 | close $fi | |
1396 | ||
1397 | # check type list | |
1398 | ||
1399 | set exp [file_contents "$srcdir/$subdir/pdb-types3-typelist.d"] | |
1400 | set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types3-typelist"] | |
1401 | if ![string match $exp $got] { | |
1402 | fail "Incorrect type list in IPI stream." | |
1403 | } else { | |
1404 | pass "Correct type list in IPI stream." | |
1405 | } | |
1406 | ||
1407 | # extract hash list and skip list | |
1408 | ||
1409 | set index_str [format "%04x" $hash_stream_index] | |
1410 | ||
1411 | set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-types3.pdb $index_str"] | |
1412 | ||
1413 | if ![string match "" $exec_output] { | |
1414 | fail "Could not extract IPI hash stream." | |
1415 | } else { | |
1416 | pass "Extracted IPI hash stream." | |
1417 | } | |
1418 | ||
1419 | set fi [open tmpdir/$index_str] | |
1420 | fconfigure $fi -translation binary | |
1421 | ||
1422 | seek $fi $hash_list_offset | |
1423 | set hash_list [read $fi $hash_list_size] | |
1424 | ||
1425 | seek $fi $skip_list_offset | |
1426 | set skip_list [read $fi $skip_list_size] | |
1427 | ||
1428 | close $fi | |
1429 | ||
1430 | # check hash list | |
1431 | ||
1432 | set fi [open tmpdir/pdb-types3-hashlist w] | |
1433 | fconfigure $fi -translation binary | |
1434 | puts -nonewline $fi $hash_list | |
1435 | close $fi | |
1436 | ||
1437 | set exp [file_contents "$srcdir/$subdir/pdb-types3-hashlist.d"] | |
1438 | set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types3-hashlist"] | |
1439 | if ![string match $exp $got] { | |
1440 | fail "Incorrect hash list in IPI stream." | |
1441 | } else { | |
1442 | pass "Correct hash list in IPI stream." | |
1443 | } | |
1444 | ||
1445 | # check skip list | |
1446 | ||
1447 | set fi [open tmpdir/pdb-types3-skiplist w] | |
1448 | fconfigure $fi -translation binary | |
1449 | puts -nonewline $fi $skip_list | |
1450 | close $fi | |
1451 | ||
1452 | set exp [file_contents "$srcdir/$subdir/pdb-types3-skiplist.d"] | |
1453 | set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types3-skiplist"] | |
1454 | if ![string match $exp $got] { | |
1455 | fail "Incorrect skip list in IPI stream." | |
1456 | } else { | |
1457 | pass "Correct skip list in IPI stream." | |
1458 | } | |
1459 | } | |
1460 | ||
81814b6f MH |
1461 | proc test8 { } { |
1462 | global as | |
1463 | global ar | |
1464 | global ld | |
1465 | global objdump | |
1466 | global srcdir | |
1467 | global subdir | |
1468 | ||
1469 | if ![ld_assemble $as $srcdir/$subdir/pdb-syms1a.s tmpdir/pdb-syms1a.o] { | |
1470 | unsupported "Build pdb-syms1a.o" | |
1471 | return | |
1472 | } | |
1473 | ||
1474 | if ![ld_assemble $as $srcdir/$subdir/pdb-syms1b.s tmpdir/pdb-syms1b.o] { | |
1475 | unsupported "Build pdb-syms1b.o" | |
1476 | return | |
1477 | } | |
1478 | ||
1479 | if ![ld_link $ld "tmpdir/pdb-syms1.exe" "--pdb=tmpdir/pdb-syms1.pdb tmpdir/pdb-syms1a.o tmpdir/pdb-syms1b.o"] { | |
1480 | unsupported "Create PE image with PDB file" | |
1481 | return | |
1482 | } | |
1483 | ||
1484 | # get index of globals stream and records stream | |
1485 | ||
1486 | set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms1.pdb 0003"] | |
1487 | ||
1488 | if ![string match "" $exec_output] { | |
1489 | fail "Could not extract DBI stream" | |
1490 | return | |
1491 | } else { | |
1492 | pass "Extracted DBI stream" | |
1493 | } | |
1494 | ||
1495 | set fi [open tmpdir/0003] | |
1496 | fconfigure $fi -translation binary | |
1497 | ||
1498 | seek $fi 12 | |
1499 | set data [read $fi 2] | |
1500 | binary scan $data s globals_index | |
1501 | ||
1502 | seek $fi 6 current | |
1503 | set data [read $fi 2] | |
1504 | binary scan $data s records_index | |
1505 | ||
1506 | seek $fi 2 current | |
1507 | set data [read $fi 4] | |
1508 | binary scan $data i mod_info_size | |
1509 | ||
1510 | seek $fi 36 current | |
1511 | set mod_info [read $fi $mod_info_size] | |
1512 | ||
1513 | close $fi | |
1514 | ||
1515 | # get index of first and second module streams | |
1516 | ||
1517 | binary scan [string range $mod_info 34 35] s mod1_index | |
1518 | ||
1519 | set off 64 | |
1520 | ||
1521 | set obj1 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]] | |
1522 | incr off [expr [string length $obj1] + 1] | |
1523 | ||
1524 | set ar1 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]] | |
1525 | incr off [expr [string length $ar1] + 1] | |
1526 | ||
1527 | if { [expr $off % 4] != 0 } { | |
1528 | set off [expr $off + 4 - ($off % 4)] | |
1529 | } | |
1530 | ||
1531 | incr off 34 | |
1532 | ||
1533 | binary scan [string range $mod_info $off [expr $off + 1]] s mod2_index | |
1534 | ||
1535 | # check globals stream | |
1536 | ||
1537 | set index_str [format "%04x" $globals_index] | |
1538 | ||
1539 | set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms1.pdb $index_str"] | |
1540 | ||
1541 | if ![string match "" $exec_output] { | |
1542 | fail "Could not extract globals stream" | |
1543 | return | |
1544 | } else { | |
1545 | pass "Extracted globals stream" | |
1546 | } | |
1547 | ||
1548 | set exp [file_contents "$srcdir/$subdir/pdb-syms1-globals.d"] | |
1549 | set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"] | |
1550 | ||
1551 | if [string match $exp $got] { | |
1552 | pass "Correct globals stream" | |
1553 | } else { | |
1554 | fail "Incorrect globals stream" | |
1555 | } | |
1556 | ||
1557 | # check records stream | |
1558 | ||
1559 | set index_str [format "%04x" $records_index] | |
1560 | ||
1561 | set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms1.pdb $index_str"] | |
1562 | ||
1563 | if ![string match "" $exec_output] { | |
1564 | fail "Could not extract records stream" | |
1565 | return | |
1566 | } else { | |
1567 | pass "Extracted records stream" | |
1568 | } | |
1569 | ||
1570 | set exp [file_contents "$srcdir/$subdir/pdb-syms1-records.d"] | |
1571 | set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"] | |
1572 | ||
1573 | if [string match $exp $got] { | |
1574 | pass "Correct records stream" | |
1575 | } else { | |
1576 | fail "Incorrect records stream" | |
1577 | } | |
1578 | ||
1579 | # check symbols in first module | |
1580 | ||
1581 | set index_str [format "%04x" $mod1_index] | |
1582 | ||
1583 | set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms1.pdb $index_str"] | |
1584 | ||
1585 | if ![string match "" $exec_output] { | |
1586 | fail "Could not extract first module's symbols" | |
1587 | return | |
1588 | } else { | |
1589 | pass "Extracted first module's symbols" | |
1590 | } | |
1591 | ||
1592 | set exp [file_contents "$srcdir/$subdir/pdb-syms1-symbols1.d"] | |
1593 | set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"] | |
1594 | ||
1595 | if [string match $exp $got] { | |
1596 | pass "Correct symbols in first module's stream" | |
1597 | } else { | |
1598 | fail "Incorrect symbols in first module's stream" | |
1599 | } | |
1600 | ||
1601 | # check symbols in second module | |
1602 | ||
1603 | set index_str [format "%04x" $mod2_index] | |
1604 | ||
1605 | set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms1.pdb $index_str"] | |
1606 | ||
1607 | if ![string match "" $exec_output] { | |
1608 | fail "Could not extract second module's symbols" | |
1609 | return | |
1610 | } else { | |
1611 | pass "Extracted second module's symbols" | |
1612 | } | |
1613 | ||
1614 | set exp [file_contents "$srcdir/$subdir/pdb-syms1-symbols2.d"] | |
1615 | set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"] | |
1616 | ||
1617 | if [string match $exp $got] { | |
1618 | pass "Correct symbols in second module's stream" | |
1619 | } else { | |
1620 | fail "Incorrect symbols in second module's stream" | |
1621 | } | |
1622 | } | |
1623 | ||
5d9c0336 MH |
1624 | proc test9 { } { |
1625 | global as | |
1626 | global ar | |
1627 | global ld | |
1628 | global objdump | |
1629 | global srcdir | |
1630 | global subdir | |
1631 | ||
1632 | if ![ld_assemble $as $srcdir/$subdir/pdb-syms2.s tmpdir/pdb-syms2.o] { | |
1633 | unsupported "Build pdb-syms2.o" | |
1634 | return | |
1635 | } | |
1636 | ||
1637 | if ![ld_link $ld "tmpdir/pdb-syms2.exe" "--pdb=tmpdir/pdb-syms2.pdb tmpdir/pdb-syms2.o"] { | |
1638 | unsupported "Create PE image with PDB file" | |
1639 | return | |
1640 | } | |
1641 | ||
1642 | # get index of module stream | |
1643 | ||
1644 | set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms2.pdb 0003"] | |
1645 | ||
1646 | if ![string match "" $exec_output] { | |
1647 | fail "Could not extract DBI stream" | |
1648 | return | |
1649 | } else { | |
1650 | pass "Extracted DBI stream" | |
1651 | } | |
1652 | ||
1653 | set fi [open tmpdir/0003] | |
1654 | fconfigure $fi -translation binary | |
1655 | ||
1656 | seek $fi 24 | |
1657 | set data [read $fi 4] | |
1658 | binary scan $data i mod_info_size | |
1659 | ||
1660 | seek $fi 36 current | |
1661 | set mod_info [read $fi $mod_info_size] | |
1662 | ||
1663 | close $fi | |
1664 | ||
1665 | binary scan [string range $mod_info 34 35] s module_index | |
1666 | ||
1667 | # check module records | |
1668 | ||
1669 | set index_str [format "%04x" $module_index] | |
1670 | ||
1671 | set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms2.pdb $index_str"] | |
1672 | ||
1673 | if ![string match "" $exec_output] { | |
1674 | fail "Could not extract module symbols" | |
1675 | return | |
1676 | } else { | |
1677 | pass "Extracted module symbols" | |
1678 | } | |
1679 | ||
1680 | set exp [file_contents "$srcdir/$subdir/pdb-syms2-symbols1.d"] | |
1681 | set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"] | |
1682 | ||
1683 | if [string match $exp $got] { | |
1684 | pass "Correct symbols in module stream" | |
1685 | } else { | |
1686 | fail "Incorrect symbols in module stream" | |
1687 | } | |
8d25f5ef MH |
1688 | |
1689 | # check linker symbols | |
1690 | ||
1691 | set off 64 | |
1692 | ||
1693 | set obj1 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]] | |
1694 | incr off [expr [string length $obj1] + 1] | |
1695 | ||
1696 | set ar1 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]] | |
1697 | incr off [expr [string length $ar1] + 1] | |
1698 | ||
1699 | if { [expr $off % 4] != 0 } { | |
1700 | set off [expr $off + 4 - ($off % 4)] | |
1701 | } | |
1702 | ||
1703 | incr off 34 | |
1704 | ||
1705 | binary scan [string range $mod_info $off [expr $off + 1]] s linker_syms_index | |
1706 | ||
1707 | set index_str [format "%04x" $linker_syms_index] | |
1708 | ||
1709 | set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms2.pdb $index_str"] | |
1710 | ||
1711 | if ![string match "" $exec_output] { | |
1712 | fail "Could not extract linker symbols" | |
1713 | return | |
1714 | } else { | |
1715 | pass "Extracted linker symbols" | |
1716 | } | |
1717 | ||
1718 | set syms [file_contents "tmpdir/$index_str"] | |
1719 | ||
1720 | # check S_OBJNAME | |
1721 | ||
1722 | set off 4 | |
1723 | binary scan [string range $syms $off [expr $off + 1]] s sym_len | |
1724 | binary scan [string range $syms [expr $off + 2] [expr $off + 3]] s sym_type | |
1725 | ||
1726 | if { $sym_type != 0x1101 } { | |
1727 | fail "First linker symbol was not S_OBJNAME" | |
1728 | } else { | |
1729 | pass "First linker symbol was S_OBJNAME" | |
1730 | ||
1731 | set linker_fn [string range $syms [expr $off + 8] [expr [string first \000 $syms [expr $off + 8]] - 1]] | |
1732 | ||
1733 | if ![string equal $linker_fn "* Linker *"] { | |
1734 | fail "Incorrect linker object name" | |
1735 | } else { | |
1736 | pass "Correct linker object name" | |
1737 | } | |
1738 | } | |
1739 | ||
1740 | incr off [expr $sym_len + 2] | |
1741 | ||
1742 | # check S_COMPILE3 | |
1743 | ||
1744 | binary scan [string range $syms $off [expr $off + 1]] s sym_len | |
1745 | binary scan [string range $syms [expr $off + 2] [expr $off + 3]] s sym_type | |
1746 | ||
1747 | if { $sym_type != 0x113c } { | |
1748 | fail "Second linker symbol was not S_COMPILE3" | |
1749 | } else { | |
1750 | pass "Second linker symbol was S_COMPILE3" | |
1751 | } | |
1752 | ||
1753 | incr off [expr $sym_len + 2] | |
1754 | ||
1755 | # check S_ENVBLOCK | |
1756 | ||
1757 | binary scan [string range $syms $off [expr $off + 1]] s sym_len | |
1758 | binary scan [string range $syms [expr $off + 2] [expr $off + 3]] s sym_type | |
1759 | ||
1760 | if { $sym_type != 0x113d } { | |
1761 | fail "Third linker symbol was not S_ENVBLOCK" | |
1762 | } else { | |
1763 | pass "Third linker symbol was S_ENVBLOCK" | |
1764 | } | |
5d9c0336 MH |
1765 | } |
1766 | ||
5967ca92 MH |
1767 | test1 |
1768 | test2 | |
f559276d | 1769 | test3 |
803561cb | 1770 | test4 |
d5b4c0dd | 1771 | test5 |
fca9096a | 1772 | test6 |
81784004 | 1773 | test7 |
81814b6f | 1774 | test8 |
5d9c0336 | 1775 | test9 |