binutils-gdb/ld/testsuite/ld-pe/pdb.exp
2022-10-31 12:57:26 +10:30

549 lines
11 KiB
Plaintext

# Expect script for creating PDB files when linking.
# Copyright (C) 2022 Free Software Foundation, Inc.
#
# This file is part of the GNU Binutils.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
# MA 02110-1301, USA.
if {![istarget i*86-*-mingw*]
&& ![istarget x86_64-*-mingw*]} {
return
}
proc get_pdb_name { pe } {
global OBJDUMP
set exec_output [run_host_cmd "$OBJDUMP" "-p $pe"]
if ![regexp -line "^\\(format RSDS signature (\[0-9a-fA-F\]{32}) age 1 pdb (.*)\\)$" $exec_output full sig pdb] {
return ""
}
return $pdb
}
proc get_pdb_guid { pe } {
global OBJDUMP
set exec_output [run_host_cmd "$OBJDUMP" "-p $pe"]
if ![regexp -line "^\\(format RSDS signature (\[0-9a-fA-F\]{32}) age 1 pdb (.*)\\)$" $exec_output full sig pdb] {
return ""
}
return $sig
}
proc check_pdb_info_stream { pdb guid } {
global ar
set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb 0001"]
if ![string match "" $exec_output] {
return 0
}
set fi [open tmpdir/0001]
fconfigure $fi -translation binary
# check version
set data [read $fi 4]
binary scan $data i version
if { $version != 20000404 } {
close $fi
return 0
}
# skip signature (timestamp)
read $fi 4
# check age
set data [read $fi 4]
binary scan $data i age
if { $age != 1 } {
close $fi
return 0
}
# check GUID
set data [read $fi 16]
binary scan $data H2H2H2H2H2H2H2H2H* guid1 guid2 guid3 guid4 guid5 guid6 guid7 guid8 guid9
set data "$guid4$guid3$guid2$guid1$guid6$guid5$guid8$guid7$guid9"
if { $data ne $guid } {
close $fi
return 0
}
# skip names string
set data [read $fi 4]
binary scan $data i names_length
read $fi $names_length
# read number of names entries
set data [read $fi 4]
binary scan $data i num_entries
# skip number of buckets
read $fi 4
# skip present bitmap
set data [read $fi 4]
binary scan $data i bitmap_length
read $fi [expr $bitmap_length * 4]
# skip deleted bitmap
set data [read $fi 4]
binary scan $data i bitmap_length
read $fi [expr $bitmap_length * 4]
# skip names entries
read $fi [expr $num_entries * 8]
# skip uint32_t
read $fi 4
# read second version
set data [read $fi 4]
binary scan $data i version2
if { $version2 != 20140508 } {
close $fi
return 0
}
close $fi
return 1
}
proc check_type_stream { pdb stream } {
global ar
set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb $stream"]
if ![string match "" $exec_output] {
return 0
}
set fi [open tmpdir/$stream]
fconfigure $fi -translation binary
# check version
set data [read $fi 4]
binary scan $data i version
if { $version != 20040203 } {
close $fi
return 0
}
# check header size
set data [read $fi 4]
binary scan $data i header_size
if { $header_size != 0x38 } {
close $fi
return 0
}
# skip type_index_begin and type_index_end
read $fi 8
# read type_record_bytes
set data [read $fi 4]
binary scan $data i type_record_bytes
close $fi
# check stream length
set stream_length [file size tmpdir/$stream]
if { $stream_length != [ expr $header_size + $type_record_bytes ] } {
return 0
}
return 1
}
proc check_dbi_stream { pdb } {
global ar
set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb 0003"]
if ![string match "" $exec_output] {
return 0
}
set fi [open tmpdir/0003]
fconfigure $fi -translation binary
# check signature
set data [read $fi 4]
binary scan $data i signature
if { $signature != -1 } {
close $fi
return 0
}
# check version
set data [read $fi 4]
binary scan $data i version
if { $version != 19990903 } {
close $fi
return 0
}
# check age
set data [read $fi 4]
binary scan $data i age
if { $age != 1 } {
close $fi
return 0
}
# skip fields
read $fi 12
# read substream sizes
set data [read $fi 4]
binary scan $data i mod_info_size
set data [read $fi 4]
binary scan $data i section_contribution_size
set data [read $fi 4]
binary scan $data i section_map_size
set data [read $fi 4]
binary scan $data i source_info_size
set data [read $fi 4]
binary scan $data i type_server_map_size
set data [read $fi 4]
binary scan $data i mfc_type_server_index
set data [read $fi 4]
binary scan $data i optional_dbg_header_size
set data [read $fi 4]
binary scan $data i ec_substream_size
close $fi
# check stream length
set stream_length [file size tmpdir/0003]
if { $stream_length != [expr 0x40 + $mod_info_size + $section_contribution_size + $section_map_size + $source_info_size + $type_server_map_size + $mfc_type_server_index + $optional_dbg_header_size + $ec_substream_size] } {
return 0
}
return 1
}
proc get_section_stream_index { pdb } {
global ar
set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb 0003"]
if ![string match "" $exec_output] {
return -1
}
set fi [open tmpdir/0003]
fconfigure $fi -translation binary
# skip fields
seek $fi 24
# read substream sizes
set data [read $fi 4]
binary scan $data i mod_info_size
set data [read $fi 4]
binary scan $data i section_contribution_size
set data [read $fi 4]
binary scan $data i section_map_size
set data [read $fi 4]
binary scan $data i source_info_size
set data [read $fi 4]
binary scan $data i type_server_map_size
# skip type server index
seek $fi 4 current
set data [read $fi 4]
binary scan $data i optional_dbg_header_size
if { $optional_dbg_header_size < 12 } {
close $fi
return -1
}
# skip data
seek $fi [expr 12 + $mod_info_size + $section_contribution_size + $section_map_size + $source_info_size + $type_server_map_size + 10] current
set data [read $fi 2]
binary scan $data s section_stream_index
close $fi
return $section_stream_index
}
proc check_section_stream { img pdb } {
global ar
# read sections stream
set index [get_section_stream_index $pdb]
if { $index == -1 } {
return 0
}
set index_str [format "%04x" $index]
set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb $index_str"]
if ![string match "" $exec_output] {
return 0
}
set stream_length [file size tmpdir/$index_str]
set fi [open tmpdir/$index_str]
fconfigure $fi -translation binary
set stream_data [read $fi $stream_length]
close $fi
# read sections from PE file
set fi [open $img]
fconfigure $fi -translation binary
# read PE offset
read $fi 0x3c
set data [read $fi 4]
binary scan $data i pe_offset
# read number of sections
seek $fi [expr $pe_offset + 6]
set data [read $fi 2]
binary scan $data s num_sections
# read size of optional header
seek $fi 12 current
set data [read $fi 2]
binary scan $data s opt_header_size
# read section headers
seek $fi [expr $opt_header_size + 2] current
set section_data [read $fi [expr $num_sections * 40]]
close $fi
# compare
if { $stream_data ne $section_data} {
return 0
}
return 1
}
proc get_publics_stream_index { pdb } {
global ar
set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb 0003"]
if ![string match "" $exec_output] {
return -1
}
set fi [open tmpdir/0003]
fconfigure $fi -translation binary
# skip fields
seek $fi 16
# read substream sizes
set data [read $fi 2]
binary scan $data s index
close $fi
return $index
}
proc get_sym_record_stream_index { pdb } {
global ar
set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb 0003"]
if ![string match "" $exec_output] {
return -1
}
set fi [open tmpdir/0003]
fconfigure $fi -translation binary
# skip fields
seek $fi 20
# read substream sizes
set data [read $fi 2]
binary scan $data s index
close $fi
return $index
}
proc check_publics_stream { pdb } {
global ar
global objdump
global srcdir
global subdir
set publics_index [get_publics_stream_index $pdb]
if { $publics_index == -1 } {
return 0
}
set index_str [format "%04x" $publics_index]
set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb $index_str"]
if ![string match "" $exec_output] {
return 0
}
set exp [file_contents "$srcdir/$subdir/pdb1-publics.d"]
set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"]
if ![string match $exp $got] {
return 0
}
set sym_record_index [get_sym_record_stream_index $pdb]
if { $sym_record_index == -1 } {
return 0
}
set index_str [format "%04x" $sym_record_index]
set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb $index_str"]
if ![string match "" $exec_output] {
return 0
}
set exp [file_contents "$srcdir/$subdir/pdb1-sym-record.d"]
set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"]
if ![string match $exp $got] {
return 0
}
return 1
}
if ![ld_assemble $as $srcdir/$subdir/pdb1.s tmpdir/pdb1.o] {
unsupported "Build pdb1.o"
return
}
if ![ld_link $ld "tmpdir/pdb1.exe" "--pdb=tmpdir/pdb1.pdb --gc-sections -e foo tmpdir/pdb1.o"] {
fail "Could not create a PE image with a PDB file"
return
}
if ![string equal [get_pdb_name "tmpdir/pdb1.exe"] "pdb1.pdb"] {
fail "PDB filename not found in CodeView debug info"
return
}
pass "PDB filename present in CodeView debug info"
if [check_pdb_info_stream tmpdir/pdb1.pdb [get_pdb_guid "tmpdir/pdb1.exe"]] {
pass "Valid PDB info stream"
} else {
fail "Invalid PDB info stream"
}
if [check_type_stream tmpdir/pdb1.pdb "0002"] {
pass "Valid TPI stream"
} else {
fail "Invalid TPI stream"
}
if [check_type_stream tmpdir/pdb1.pdb "0004"] {
pass "Valid IPI stream"
} else {
fail "Invalid IPI stream"
}
if [check_dbi_stream tmpdir/pdb1.pdb] {
pass "Valid DBI stream"
} else {
fail "Invalid DBI stream"
}
if [check_section_stream tmpdir/pdb1.exe tmpdir/pdb1.pdb] {
pass "Valid section stream"
} else {
fail "Invalid section stream"
}
if [check_publics_stream tmpdir/pdb1.pdb] {
pass "Valid publics stream"
} else {
fail "Invalid publics stream"
}