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