| # Copyright 1995, 1997, 2002, 2004, 2007, 2008, 2009, 2010 |
| # 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 |
| } |
| } |
| |
| # send_user "Version [binutil_version $AR]" |
| |
| # Test long file name support |
| |
| proc long_filenames { } { |
| global AR |
| global host_triplet |
| |
| 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 |
| } |
| |
| verbose -log "$AR x $dest" |
| 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 |
| } |
| |
| 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 |
| |
| set testname "ar symbol table" |
| |
| if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.o] { |
| unresolved $testname |
| return |
| } |
| |
| if [is_remote host] { |
| set archive artest.a |
| set objfile [remote_download host tmpdir/bintest.o] |
| remote_file host delete $archive |
| } else { |
| set archive tmpdir/artest.a |
| set objfile tmpdir/bintest.o |
| } |
| |
| 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.o*" $got] \ |
| || ![string match "*data_symbol in bintest.o*" $got] \ |
| || ![string match "*common_symbol in bintest.o*" $got] \ |
| || [string match "*static_text_symbol in bintest.o*" $got] \ |
| || [string match "*static_data_symbol in bintest.o*" $got] \ |
| || [string match "*external_symbol in bintest.o*" $got] } { |
| fail $testname |
| return |
| } |
| |
| pass $testname |
| } |
| |
| # Test building a thin archive. |
| |
| proc thin_archive { } { |
| global AR |
| global AS |
| global NM |
| global srcdir |
| global subdir |
| |
| set testname "ar thin archive" |
| |
| if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.o] { |
| unresolved $testname |
| return |
| } |
| |
| if [is_remote host] { |
| set archive artest.a |
| set objfile [remote_download host tmpdir/bintest.o] |
| remote_file host delete $archive |
| } else { |
| set archive tmpdir/artest.a |
| set objfile tmpdir/bintest.o |
| } |
| |
| remote_file build delete tmpdir/artest.a |
| |
| set got [binutils_run $AR "rcT $archive ${objfile}"] |
| if ![string match "" $got] { |
| fail $testname |
| return |
| } |
| |
| set got [binutils_run $NM "--print-armap $archive"] |
| if { ![string match "*text_symbol in *bintest.o*" $got] \ |
| || ![string match "*data_symbol in *bintest.o*" $got] \ |
| || ![string match "*common_symbol in *bintest.o*" $got] \ |
| || [string match "*static_text_symbol in *bintest.o*" $got] \ |
| || [string match "*static_data_symbol in *bintest.o*" $got] \ |
| || [string match "*external_symbol in *bintest.o*" $got] } { |
| fail $testname |
| return |
| } |
| |
| pass $testname |
| } |
| |
| # Test building a thin archive with a nested archive. |
| |
| proc thin_archive_with_nested { } { |
| global AR |
| global AS |
| global NM |
| global srcdir |
| global subdir |
| |
| set testname "ar thin archive with nested archive" |
| |
| if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.o] { |
| unresolved $testname |
| return |
| } |
| |
| if [is_remote host] { |
| set archive artest.a |
| set archive2 artest2.a |
| set objfile [remote_download host tmpdir/bintest.o] |
| remote_file host delete $archive |
| } else { |
| set archive tmpdir/artest.a |
| set archive2 tmpdir/artest2.a |
| set objfile tmpdir/bintest.o |
| } |
| |
| 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 |
| } |
| |
| set got [binutils_run $NM "--print-armap $archive"] |
| if { ![string match "*text_symbol in *bintest.o*" $got] \ |
| || ![string match "*data_symbol in *bintest.o*" $got] \ |
| || ![string match "*common_symbol in *bintest.o*" $got] \ |
| || [string match "*static_text_symbol in *bintest.o*" $got] \ |
| || [string match "*static_data_symbol in *bintest.o*" $got] \ |
| || [string match "*external_symbol in *bintest.o*" $got] } { |
| fail $testname |
| return |
| } |
| |
| pass $testname |
| } |
| |
| # Test POSIX-compatible argument parsing. |
| |
| proc argument_parsing { } { |
| global AR |
| global AS |
| global srcdir |
| global subdir |
| |
| set testname "ar argument parsing" |
| |
| if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.o] { |
| unresolved $testname |
| return |
| } |
| |
| if [is_remote host] { |
| set archive artest.a |
| set objfile [remote_download host tmpdir/bintest.o] |
| remote_file host delete $archive |
| } else { |
| set archive tmpdir/artest.a |
| set objfile tmpdir/bintest.o |
| } |
| |
| 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 |
| |
| set testname "ar deterministic archive" |
| |
| if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.o] { |
| unresolved $testname |
| return |
| } |
| |
| if [is_remote host] { |
| set archive artest.a |
| set objfile [remote_download host tmpdir/bintest.o] |
| remote_file host delete $archive |
| } else { |
| set archive tmpdir/artest.a |
| set objfile tmpdir/bintest.o |
| } |
| |
| 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.o*" $got] { |
| fail $testname |
| return |
| } |
| |
| pass $testname |
| } |
| |
| proc unique_symbol { } { |
| global AR |
| global AS |
| global NM |
| global srcdir |
| global subdir |
| |
| set testname "ar unique symbol in archive" |
| |
| if ![binutils_assemble $srcdir/$subdir/unique.s tmpdir/unique.o] { |
| unresolved $testname |
| } |
| |
| if [is_remote host] { |
| set archive artest.a |
| set objfile [remote_download host tmpdir/unique.o] |
| remote_file host delete $archive |
| } else { |
| set archive tmpdir/artest.a |
| set objfile tmpdir/unique.o |
| } |
| |
| 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.o*" $got] { |
| fail $testname |
| return |
| } |
| |
| pass $testname |
| } |
| |
| # Run the tests. |
| |
| long_filenames |
| symbol_table |
| thin_archive |
| thin_archive_with_nested |
| argument_parsing |
| deterministic_archive |
| if { [is_elf_format] |
| && ![istarget "*-*-hpux*"] |
| && ![istarget "msp*-*-*"] } { |
| unique_symbol |
| } |
