binutils/testsuite/binutils-all/ar.exp

   1 #   Copyright (C) 1995, 1997 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     pass $testname
 167 }
 168
 169 # Test building the symbol table.
 170
 171 proc symbol_table { } {
 172     global AR
 173     global AS
 174     global NM
 175     global srcdir
 176     global subdir
 177
 178     set testname "ar symbol table"
 179
 180     if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.o] {
 181         unresolved $testname
 182         return
 183     }
 184
 185     if [is_remote host] {
 186         set archive artest.a
 187         set objfile [remote_download host tmpdir/bintest.o]
 188         remote_file host delete $archive
 189     } else {
 190         set archive tmpdir/artest.a
 191         set objfile tmpdir/bintest.o
 192     }
 193
 194     remote_file build delete tmpdir/artest.a
 195
 196     set got [binutils_run $AR "rc $archive ${objfile}"]
 197     if ![string match "" $got] {
 198         fail $testname
 199         return
 200     }
 201
 202     set got [binutils_run $NM "--print-armap $archive"]
 203     if { ![string match "*text_symbol in bintest.o*" $got] \
 204          || ![string match "*data_symbol in bintest.o*" $got] \
 205          || ![string match "*common_symbol in bintest.o*" $got] \
 206          || [string match "*static_text_symbol in bintest.o*" $got] \
 207          || [string match "*static_data_symbol in bintest.o*" $got] \
 208          || [string match "*external_symbol in bintest.o*" $got] } {
 209         fail $testname
 210         return
 211     }
 212
 213     pass $testname
 214 }
 215
 216 # Run the tests.
 217
 218 long_filenames
 219 symbol_table