binutils/testsuite/binutils-all/ar.exp

   1 #   Copyright 1995, 1997, 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 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
  22 if ![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
  33 proc 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
 172 proc 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
 219 proc 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
 254 long_filenames
 255 symbol_table
 256 argument_parsing