binutils-gdb/binutils/testsuite/binutils-all/ar.exp
Alan Modra 0bee4d1c08 binutils archive tests
There are a number of targets that don't support thin archives (*),
and vms doesn't even support file name extensions other than .obj for
archives containing object files.  This patch adjusts the testsuite
to cater for the vms restriction, and reenables testing for non-ELF
alpha targets.  That adds a few alpha-dec-vms fails and one
alpha-linuxecoff fail but testsuite fails on those targets are nothing
new.

(*) It might seem like they do if binutils is built with
--enable-plugins but the plugin archive support is broken, causing the
wrong type of archives to be created by ar for those targets.

	* testsuite/binutils-all/ar.exp (obj): Set up object file name
	extension.  Use throughout.  Don't completely exclude non-ELF
	alpha targets.  Run long_filenames test for tic30.  Exclude thin
	archive tests for aix, ecoff and vms.
	* estsuite/binutils-all/objdump.exp (obj): Set up object file name
	extension.  Use throughout.  Don't exclude non-ELF alpha targets
	from "bintest.a".
2020-06-02 15:00:14 +09:30

750 lines
17 KiB
Plaintext

# Copyright (C) 1995-2020 Free Software Foundation, Inc.
# 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.
# Please email any bugs, comments, and/or additions to this file to:
# bug-dejagnu@prep.ai.mit.edu
# Written by Ian Lance Taylor <ian@cygnus.com>
if ![is_remote host] {
if {[which $AR] == 0} then {
perror "$AR does not exist"
return
}
}
set obj o
if { [istarget "*-*-vms"] } then {
set obj obj
}
# send_user "Version [binutil_version $AR]"
# Test long file name support
proc long_filenames { bfdtests } {
global AR
global host_triplet
global base_dir
set testname "ar long file names"
set n1 "abcdefghijklmnopqrstuvwxyz1"
set n2 "abcdefghijklmnopqrstuvwxyz2"
set file1 tmpdir/$n1
set file2 tmpdir/$n2
remote_file build delete $file1
remote_file host delete $n1
# Some file systems truncate file names at 14 characters, which
# makes it impossible to run this test. Check for that now.
set status [catch "set f [open tmpdir/$n1 w]" errs]
if { $status != 0 } {
verbose -log "open tmpdir/$n1 returned $errs"
unsupported $testname
return
}
puts $f "first"
close $f
remote_file build delete $file2
remote_file host delete $n2
set status [catch "set f [open tmpdir/$n2 w]" errs]
if { $status != 0 } {
verbose -log "open tmpdir/$n2 returned $errs"
unsupported $testname
return
}
puts $f "second"
close $f
if [is_remote host] {
set file1 [remote_download host $file1]
set file2 [remote_download host $file2]
set dest artest.a
} else {
set dest tmpdir/artest.a
}
remote_file host delete $dest
set got [binutils_run $AR "rc $dest $file1 $file2"]
if [is_remote host] {
remote_upload host $file1 tmpdir/$n1
}
set f [open tmpdir/$n1 r]
gets $f string
close $f
if ![string match "first" $string] {
verbose -log "reading tmpdir/$n1 returned $string"
unsupported $testname
return
}
remote_file host delete $dest
set got [binutils_run $AR "rc $dest $file1 $file2"]
if ![string match "" $got] {
fail $testname
return
}
remote_file build delete tmpdir/$n1
remote_file build delete tmpdir/$n2
set got [binutils_run $AR "t $dest"]
regsub "\[\r\n \t\]*$" "$got" "" got
if ![string match "$n1*$n2" $got] {
fail $testname
return
}
if [is_remote host] {
remote_file host delete $file1
remote_file host delete $file2
}
set exec_output [binutils_run $AR "x $dest"]
set exec_output [prune_warnings $exec_output]
if ![string match "" $exec_output] {
verbose -log $exec_output
fail $testname
return
}
foreach bfdtest $bfdtests {
set exec_output [binutils_run "$base_dir/$bfdtest" "$dest"]
if ![string match "" $exec_output] {
verbose -log $exec_output
fail "$testname ($bfdtest)"
return
}
}
if [is_remote host] {
remote_upload host $n1 tmpdir/$n1
remote_upload host $n2 tmpdir/$n2
set file1 tmpdir/$n1
set file2 tmpdir/$n2
} else {
set file1 $n1
set file2 $n2
}
if ![file exists $file1] {
verbose -log "$file1 does not exist"
fail $testname
return
}
if ![file exists $file2] {
verbose -log "$file2 does not exist"
fail $testname
return
}
set f [open $file1 r]
if { [gets $f line] == -1 || $line != "first" } {
verbose -log "$file1 contents:"
verbose -log "$line"
close $f
fail $testname
return
}
close $f
set f [open $file2 r]
if { [gets $f line] == -1 || $line != "second" } {
verbose -log "$file2 contents:"
verbose -log "$line"
close $f
fail $testname
return
}
close $f
file delete $file1 $file2
pass $testname
}
# Test building the symbol table.
proc symbol_table { } {
global AR
global AS
global NM
global srcdir
global subdir
global obj
set testname "ar symbol table"
if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
unresolved $testname
return
}
if [is_remote host] {
set archive artest.a
set objfile [remote_download host tmpdir/bintest.${obj}]
remote_file host delete $archive
} else {
set archive tmpdir/artest.a
set objfile tmpdir/bintest.${obj}
}
remote_file build delete tmpdir/artest.a
set got [binutils_run $AR "rc $archive ${objfile}"]
if ![string match "" $got] {
fail $testname
return
}
set got [binutils_run $NM "--print-armap $archive"]
if { ![string match "*text_symbol in bintest.${obj}*" $got] \
|| ![string match "*data_symbol in bintest.${obj}*" $got] \
|| ![string match "*common_symbol in bintest.${obj}*" $got] \
|| [string match "*static_text_symbol in bintest.${obj}*" $got] \
|| [string match "*static_data_symbol in bintest.${obj}*" $got] \
|| [string match "*external_symbol in bintest.${obj}*" $got] } {
fail $testname
return
}
pass $testname
}
# Test building a thin archive.
proc thin_archive { bfdtests } {
global AR
global AS
global NM
global srcdir
global subdir
global base_dir
global obj
set testname "ar thin archive"
if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
unresolved $testname
return
}
if [is_remote host] {
set archive artest.a
set objfile [remote_download host tmpdir/bintest.${obj}]
remote_file host delete $archive
} else {
set archive tmpdir/artest.a
set objfile tmpdir/bintest.${obj}
}
remote_file build delete tmpdir/artest.a
set got [binutils_run $AR "rcT $archive ${objfile}"]
if ![string match "" $got] {
fail $testname
return
}
foreach bfdtest $bfdtests {
set exec_output [binutils_run "$base_dir/$bfdtest" "$archive"]
if ![string match "" $exec_output] {
verbose -log $exec_output
fail "$testname ($bfdtest)"
return
}
}
set got [binutils_run $NM "--print-armap $archive"]
if { ![string match "*text_symbol in *bintest.${obj}*" $got] \
|| ![string match "*data_symbol in *bintest.${obj}*" $got] \
|| ![string match "*common_symbol in *bintest.${obj}*" $got] \
|| [string match "*static_text_symbol in *bintest.${obj}*" $got] \
|| [string match "*static_data_symbol in *bintest.${obj}*" $got] \
|| [string match "*external_symbol in *bintest.${obj}*" $got] } {
fail $testname
return
}
pass $testname
}
# Test building a thin archive with a nested archive.
proc thin_archive_with_nested { bfdtests } {
global AR
global AS
global NM
global srcdir
global subdir
global base_dir
global obj
set testname "ar thin archive with nested archive"
if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
unresolved $testname
return
}
if [is_remote host] {
set archive artest.a
set archive2 artest2.a
set objfile [remote_download host tmpdir/bintest.${obj}]
remote_file host delete $archive
} else {
set archive tmpdir/artest.a
set archive2 tmpdir/artest2.a
set objfile tmpdir/bintest.${obj}
}
remote_file build delete tmpdir/artest.a
set got [binutils_run $AR "rc $archive ${objfile}"]
if ![string match "" $got] {
fail $testname
return
}
remote_file build delete tmpdir/artest2.a
set got [binutils_run $AR "rcT $archive2 ${archive}"]
if ![string match "" $got] {
fail $testname
return
}
foreach bfdtest $bfdtests {
set exec_output [binutils_run "$base_dir/$bfdtest" "$archive"]
if ![string match "" $exec_output] {
verbose -log $exec_output
fail "$testname ($bfdtest)"
return
}
set exec_output [binutils_run "$base_dir/$bfdtest" "$archive2"]
if ![string match "" $exec_output] {
verbose -log $exec_output
fail "$testname ($bfdtest)"
return
}
}
set got [binutils_run $NM "--print-armap $archive"]
if { ![string match "*text_symbol in *bintest.${obj}*" $got] \
|| ![string match "*data_symbol in *bintest.${obj}*" $got] \
|| ![string match "*common_symbol in *bintest.${obj}*" $got] \
|| [string match "*static_text_symbol in *bintest.${obj}*" $got] \
|| [string match "*static_data_symbol in *bintest.${obj}*" $got] \
|| [string match "*external_symbol in *bintest.${obj}*" $got] } {
fail $testname
return
}
pass $testname
}
# Test POSIX-compatible argument parsing.
proc argument_parsing { } {
global AR
global AS
global srcdir
global subdir
global obj
set testname "ar argument parsing"
if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
unresolved $testname
return
}
if [is_remote host] {
set archive artest.a
set objfile [remote_download host tmpdir/bintest.${obj}]
remote_file host delete $archive
} else {
set archive tmpdir/artest.a
set objfile tmpdir/bintest.${obj}
}
remote_file build delete tmpdir/artest.a
set got [binutils_run $AR "-r -c $archive ${objfile}"]
if ![string match "" $got] {
fail $testname
return
}
pass $testname
}
# Test building a deterministic archive.
proc deterministic_archive { } {
global AR
global AS
global NM
global srcdir
global subdir
global obj
set testname "ar deterministic archive"
if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
unresolved $testname
return
}
if [is_remote host] {
set archive artest.a
set objfile [remote_download host tmpdir/bintest.${obj}]
remote_file host delete $archive
} else {
set archive tmpdir/artest.a
set objfile tmpdir/bintest.${obj}
}
remote_file build delete tmpdir/artest.a
set got [binutils_run $AR "rcD $archive ${objfile}"]
if ![string match "" $got] {
fail $testname
return
}
set got [binutils_run $AR "tv $archive"]
# This only checks the file mode and uid/gid. We can't easily match
# date because it's printed with the user's timezone.
if ![string match "rw-r--r-- 0/0 *bintest.${obj}*" $got] {
fail $testname
return
}
set got [binutils_run $AR "tvO $archive"]
if ![string match "rw-r--r-- 0/0 *bintest.${obj} 0x*" $got] {
fail $testname
return
}
pass $testname
}
proc unique_symbol { } {
global AR
global AS
global NM
global srcdir
global subdir
global obj
set testname "ar unique symbol in archive"
if ![binutils_assemble $srcdir/$subdir/unique.s tmpdir/unique.${obj}] {
unresolved $testname
return
}
if [is_remote host] {
set archive artest.a
set objfile [remote_download host tmpdir/unique.${obj}]
remote_file host delete $archive
} else {
set archive tmpdir/artest.a
set objfile tmpdir/unique.${obj}
}
remote_file build delete tmpdir/artest.a
set got [binutils_run $AR "-s -r -c $archive ${objfile}"]
if ![string match "" $got] {
fail $testname
return
}
set got [binutils_run $NM "--print-armap $archive"]
if ![string match "*foo in *unique.${obj}*" $got] {
fail $testname
return
}
pass $testname
}
# Test deleting an element.
proc delete_an_element { } {
global AR
global AS
global srcdir
global subdir
global obj
set testname "ar deleting an element"
if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
unresolved $testname
return
}
if [is_remote host] {
set archive artest.a
set objfile [remote_download host tmpdir/bintest.${obj}]
remote_file host delete $archive
} else {
set archive tmpdir/artest.a
set objfile tmpdir/bintest.${obj}
}
remote_file build delete tmpdir/artest.a
set got [binutils_run $AR "-r -c $archive ${objfile}"]
if ![string match "" $got] {
fail $testname
return
}
set got [binutils_run $AR "-d $archive ${objfile}"]
if ![string match "" $got] {
fail $testname
return
}
pass $testname
}
# Test moving an element.
proc move_an_element { } {
global AR
global AS
global srcdir
global subdir
global obj
set testname "ar moving an element"
if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
unresolved $testname
return
}
if [is_remote host] {
set archive artest.a
set objfile [remote_download host tmpdir/bintest.${obj}]
remote_file host delete $archive
} else {
set archive tmpdir/artest.a
set objfile tmpdir/bintest.${obj}
}
remote_file build delete tmpdir/artest.a
set got [binutils_run $AR "-r -c $archive ${objfile}"]
if ![string match "" $got] {
fail $testname
return
}
set got [binutils_run $AR "-m $archive ${objfile}"]
if ![string match "" $got] {
fail $testname
return
}
pass $testname
}
# PR 19775: Test creating and listing archives with an empty element.
proc empty_archive { } {
global AR
global srcdir
global subdir
set testname "archive with empty element"
# FIXME: There ought to be a way to dynamically create an empty file.
set empty $srcdir/$subdir/empty
if [is_remote host] {
set archive artest.a
set objfile [remote_download host $empty]
remote_file host delete $archive
} else {
set archive tmpdir/artest.a
set objfile $empty
}
remote_file build delete tmpdir/artest.a
set got [binutils_run $AR "-r -c $archive ${objfile}"]
if ![string match "" $got] {
fail $testname
return
}
# This commmand used to fail with: "Malformed archive".
set got [binutils_run $AR "-t $archive"]
if ![string match "empty
" $got] {
fail $testname
return
}
pass $testname
}
# Test extracting an element.
proc extract_an_element { } {
global AR
global AS
global srcdir
global subdir
global obj
set testname "ar extracting an element"
if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
unresolved $testname
return
}
set archive artest.a
if [is_remote host] {
set objfile [remote_download host tmpdir/bintest.${obj}]
remote_file host delete $archive
} else {
set objfile tmpdir/bintest.${obj}
}
remote_file build delete $archive
set got [binutils_run $AR "-r -c $archive ${objfile}"]
if ![string match "" $got] {
fail $testname
return
}
set got [binutils_run $AR "--output=tmpdir -x $archive ${objfile}"]
if ![string match "" $got] {
fail $testname
return
}
remote_file build delete $archive
remote_file build delete tmpdir/$archive
pass $testname
}
proc many_files { } {
global AR
global AS
global srcdir
global subdir
global obj
set testname "ar many files"
set ofiles {}
set max_file 150
for { set i 0 } { $i < $max_file } { incr i } {
set sfile "tmpdir/d-$i.s"
if [catch { set ofd [open $sfile w] } x] {
perror "$x"
unresolved $testname
return
}
puts $ofd " .globl data_sym$i"
puts $ofd " .data"
puts $ofd "data_sym$i:"
puts $ofd " .long $i"
close $ofd
set ofile "tmpdir/d-$i.${obj}"
if ![binutils_assemble $sfile $ofile] {
unresolved $testname
return
}
set objfile $ofile
if [is_remote host] {
remote_file host delete $sfile
set objfile [remote_download host $ofile]
remote_file build delete $ofile
}
remote_file build delete $sfile
lappend ofiles $objfile
}
set archive tmpdir/many.a
remote_file host delete $archive
set got [binutils_run $AR "cr $archive $ofiles"]
if ![string match "" $got] {
fail $testname
return
}
remote_file host delete $archive
eval remote_file host delete $ofiles
pass $testname
}
# Run the tests.
# Only run the bfdtest checks if the programs exist. Since these
# programs are built but not installed, running the testsuite on an
# installed toolchain will produce ERRORs about missing bfdtest1 and
# bfdtest2 executables.
if { [file exists $base_dir/bfdtest1] && [file exists $base_dir/bfdtest2] } {
set bfdtests [list bfdtest1 bfdtest2]
long_filenames $bfdtests
# xcoff, ecoff, and vms archive support doesn't handle thin archives
if { ![istarget "*-*-aix*"]
&& ![istarget "*-*-*ecoff"]
&& ![istarget "*-*-vms"] } {
thin_archive $bfdtests
thin_archive_with_nested $bfdtests
}
}
symbol_table
argument_parsing
deterministic_archive
delete_an_element
move_an_element
empty_archive
extract_an_element
many_files
if { [is_elf_format] && [supports_gnu_unique] } {
unique_symbol
}