1# Copyright 1995, 1997, 2002, 2004 Free Software Foundation, Inc. 2 3# This program is free software; you can redistribute it and/or modify 4# it under the terms of the GNU General Public License as published by 5# the Free Software Foundation; either version 2 of the License, or 6# (at your option) any later version. 7# 8# This program is distributed in the hope that it will be useful, 9# but WITHOUT ANY WARRANTY; without even the implied warranty of 10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11# GNU General Public License for more details. 12# 13# You should have received a copy of the GNU General Public License 14# along with this program; if not, write to the Free Software 15# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA. 16 17# Please email any bugs, comments, and/or additions to this file to: 18# bug-dejagnu@prep.ai.mit.edu 19 20# Written by Ian Lance Taylor <ian@cygnus.com> 21 22if ![is_remote host] { 23 if {[which $AR] == 0} then { 24 perror "$AR does not exist" 25 return 26 } 27} 28 29# send_user "Version [binutil_version $AR]" 30 31# Test long file name support 32 33proc long_filenames { } { 34 global AR 35 global host_triplet 36 37 set testname "ar long file names" 38 39 set n1 "abcdefghijklmnopqrstuvwxyz1" 40 set n2 "abcdefghijklmnopqrstuvwxyz2" 41 set file1 tmpdir/$n1 42 set file2 tmpdir/$n2 43 44 remote_file build delete $file1 45 46 # Some file systems truncate file names at 14 characters, which 47 # makes it impossible to run this test. Check for that now. 48 set status [catch "set f [open tmpdir/$n1 w]" errs] 49 if { $status != 0 } { 50 verbose -log "open tmpdir/$n1 returned $errs" 51 unsupported $testname 52 return 53 } 54 puts $f "first" 55 close $f 56 57 58 remote_file build delete $file2 59 60 set status [catch "set f [open tmpdir/$n2 w]" errs] 61 if { $status != 0 } { 62 verbose -log "open tmpdir/$n2 returned $errs" 63 unsupported $testname 64 return 65 } 66 puts $f "second" 67 close $f 68 69 if [is_remote host] { 70 set file1 [remote_download host $file1] 71 set file2 [remote_download host $file2] 72 set dest artest.a 73 } else { 74 set dest tmpdir/artest.a 75 } 76 77 remote_file host delete $dest 78 79 set got [binutils_run $AR "rc $dest $file1 $file2"] 80 if [is_remote host] { 81 remote_upload host $file1 tmpdir/$n1 82 } 83 84 set f [open tmpdir/$n1 r] 85 gets $f string 86 close $f 87 if ![string match "first" $string] { 88 verbose -log "reading tmpdir/$n1 returned $string" 89 unsupported $testname 90 return 91 } 92 93 remote_file host delete $dest 94 set got [binutils_run $AR "rc $dest $file1 $file2"] 95 96 if ![string match "" $got] { 97 fail $testname 98 return 99 } 100 101 remote_file build delete tmpdir/$n1 102 remote_file build delete tmpdir/$n2 103 104 set got [binutils_run $AR "t $dest"] 105 regsub "\[\r\n \t\]*$" "$got" "" got 106 if ![string match "$n1*$n2" $got] { 107 fail $testname 108 return 109 } 110 111 if [is_remote host] { 112 remote_file host delete $file1 113 remote_file host delete $file2 114 } 115 116 verbose -log "$AR x $dest" 117 set exec_output [binutils_run $AR "x $dest"] 118 set exec_output [prune_warnings $exec_output] 119 if ![string match "" $exec_output] { 120 verbose -log $exec_output 121 fail $testname 122 return 123 } 124 125 if [is_remote host] { 126 remote_upload host $n1 tmpdir/$n1 127 remote_upload host $n2 tmpdir/$n2 128 set file1 tmpdir/$n1 129 set file2 tmpdir/$n2 130 } else { 131 set file1 $n1 132 set file2 $n2 133 } 134 135 if ![file exists $file1] { 136 verbose -log "$file1 does not exist" 137 fail $testname 138 return 139 } 140 if ![file exists $file2] { 141 verbose -log "$file2 does not exist" 142 fail $testname 143 return 144 } 145 146 set f [open $file1 r] 147 if { [gets $f line] == -1 || $line != "first" } { 148 verbose -log "$file1 contents:" 149 verbose -log "$line" 150 close $f 151 fail $testname 152 return 153 } 154 close $f 155 156 set f [open $file2 r] 157 if { [gets $f line] == -1 || $line != "second" } { 158 verbose -log "$file2 contents:" 159 verbose -log "$line" 160 close $f 161 fail $testname 162 return 163 } 164 close $f 165 166 file delete $file1 $file2 167 pass $testname 168} 169 170# Test building the symbol table. 171 172proc symbol_table { } { 173 global AR 174 global AS 175 global NM 176 global srcdir 177 global subdir 178 179 set testname "ar symbol table" 180 181 if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.o] { 182 unresolved $testname 183 return 184 } 185 186 if [is_remote host] { 187 set archive artest.a 188 set objfile [remote_download host tmpdir/bintest.o] 189 remote_file host delete $archive 190 } else { 191 set archive tmpdir/artest.a 192 set objfile tmpdir/bintest.o 193 } 194 195 remote_file build delete tmpdir/artest.a 196 197 set got [binutils_run $AR "rc $archive ${objfile}"] 198 if ![string match "" $got] { 199 fail $testname 200 return 201 } 202 203 set got [binutils_run $NM "--print-armap $archive"] 204 if { ![string match "*text_symbol in bintest.o*" $got] \ 205 || ![string match "*data_symbol in bintest.o*" $got] \ 206 || ![string match "*common_symbol in bintest.o*" $got] \ 207 || [string match "*static_text_symbol in bintest.o*" $got] \ 208 || [string match "*static_data_symbol in bintest.o*" $got] \ 209 || [string match "*external_symbol in bintest.o*" $got] } { 210 fail $testname 211 return 212 } 213 214 pass $testname 215} 216 217# Test POSIX-compatible argument parsing. 218 219proc argument_parsing { } { 220 global AR 221 global AS 222 global srcdir 223 global subdir 224 225 set testname "ar argument parsing" 226 227 if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.o] { 228 unresolved $testname 229 return 230 } 231 232 if [is_remote host] { 233 set archive artest.a 234 set objfile [remote_download host tmpdir/bintest.o] 235 remote_file host delete $archive 236 } else { 237 set archive tmpdir/artest.a 238 set objfile tmpdir/bintest.o 239 } 240 241 remote_file build delete tmpdir/artest.a 242 243 set got [binutils_run $AR "-r -c $archive ${objfile}"] 244 if ![string match "" $got] { 245 fail $testname 246 return 247 } 248 249 pass $testname 250} 251 252# Run the tests. 253 254long_filenames 255symbol_table 256argument_parsing 257