ld/testsuite/ld-pe/pdb.exp

   1 # Expect script for creating PDB files when linking.
   2 #   Copyright (C) 2022-2025 Free Software Foundation, Inc.
   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 i*86-*-cygwin*]
  23   && ![istarget i*86-*-winnt]
  24   && ![istarget i*86-*-pe]
  25   && ![istarget x86_64-*-mingw*]
  26   && ![istarget x86_64-*-pe*]
  27   && ![istarget x86_64-*-cygwin]
  28   && ![istarget aarch64-*-mingw*]
  29   && ![istarget aarch64-*-pe*]} {
  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
  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
 266     # skip MFC type server index
 267     seek $fi 4 current
 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
 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] } {
 282         return 0
 283     }
 284
 285     return 1
 286 }
 287
 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
 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
 504 proc test1 { } {
 505     global as
 506     global ld
 507     global srcdir
 508     global subdir
 509
 510     if ![ld_assemble $as $srcdir/$subdir/pdb1.s tmpdir/pdb1.o] {
 511         unsupported "Build pdb1.o"
 512         return
 513     }
 514
 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     }
 519
 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     }
 524
 525     pass "PDB filename present in CodeView debug info"
 526
 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     }
 532
 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     }
 550
 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     }
 562 }
 563
 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
 616 proc test_section_contrib { section_contrib } {
 617     global objdump
 618     global srcdir
 619     global subdir
 620
 621     set fi [open tmpdir/pdb2-sc w]
 622     fconfigure $fi -translation binary
 623     puts -nonewline $fi $section_contrib
 624     close $fi
 625
 626     set exp [file_contents "$srcdir/$subdir/pdb2-section-contrib.d"]
 627     set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb2-sc"]
 628
 629     if [string equal $exp $got] {
 630         pass "Correct section contribution substream"
 631     } else {
 632         fail "Incorrect section contribution substream"
 633     }
 634 }
 635
 636 proc test2 { } {
 637     global as
 638     global ar
 639     global ld
 640     global srcdir
 641     global subdir
 642
 643     if ![ld_assemble $as $srcdir/$subdir/pdb2a.s tmpdir/pdb2a.o] {
 644         unsupported "Build pdb2a.o"
 645         return
 646     }
 647
 648     if ![ld_assemble $as $srcdir/$subdir/pdb2b.s tmpdir/pdb2b.o] {
 649         unsupported "Build pdb2b.o"
 650         return
 651     }
 652
 653     set exec_output [run_host_cmd "$ar" "cr tmpdir/pdb2b.a tmpdir/pdb2b.o"]
 654
 655     if ![string match "" $exec_output] {
 656         unsupported "Create pdb2b.a"
 657         return
 658     }
 659
 660     if ![ld_link $ld "tmpdir/pdb2.exe" "--pdb=tmpdir/pdb2.pdb --gc-sections --disable-reloc-section -e foo tmpdir/pdb2a.o tmpdir/pdb2b.a"] {
 661         unsupported "Create PE image with PDB file"
 662         return
 663     }
 664
 665     set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb2.pdb 0003"]
 666
 667     if ![string match "" $exec_output] {
 668         return 0
 669     }
 670
 671     set fi [open tmpdir/0003]
 672     fconfigure $fi -translation binary
 673
 674     seek $fi 24
 675
 676     set data [read $fi 4]
 677     binary scan $data i mod_info_size
 678
 679     set data [read $fi 4]
 680     binary scan $data i section_contrib_size
 681
 682     seek $fi 32 current
 683
 684     set mod_info [read $fi $mod_info_size]
 685     set section_contrib [read $fi $section_contrib_size]
 686
 687     close $fi
 688
 689     test_mod_info $mod_info
 690     test_section_contrib $section_contrib
 691 }
 692
 693 proc find_named_stream { pdb name } {
 694     global ar
 695
 696     set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb 0001"]
 697
 698     if ![string match "" $exec_output] {
 699         return 0
 700     }
 701
 702     set fi [open tmpdir/0001]
 703     fconfigure $fi -translation binary
 704
 705     seek $fi 0x1c
 706
 707     set data [read $fi 4]
 708     binary scan $data i string_len
 709
 710     set strings [read $fi $string_len]
 711
 712     set string_off 0
 713
 714     while {[string first \000 $strings $string_off] != -1 } {
 715         set str [string range $strings $string_off [expr [string first \000 $strings $string_off] - 1]]
 716
 717         if { $str eq $name } {
 718             break
 719         }
 720
 721         incr string_off [expr [string length $str] + 1]
 722     }
 723
 724     if { [string length $strings] == $string_off } { # string not found
 725         close $fi
 726         return 0
 727     }
 728
 729     set data [read $fi 4]
 730     binary scan $data i num_entries
 731
 732     seek $fi 4 current
 733
 734     set data [read $fi 4]
 735     binary scan $data i present_bitmap_len
 736
 737     seek $fi [expr $present_bitmap_len * 4] current
 738
 739     set data [read $fi 4]
 740     binary scan $data i deleted_bitmap_len
 741
 742     seek $fi [expr $deleted_bitmap_len * 4] current
 743
 744     for {set i 0} {$i < $num_entries} {incr i} {
 745         set data [read $fi 4]
 746         binary scan $data i offset
 747
 748         if { $offset == $string_off } {
 749             set data [read $fi 4]
 750             binary scan $data i value
 751             close $fi
 752
 753             return $value
 754         }
 755
 756         seek $fi 4 current
 757     }
 758
 759     close $fi
 760
 761     return 0
 762 }
 763
 764 proc test3 { } {
 765     global as
 766     global ar
 767     global ld
 768     global objdump
 769     global srcdir
 770     global subdir
 771
 772     if ![ld_assemble $as $srcdir/$subdir/pdb-strings1.s tmpdir/pdb-strings1.o] {
 773         unsupported "Build pdb-strings1.o"
 774         return
 775     }
 776
 777     if ![ld_assemble $as $srcdir/$subdir/pdb-strings2.s tmpdir/pdb-strings2.o] {
 778         unsupported "Build pdb-strings2.o"
 779         return
 780     }
 781
 782     if ![ld_link $ld "tmpdir/pdb-strings.exe" "--pdb=tmpdir/pdb-strings.pdb tmpdir/pdb-strings1.o tmpdir/pdb-strings2.o"] {
 783         unsupported "Create PE image with PDB file"
 784         return
 785     }
 786
 787     set index [find_named_stream "tmpdir/pdb-strings.pdb" "/names"]
 788
 789     if { $index == 0 } {
 790         fail "Could not find /names stream"
 791         return
 792     } else {
 793         pass "Found /names stream"
 794     }
 795
 796     set index_str [format "%04x" $index]
 797
 798     set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-strings.pdb $index_str"]
 799
 800     if ![string match "" $exec_output] {
 801         return 0
 802     }
 803
 804     set exp [file_contents "$srcdir/$subdir/pdb-strings.d"]
 805     set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"]
 806
 807     if ![string match $exp $got] {
 808         fail "Strings table was not as expected"
 809     } else {
 810         pass "Strings table was as expected"
 811     }
 812 }
 813
 814 proc extract_c13_info { pdb mod_info } {
 815     global ar
 816
 817     binary scan [string range $mod_info 34 35] s module_sym_stream
 818     binary scan [string range $mod_info 36 39] i sym_byte_size
 819     binary scan [string range $mod_info 40 43] i c11_byte_size
 820     binary scan [string range $mod_info 44 47] i c13_byte_size
 821
 822     set index_str [format "%04x" $module_sym_stream]
 823
 824     set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb $index_str"]
 825
 826     if ![string match "" $exec_output] {
 827         return ""
 828     }
 829
 830     set fi [open tmpdir/$index_str]
 831     fconfigure $fi -translation binary
 832
 833     seek $fi [expr $sym_byte_size + $c11_byte_size]
 834
 835     set data [read $fi $c13_byte_size]
 836
 837     close $fi
 838
 839     return $data
 840 }
 841
 842 proc test4 { } {
 843     global as
 844     global ar
 845     global ld
 846     global objdump
 847     global srcdir
 848     global subdir
 849
 850     if ![ld_assemble $as $srcdir/$subdir/pdb3a.s tmpdir/pdb3a.o] {
 851         unsupported "Build pdb3a.o"
 852         return
 853     }
 854
 855     if ![ld_assemble $as $srcdir/$subdir/pdb3b.s tmpdir/pdb3b.o] {
 856         unsupported "Build pdb3b.o"
 857         return
 858     }
 859
 860     if ![ld_link $ld "tmpdir/pdb3.exe" "--pdb=tmpdir/pdb3.pdb --gc-sections -e main tmpdir/pdb3a.o tmpdir/pdb3b.o"] {
 861         unsupported "Create PE image with PDB file"
 862         return
 863     }
 864
 865     # read relevant bits from DBI stream
 866
 867     set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb3.pdb 0003"]
 868
 869     if ![string match "" $exec_output] {
 870         fail "Could not extract DBI stream"
 871         return
 872     } else {
 873         pass "Extracted DBI stream"
 874     }
 875
 876     set fi [open tmpdir/0003]
 877     fconfigure $fi -translation binary
 878
 879     seek $fi 24
 880
 881     # read substream sizes
 882
 883     set data [read $fi 4]
 884     binary scan $data i mod_info_size
 885
 886     set data [read $fi 4]
 887     binary scan $data i section_contribution_size
 888
 889     set data [read $fi 4]
 890     binary scan $data i section_map_size
 891
 892     set data [read $fi 4]
 893     binary scan $data i source_info_size
 894
 895     seek $fi 24 current
 896
 897     set mod_info [read $fi $mod_info_size]
 898
 899     seek $fi [expr $section_contribution_size + $section_map_size] current
 900
 901     set source_info [read $fi $source_info_size]
 902
 903     close $fi
 904
 905     # check source info substream
 906
 907     set fi [open tmpdir/pdb3-source-info w]
 908     fconfigure $fi -translation binary
 909     puts -nonewline $fi $source_info
 910     close $fi
 911
 912     set exp [file_contents "$srcdir/$subdir/pdb3-source-info.d"]
 913     set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb3-source-info"]
 914
 915     if [string match $exp $got] {
 916         pass "Correct source info substream"
 917     } else {
 918         fail "Incorrect source info substream"
 919     }
 920
 921     # check C13 info in first module
 922
 923     set c13_info [extract_c13_info "tmpdir/pdb3.pdb" [string range $mod_info 0 63]]
 924
 925     set fi [open tmpdir/pdb3-c13-info1 w]
 926     fconfigure $fi -translation binary
 927     puts -nonewline $fi $c13_info
 928     close $fi
 929
 930     set exp [file_contents "$srcdir/$subdir/pdb3-c13-info1.d"]
 931     set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb3-c13-info1"]
 932
 933     if [string match $exp $got] {
 934         pass "Correct C13 info for first module"
 935     } else {
 936         fail "Incorrect C13 info for first module"
 937     }
 938
 939     # check C13 info in second module
 940
 941     set fn1_end [string first \000 $mod_info 64]
 942     set fn2_end [string first \000 $mod_info [expr $fn1_end + 1]]
 943
 944     set off [expr $fn2_end + 1]
 945
 946     if { [expr $off % 4] != 0 } {
 947         set off [expr $off + 4 - ($off % 4)]
 948     }
 949
 950     set c13_info [extract_c13_info "tmpdir/pdb3.pdb" [string range $mod_info $off [expr $off + 63]]]
 951
 952     set fi [open tmpdir/pdb3-c13-info2 w]
 953     fconfigure $fi -translation binary
 954     puts -nonewline $fi $c13_info
 955     close $fi
 956
 957     set exp [file_contents "$srcdir/$subdir/pdb3-c13-info2.d"]
 958     set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb3-c13-info2"]
 959
 960     if [string match $exp $got] {
 961         pass "Correct C13 info for second module"
 962     } else {
 963         fail "Incorrect C13 info for second module"
 964     }
 965 }
 966
 967 proc test5 { } {
 968     global as
 969     global ar
 970     global ld
 971     global objdump
 972     global srcdir
 973     global subdir
 974
 975     if ![ld_assemble $as $srcdir/$subdir/pdb-types1a.s tmpdir/pdb-types1a.o] {
 976         unsupported "Build pdb-types1a.o"
 977         return
 978     }
 979
 980     if ![ld_assemble $as $srcdir/$subdir/pdb-types1b.s tmpdir/pdb-types1b.o] {
 981         unsupported "Build pdb-types1b.o"
 982         return
 983     }
 984
 985     if ![ld_link $ld "tmpdir/pdb-types1.exe" "--pdb=tmpdir/pdb-types1.pdb tmpdir/pdb-types1a.o tmpdir/pdb-types1b.o"] {
 986         unsupported "Create PE image with PDB file"
 987         return
 988     }
 989
 990     set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-types1.pdb 0002"]
 991
 992     if ![string match "" $exec_output] {
 993         fail "Could not extract TPI stream"
 994         return
 995     } else {
 996         pass "Extracted TPI stream"
 997     }
 998
 999     # check values in TPI header, and save anything interesting
1000
1001     set fi [open tmpdir/0002]
1002     fconfigure $fi -translation binary
1003
1004     seek $fi 8 current
1005
1006     set data [read $fi 4]
1007     binary scan $data i first_type
1008
1009     if { $first_type != 0x1000 } {
1010         fail "Incorrect first type value in TPI stream."
1011     } else {
1012         pass "Correct first type value in TPI stream."
1013     }
1014
1015     set data [read $fi 4]
1016     binary scan $data i end_type
1017
1018     # end_type is one greater than the last type in the stream
1019     if { $end_type != 0x1030 } {
1020         fail "Incorrect end type value in TPI stream."
1021     } else {
1022         pass "Correct end type value in TPI stream."
1023     }
1024
1025     set data [read $fi 4]
1026     binary scan $data i type_list_size
1027
1028     set data [read $fi 2]
1029     binary scan $data s hash_stream_index
1030
1031     seek $fi 2 current
1032
1033     set data [read $fi 4]
1034     binary scan $data i hash_size
1035
1036     if { $hash_size != 4 } {
1037         fail "Incorrect hash size in TPI stream."
1038     } else {
1039         pass "Correct hash size in TPI stream."
1040     }
1041
1042     set data [read $fi 4]
1043     binary scan $data i num_buckets
1044
1045     if { $num_buckets != 0x3ffff } {
1046         fail "Incorrect number of buckets in TPI stream."
1047     } else {
1048         pass "Correct number of buckets in TPI stream."
1049     }
1050
1051     set data [read $fi 4]
1052     binary scan $data i hash_list_offset
1053
1054     set data [read $fi 4]
1055     binary scan $data i hash_list_size
1056
1057     set data [read $fi 4]
1058     binary scan $data i skip_list_offset
1059
1060     set data [read $fi 4]
1061     binary scan $data i skip_list_size
1062
1063     seek $fi 8 current
1064
1065     set type_list [read $fi $type_list_size]
1066
1067     close $fi
1068
1069     set fi [open tmpdir/pdb-types1-typelist w]
1070     fconfigure $fi -translation binary
1071     puts -nonewline $fi $type_list
1072     close $fi
1073
1074     # check type list
1075
1076     set exp [file_contents "$srcdir/$subdir/pdb-types1-typelist.d"]
1077     set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types1-typelist"]
1078     if ![string match $exp $got] {
1079         fail "Incorrect type list in TPI stream."
1080     } else {
1081         pass "Correct type list in TPI stream."
1082     }
1083
1084     # extract hash list and skip list
1085
1086     set index_str [format "%04x" $hash_stream_index]
1087
1088     set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-types1.pdb $index_str"]
1089
1090     if ![string match "" $exec_output] {
1091         fail "Could not extract TPI hash stream."
1092     } else {
1093         pass "Extracted TPI hash stream."
1094     }
1095
1096     set fi [open tmpdir/$index_str]
1097     fconfigure $fi -translation binary
1098
1099     seek $fi $hash_list_offset
1100     set hash_list [read $fi $hash_list_size]
1101
1102     seek $fi $skip_list_offset
1103     set skip_list [read $fi $skip_list_size]
1104
1105     close $fi
1106
1107     # check hash list
1108
1109     set fi [open tmpdir/pdb-types1-hashlist w]
1110     fconfigure $fi -translation binary
1111     puts -nonewline $fi $hash_list
1112     close $fi
1113
1114     set exp [file_contents "$srcdir/$subdir/pdb-types1-hashlist.d"]
1115     set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types1-hashlist"]
1116     if ![string match $exp $got] {
1117         fail "Incorrect hash list in TPI stream."
1118     } else {
1119         pass "Correct hash list in TPI stream."
1120     }
1121
1122     # check skip list
1123
1124     set fi [open tmpdir/pdb-types1-skiplist w]
1125     fconfigure $fi -translation binary
1126     puts -nonewline $fi $skip_list
1127     close $fi
1128
1129     set exp [file_contents "$srcdir/$subdir/pdb-types1-skiplist.d"]
1130     set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types1-skiplist"]
1131     if ![string match $exp $got] {
1132         fail "Incorrect skip list in TPI stream."
1133     } else {
1134         pass "Correct skip list in TPI stream."
1135     }
1136 }
1137
1138 proc test6 { } {
1139     global as
1140     global ar
1141     global ld
1142     global objdump
1143     global srcdir
1144     global subdir
1145
1146     if ![ld_assemble $as $srcdir/$subdir/pdb-types2a.s tmpdir/pdb-types2a.o] {
1147         unsupported "Build pdb-types2a.o"
1148         return
1149     }
1150
1151     if ![ld_assemble $as $srcdir/$subdir/pdb-types2b.s tmpdir/pdb-types2b.o] {
1152         unsupported "Build pdb-types2b.o"
1153         return
1154     }
1155
1156     if ![ld_link $ld "tmpdir/pdb-types2.exe" "--pdb=tmpdir/pdb-types2.pdb tmpdir/pdb-types2a.o tmpdir/pdb-types2b.o"] {
1157         unsupported "Create PE image with PDB file"
1158         return
1159     }
1160
1161     set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-types2.pdb 0004"]
1162
1163     if ![string match "" $exec_output] {
1164         fail "Could not extract IPI stream"
1165         return
1166     } else {
1167         pass "Extracted IPI stream"
1168     }
1169
1170     # check values in IPI header, and save anything interesting
1171
1172     set fi [open tmpdir/0004]
1173     fconfigure $fi -translation binary
1174
1175     seek $fi 8 current
1176
1177     set data [read $fi 4]
1178     binary scan $data i first_type
1179
1180     if { $first_type != 0x1000 } {
1181         fail "Incorrect first type value in IPI stream."
1182     } else {
1183         pass "Correct first type value in IPI stream."
1184     }
1185
1186     set data [read $fi 4]
1187     binary scan $data i end_type
1188
1189     # end_type is one greater than the last type in the stream
1190     if { $end_type != 0x100f } {
1191         fail "Incorrect end type value in IPI stream."
1192     } else {
1193         pass "Correct end type value in IPI stream."
1194     }
1195
1196     set data [read $fi 4]
1197     binary scan $data i type_list_size
1198
1199     set data [read $fi 2]
1200     binary scan $data s hash_stream_index
1201
1202     seek $fi 2 current
1203
1204     set data [read $fi 4]
1205     binary scan $data i hash_size
1206
1207     if { $hash_size != 4 } {
1208         fail "Incorrect hash size in IPI stream."
1209     } else {
1210         pass "Correct hash size in IPI stream."
1211     }
1212
1213     set data [read $fi 4]
1214     binary scan $data i num_buckets
1215
1216     if { $num_buckets != 0x3ffff } {
1217         fail "Incorrect number of buckets in IPI stream."
1218     } else {
1219         pass "Correct number of buckets in IPI stream."
1220     }
1221
1222     set data [read $fi 4]
1223     binary scan $data i hash_list_offset
1224
1225     set data [read $fi 4]
1226     binary scan $data i hash_list_size
1227
1228     set data [read $fi 4]
1229     binary scan $data i skip_list_offset
1230
1231     set data [read $fi 4]
1232     binary scan $data i skip_list_size
1233
1234     seek $fi 8 current
1235
1236     set type_list [read $fi $type_list_size]
1237
1238     close $fi
1239
1240     set fi [open tmpdir/pdb-types2-typelist w]
1241     fconfigure $fi -translation binary
1242     puts -nonewline $fi $type_list
1243     close $fi
1244
1245     # check type list
1246
1247     set exp [file_contents "$srcdir/$subdir/pdb-types2-typelist.d"]
1248     set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types2-typelist"]
1249     if ![string match $exp $got] {
1250         fail "Incorrect type list in IPI stream."
1251     } else {
1252         pass "Correct type list in IPI stream."
1253     }
1254
1255     # extract hash list and skip list
1256
1257     set index_str [format "%04x" $hash_stream_index]
1258
1259     set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-types2.pdb $index_str"]
1260
1261     if ![string match "" $exec_output] {
1262         fail "Could not extract IPI hash stream."
1263     } else {
1264         pass "Extracted IPI hash stream."
1265     }
1266
1267     set fi [open tmpdir/$index_str]
1268     fconfigure $fi -translation binary
1269
1270     seek $fi $hash_list_offset
1271     set hash_list [read $fi $hash_list_size]
1272
1273     seek $fi $skip_list_offset
1274     set skip_list [read $fi $skip_list_size]
1275
1276     close $fi
1277
1278     # check hash list
1279
1280     set fi [open tmpdir/pdb-types2-hashlist w]
1281     fconfigure $fi -translation binary
1282     puts -nonewline $fi $hash_list
1283     close $fi
1284
1285     set exp [file_contents "$srcdir/$subdir/pdb-types2-hashlist.d"]
1286     set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types2-hashlist"]
1287     if ![string match $exp $got] {
1288         fail "Incorrect hash list in IPI stream."
1289     } else {
1290         pass "Correct hash list in IPI stream."
1291     }
1292
1293     # check skip list
1294
1295     set fi [open tmpdir/pdb-types2-skiplist w]
1296     fconfigure $fi -translation binary
1297     puts -nonewline $fi $skip_list
1298     close $fi
1299
1300     set exp [file_contents "$srcdir/$subdir/pdb-types2-skiplist.d"]
1301     set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types2-skiplist"]
1302     if ![string match $exp $got] {
1303         fail "Incorrect skip list in IPI stream."
1304     } else {
1305         pass "Correct skip list in IPI stream."
1306     }
1307 }
1308
1309 proc test7 { } {
1310     global as
1311     global ar
1312     global ld
1313     global objdump
1314     global srcdir
1315     global subdir
1316
1317     if ![ld_assemble $as $srcdir/$subdir/pdb-types3a.s tmpdir/pdb-types3a.o] {
1318         unsupported "Build pdb-types3a.o"
1319         return
1320     }
1321
1322     if ![ld_assemble $as $srcdir/$subdir/pdb-types3b.s tmpdir/pdb-types3b.o] {
1323         unsupported "Build pdb-types3b.o"
1324         return
1325     }
1326
1327     if ![ld_link $ld "tmpdir/pdb-types3.exe" "--pdb=tmpdir/pdb-types3.pdb tmpdir/pdb-types3a.o tmpdir/pdb-types3b.o"] {
1328         unsupported "Create PE image with PDB file"
1329         return
1330     }
1331
1332     set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-types3.pdb 0004"]
1333
1334     if ![string match "" $exec_output] {
1335         fail "Could not extract IPI stream"
1336         return
1337     } else {
1338         pass "Extracted IPI stream"
1339     }
1340
1341     set fi [open tmpdir/0004]
1342     fconfigure $fi -translation binary
1343
1344     seek $fi 16 current
1345
1346     set data [read $fi 4]
1347     binary scan $data i type_list_size
1348
1349     set data [read $fi 2]
1350     binary scan $data s hash_stream_index
1351
1352     seek $fi 10 current
1353
1354     set data [read $fi 4]
1355     binary scan $data i hash_list_offset
1356
1357     set data [read $fi 4]
1358     binary scan $data i hash_list_size
1359
1360     set data [read $fi 4]
1361     binary scan $data i skip_list_offset
1362
1363     set data [read $fi 4]
1364     binary scan $data i skip_list_size
1365
1366     seek $fi 8 current
1367
1368     set type_list [read $fi $type_list_size]
1369
1370     close $fi
1371
1372     set fi [open tmpdir/pdb-types3-typelist w]
1373     fconfigure $fi -translation binary
1374     puts -nonewline $fi $type_list
1375     close $fi
1376
1377     # check type list
1378
1379     set exp [file_contents "$srcdir/$subdir/pdb-types3-typelist.d"]
1380     set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types3-typelist"]
1381     if ![string match $exp $got] {
1382         fail "Incorrect type list in IPI stream."
1383     } else {
1384         pass "Correct type list in IPI stream."
1385     }
1386
1387     # extract hash list and skip list
1388
1389     set index_str [format "%04x" $hash_stream_index]
1390
1391     set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-types3.pdb $index_str"]
1392
1393     if ![string match "" $exec_output] {
1394         fail "Could not extract IPI hash stream."
1395     } else {
1396         pass "Extracted IPI hash stream."
1397     }
1398
1399     set fi [open tmpdir/$index_str]
1400     fconfigure $fi -translation binary
1401
1402     seek $fi $hash_list_offset
1403     set hash_list [read $fi $hash_list_size]
1404
1405     seek $fi $skip_list_offset
1406     set skip_list [read $fi $skip_list_size]
1407
1408     close $fi
1409
1410     # check hash list
1411
1412     set fi [open tmpdir/pdb-types3-hashlist w]
1413     fconfigure $fi -translation binary
1414     puts -nonewline $fi $hash_list
1415     close $fi
1416
1417     set exp [file_contents "$srcdir/$subdir/pdb-types3-hashlist.d"]
1418     set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types3-hashlist"]
1419     if ![string match $exp $got] {
1420         fail "Incorrect hash list in IPI stream."
1421     } else {
1422         pass "Correct hash list in IPI stream."
1423     }
1424
1425     # check skip list
1426
1427     set fi [open tmpdir/pdb-types3-skiplist w]
1428     fconfigure $fi -translation binary
1429     puts -nonewline $fi $skip_list
1430     close $fi
1431
1432     set exp [file_contents "$srcdir/$subdir/pdb-types3-skiplist.d"]
1433     set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types3-skiplist"]
1434     if ![string match $exp $got] {
1435         fail "Incorrect skip list in IPI stream."
1436     } else {
1437         pass "Correct skip list in IPI stream."
1438     }
1439 }
1440
1441 proc test8 { } {
1442     global as
1443     global ar
1444     global ld
1445     global objdump
1446     global srcdir
1447     global subdir
1448
1449     if ![ld_assemble $as $srcdir/$subdir/pdb-syms1a.s tmpdir/pdb-syms1a.o] {
1450         unsupported "Build pdb-syms1a.o"
1451         return
1452     }
1453
1454     if ![ld_assemble $as $srcdir/$subdir/pdb-syms1b.s tmpdir/pdb-syms1b.o] {
1455         unsupported "Build pdb-syms1b.o"
1456         return
1457     }
1458
1459     if ![ld_link $ld "tmpdir/pdb-syms1.exe" "--pdb=tmpdir/pdb-syms1.pdb tmpdir/pdb-syms1a.o tmpdir/pdb-syms1b.o"] {
1460         unsupported "Create PE image with PDB file"
1461         return
1462     }
1463
1464     # get index of globals stream and records stream
1465
1466     set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms1.pdb 0003"]
1467
1468     if ![string match "" $exec_output] {
1469         fail "Could not extract DBI stream"
1470         return
1471     } else {
1472         pass "Extracted DBI stream"
1473     }
1474
1475     set fi [open tmpdir/0003]
1476     fconfigure $fi -translation binary
1477
1478     seek $fi 12
1479     set data [read $fi 2]
1480     binary scan $data s globals_index
1481
1482     seek $fi 6 current
1483     set data [read $fi 2]
1484     binary scan $data s records_index
1485
1486     seek $fi 2 current
1487     set data [read $fi 4]
1488     binary scan $data i mod_info_size
1489
1490     seek $fi 36 current
1491     set mod_info [read $fi $mod_info_size]
1492
1493     close $fi
1494
1495     # get index of first and second module streams
1496
1497     binary scan [string range $mod_info 34 35] s mod1_index
1498
1499     set off 64
1500
1501     set obj1 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]]
1502     incr off [expr [string length $obj1] + 1]
1503
1504     set ar1 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]]
1505     incr off [expr [string length $ar1] + 1]
1506
1507     if { [expr $off % 4] != 0 } {
1508         set off [expr $off + 4 - ($off % 4)]
1509     }
1510
1511     incr off 34
1512
1513     binary scan [string range $mod_info $off [expr $off + 1]] s mod2_index
1514
1515     # check globals stream
1516
1517     set index_str [format "%04x" $globals_index]
1518
1519     set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms1.pdb $index_str"]
1520
1521     if ![string match "" $exec_output] {
1522         fail "Could not extract globals stream"
1523         return
1524     } else {
1525         pass "Extracted globals stream"
1526     }
1527
1528     set exp [file_contents "$srcdir/$subdir/pdb-syms1-globals.d"]
1529     set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"]
1530
1531     if [string match $exp $got] {
1532         pass "Correct globals stream"
1533     } else {
1534         fail "Incorrect globals stream"
1535     }
1536
1537     # check records stream
1538
1539     set index_str [format "%04x" $records_index]
1540
1541     set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms1.pdb $index_str"]
1542
1543     if ![string match "" $exec_output] {
1544         fail "Could not extract records stream"
1545         return
1546     } else {
1547         pass "Extracted records stream"
1548     }
1549
1550     set exp [file_contents "$srcdir/$subdir/pdb-syms1-records.d"]
1551     set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"]
1552
1553     if [string match $exp $got] {
1554         pass "Correct records stream"
1555     } else {
1556         fail "Incorrect records stream"
1557     }
1558
1559     # check symbols in first module
1560
1561     set index_str [format "%04x" $mod1_index]
1562
1563     set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms1.pdb $index_str"]
1564
1565     if ![string match "" $exec_output] {
1566         fail "Could not extract first module's symbols"
1567         return
1568     } else {
1569         pass "Extracted first module's symbols"
1570     }
1571
1572     set exp [file_contents "$srcdir/$subdir/pdb-syms1-symbols1.d"]
1573     set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"]
1574
1575     if [string match $exp $got] {
1576         pass "Correct symbols in first module's stream"
1577     } else {
1578         fail "Incorrect symbols in first module's stream"
1579     }
1580
1581     # check symbols in second module
1582
1583     set index_str [format "%04x" $mod2_index]
1584
1585     set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms1.pdb $index_str"]
1586
1587     if ![string match "" $exec_output] {
1588         fail "Could not extract second module's symbols"
1589         return
1590     } else {
1591         pass "Extracted second module's symbols"
1592     }
1593
1594     set exp [file_contents "$srcdir/$subdir/pdb-syms1-symbols2.d"]
1595     set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"]
1596
1597     if [string match $exp $got] {
1598         pass "Correct symbols in second module's stream"
1599     } else {
1600         fail "Incorrect symbols in second module's stream"
1601     }
1602 }
1603
1604 proc test9 { } {
1605     global as
1606     global ar
1607     global ld
1608     global objdump
1609     global srcdir
1610     global subdir
1611
1612     if ![ld_assemble $as $srcdir/$subdir/pdb-syms2.s tmpdir/pdb-syms2.o] {
1613         unsupported "Build pdb-syms2.o"
1614         return
1615     }
1616
1617     if ![ld_link $ld "tmpdir/pdb-syms2.exe" "--pdb=tmpdir/pdb-syms2.pdb tmpdir/pdb-syms2.o"] {
1618         unsupported "Create PE image with PDB file"
1619         return
1620     }
1621
1622     # get index of module stream
1623
1624     set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms2.pdb 0003"]
1625
1626     if ![string match "" $exec_output] {
1627         fail "Could not extract DBI stream"
1628         return
1629     } else {
1630         pass "Extracted DBI stream"
1631     }
1632
1633     set fi [open tmpdir/0003]
1634     fconfigure $fi -translation binary
1635
1636     seek $fi 24
1637     set data [read $fi 4]
1638     binary scan $data i mod_info_size
1639
1640     seek $fi 36 current
1641     set mod_info [read $fi $mod_info_size]
1642
1643     close $fi
1644
1645     binary scan [string range $mod_info 34 35] s module_index
1646
1647     # check module records
1648
1649     set index_str [format "%04x" $module_index]
1650
1651     set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms2.pdb $index_str"]
1652
1653     if ![string match "" $exec_output] {
1654         fail "Could not extract module symbols"
1655         return
1656     } else {
1657         pass "Extracted module symbols"
1658     }
1659
1660     set exp [file_contents "$srcdir/$subdir/pdb-syms2-symbols1.d"]
1661     set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"]
1662
1663     if [string match $exp $got] {
1664         pass "Correct symbols in module stream"
1665     } else {
1666         fail "Incorrect symbols in module stream"
1667     }
1668
1669     # check linker symbols
1670
1671     set off 64
1672
1673     set obj1 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]]
1674     incr off [expr [string length $obj1] + 1]
1675
1676     set ar1 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]]
1677     incr off [expr [string length $ar1] + 1]
1678
1679     if { [expr $off % 4] != 0 } {
1680         set off [expr $off + 4 - ($off % 4)]
1681     }
1682
1683     incr off 34
1684
1685     binary scan [string range $mod_info $off [expr $off + 1]] s linker_syms_index
1686
1687     set index_str [format "%04x" $linker_syms_index]
1688
1689     set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms2.pdb $index_str"]
1690
1691     if ![string match "" $exec_output] {
1692         fail "Could not extract linker symbols"
1693         return
1694     } else {
1695         pass "Extracted linker symbols"
1696     }
1697
1698     set syms [file_contents "tmpdir/$index_str"]
1699
1700     # check S_OBJNAME
1701
1702     set off 4
1703     binary scan [string range $syms $off [expr $off + 1]] s sym_len
1704     binary scan [string range $syms [expr $off + 2] [expr $off + 3]] s sym_type
1705
1706     if { $sym_type != 0x1101 } {
1707         fail "First linker symbol was not S_OBJNAME"
1708     } else {
1709         pass "First linker symbol was S_OBJNAME"
1710
1711         set linker_fn [string range $syms [expr $off + 8] [expr [string first \000 $syms [expr $off + 8]] - 1]]
1712
1713         if ![string equal $linker_fn "* Linker *"] {
1714             fail "Incorrect linker object name"
1715         } else {
1716             pass "Correct linker object name"
1717         }
1718     }
1719
1720     incr off [expr $sym_len + 2]
1721
1722     # check S_COMPILE3
1723
1724     binary scan [string range $syms $off [expr $off + 1]] s sym_len
1725     binary scan [string range $syms [expr $off + 2] [expr $off + 3]] s sym_type
1726
1727     if { $sym_type != 0x113c } {
1728         fail "Second linker symbol was not S_COMPILE3"
1729     } else {
1730         pass "Second linker symbol was S_COMPILE3"
1731     }
1732
1733     incr off [expr $sym_len + 2]
1734
1735     # check S_ENVBLOCK
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 != 0x113d } {
1741         fail "Third linker symbol was not S_ENVBLOCK"
1742     } else {
1743         pass "Third linker symbol was S_ENVBLOCK"
1744     }
1745 }
1746
1747 proc test10 { } {
1748     global as
1749     global ar
1750     global ld
1751     global objdump
1752     global srcdir
1753     global subdir
1754
1755     if ![ld_assemble $as $srcdir/$subdir/pdb-inlineelines1a.s tmpdir/pdb-inlineelines1a.o] {
1756         unsupported "Build pdb-inlineelines1a.o"
1757         return
1758     }
1759
1760     if ![ld_assemble $as $srcdir/$subdir/pdb-inlineelines1b.s tmpdir/pdb-inlineelines1b.o] {
1761       unsupported "Build pdb-inlineelines1a.o"
1762       return
1763     }
1764
1765     if ![ld_link $ld "tmpdir/pdb-inlineelines1.exe" "--pdb=tmpdir/pdb-inlineelines1.pdb tmpdir/pdb-inlineelines1a.o tmpdir/pdb-inlineelines1b.o"] {
1766         unsupported "Create PE image with PDB file"
1767         return
1768     }
1769
1770     # read relevant bits from DBI stream
1771
1772     set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-inlineelines1.pdb 0003"]
1773
1774     if ![string match "" $exec_output] {
1775         fail "Could not extract DBI stream"
1776         return
1777     } else {
1778         pass "Extracted DBI stream"
1779     }
1780
1781     set fi [open tmpdir/0003]
1782     fconfigure $fi -translation binary
1783
1784     seek $fi 24
1785
1786     # read substream sizes
1787
1788     set data [read $fi 4]
1789     binary scan $data i mod_info_size
1790
1791     seek $fi 36 current
1792
1793     set mod_info [read $fi $mod_info_size]
1794
1795     close $fi
1796
1797     # check C13 info in second module
1798
1799     # We're interested here that the inlinee function IDs get rewritten:
1800     # 1003 -> 1002, 1004 -> 1003.  The numbers are lower because linking splits
1801     # the types into two separate streams, numbered individually.
1802
1803     # This is what cvdump.exe -inll pdb-inlineelines1.pdb should look like:
1804
1805     # *** INLINEE LINES
1806     #
1807     # InlineeId  FileId  StaringLine
1808     #      1002       0           42
1809     #      1003       1           28
1810
1811     # For some reason it numbers file IDs in bytes for object files but as an
1812     # index for PDBs, but they're stored on disk the same way.
1813
1814     set fn1_end [string first \000 $mod_info 64]
1815     set fn2_end [string first \000 $mod_info [expr $fn1_end + 1]]
1816
1817     set off [expr $fn2_end + 1]
1818
1819     if { [expr $off % 4] != 0 } {
1820         set off [expr $off + 4 - ($off % 4)]
1821     }
1822
1823     set c13_info [extract_c13_info "tmpdir/pdb-inlineelines1.pdb" [string range $mod_info $off [expr $off + 63]]]
1824
1825     set fi [open tmpdir/pdb-inlineelines1-c13-info2 w]
1826     fconfigure $fi -translation binary
1827     puts -nonewline $fi $c13_info
1828     close $fi
1829
1830     set exp [file_contents "$srcdir/$subdir/pdb-inlineelines1-c13-info2.d"]
1831     set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-inlineelines1-c13-info2"]
1832
1833     if [string match $exp $got] {
1834         pass "Correct C13 info for second module"
1835     } else {
1836         fail "Incorrect C13 info for second module"
1837     }
1838 }
1839
1840 test1
1841 test2
1842 test3
1843 test4
1844 test5
1845 test6
1846 test7
1847 test8
1848 test9
1849 test10