ld/testsuite/ld-pe/pdb.exp

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