binutils/testsuite/binutils-all/ar.exp

   1 #   Copyright 1995, 1997, 2002, 2004, 2007, 2008, 2009, 2010
   2 #   Free Software Foundation, Inc.
   3
   4 # This program is free software; you can redistribute it and/or modify
   5 # it under the terms of the GNU General Public License as published by
   6 # the Free Software Foundation; either version 3 of the License, or
   7 # (at your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program; if not, write to the Free Software
  16 # Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
  17
  18 # Please email any bugs, comments, and/or additions to this file to:
  19 # bug-dejagnu@prep.ai.mit.edu
  20
  21 # Written by Ian Lance Taylor <ian@cygnus.com>
  22
  23 if ![is_remote host] {
  24     if {[which $AR] == 0} then {
  25         perror "$AR does not exist"
  26         return
  27     }
  28 }
  29
  30 # send_user "Version [binutil_version $AR]"
  31
  32 # Test long file name support
  33
  34 proc long_filenames { } {
  35     global AR
  36     global host_triplet
  37
  38     set testname "ar long file names"
  39
  40     set n1 "abcdefghijklmnopqrstuvwxyz1"
  41     set n2 "abcdefghijklmnopqrstuvwxyz2"
  42     set file1 tmpdir/$n1
  43     set file2 tmpdir/$n2
  44
  45     remote_file build delete $file1
  46     remote_file host delete $n1
  47
  48     # Some file systems truncate file names at 14 characters, which
  49     # makes it impossible to run this test.  Check for that now.
  50     set status [catch "set f [open tmpdir/$n1 w]" errs]
  51     if { $status != 0 } {
  52         verbose -log "open tmpdir/$n1 returned $errs"
  53         unsupported $testname
  54         return
  55     }
  56     puts $f "first"
  57     close $f
  58
  59     remote_file build delete $file2
  60     remote_file host delete $n2
  61
  62     set status [catch "set f [open tmpdir/$n2 w]" errs]
  63     if { $status != 0 } {
  64         verbose -log "open tmpdir/$n2 returned $errs"
  65         unsupported $testname
  66         return
  67     }
  68     puts $f "second"
  69     close $f
  70
  71     if [is_remote host] {
  72         set file1 [remote_download host $file1]
  73         set file2 [remote_download host $file2]
  74         set dest artest.a
  75     } else {
  76         set dest tmpdir/artest.a
  77     }
  78
  79     remote_file host delete $dest
  80
  81     set got [binutils_run $AR "rc $dest $file1 $file2"]
  82     if [is_remote host] {
  83         remote_upload host $file1 tmpdir/$n1
  84     }
  85
  86     set f [open tmpdir/$n1 r]
  87     gets $f string
  88     close $f
  89     if ![string match "first" $string] {
  90         verbose -log "reading tmpdir/$n1 returned $string"
  91         unsupported $testname
  92         return
  93     }
  94
  95     remote_file host delete $dest
  96     set got [binutils_run $AR "rc $dest $file1 $file2"]
  97
  98     if ![string match "" $got] {
  99         fail $testname
 100         return
 101     }
 102
 103     remote_file build delete tmpdir/$n1
 104     remote_file build delete tmpdir/$n2
 105
 106     set got [binutils_run $AR "t $dest"]
 107     regsub "\[\r\n \t\]*$" "$got" "" got
 108     if ![string match "$n1*$n2" $got] {
 109         fail $testname
 110         return
 111     }
 112
 113     if [is_remote host] {
 114         remote_file host delete $file1
 115         remote_file host delete $file2
 116     }
 117
 118     verbose -log "$AR x $dest"
 119     set exec_output [binutils_run $AR "x $dest"]
 120     set exec_output [prune_warnings $exec_output]
 121     if ![string match "" $exec_output] {
 122         verbose -log $exec_output
 123         fail $testname
 124         return
 125     }
 126
 127     if [is_remote host] {
 128         remote_upload host $n1 tmpdir/$n1
 129         remote_upload host $n2 tmpdir/$n2
 130         set file1 tmpdir/$n1
 131         set file2 tmpdir/$n2
 132     } else {
 133         set file1 $n1
 134         set file2 $n2
 135     }
 136
 137     if ![file exists $file1] {
 138         verbose -log "$file1 does not exist"
 139         fail $testname
 140         return
 141     }
 142     if ![file exists $file2] {
 143         verbose -log "$file2 does not exist"
 144         fail $testname
 145         return
 146     }
 147
 148     set f [open $file1 r]
 149     if { [gets $f line] == -1 || $line != "first" } {
 150         verbose -log "$file1 contents:"
 151         verbose -log "$line"
 152         close $f
 153         fail $testname
 154         return
 155     }
 156     close $f
 157
 158     set f [open $file2 r]
 159     if { [gets $f line] == -1 || $line != "second" } {
 160         verbose -log "$file2 contents:"
 161         verbose -log "$line"
 162         close $f
 163         fail $testname
 164         return
 165     }
 166     close $f
 167
 168     file delete $file1 $file2
 169     pass $testname
 170 }
 171
 172 # Test building the symbol table.
 173
 174 proc symbol_table { } {
 175     global AR
 176     global AS
 177     global NM
 178     global srcdir
 179     global subdir
 180
 181     set testname "ar symbol table"
 182
 183     if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.o] {
 184         unresolved $testname
 185         return
 186     }
 187
 188     if [is_remote host] {
 189         set archive artest.a
 190         set objfile [remote_download host tmpdir/bintest.o]
 191         remote_file host delete $archive
 192     } else {
 193         set archive tmpdir/artest.a
 194         set objfile tmpdir/bintest.o
 195     }
 196
 197     remote_file build delete tmpdir/artest.a
 198
 199     set got [binutils_run $AR "rc $archive ${objfile}"]
 200     if ![string match "" $got] {
 201         fail $testname
 202         return
 203     }
 204
 205     set got [binutils_run $NM "--print-armap $archive"]
 206     if { ![string match "*text_symbol in bintest.o*" $got] \
 207          || ![string match "*data_symbol in bintest.o*" $got] \
 208          || ![string match "*common_symbol in bintest.o*" $got] \
 209          || [string match "*static_text_symbol in bintest.o*" $got] \
 210          || [string match "*static_data_symbol in bintest.o*" $got] \
 211          || [string match "*external_symbol in bintest.o*" $got] } {
 212         fail $testname
 213         return
 214     }
 215
 216     pass $testname
 217 }
 218
 219 # Test building a thin archive.
 220
 221 proc thin_archive { } {
 222     global AR
 223     global AS
 224     global NM
 225     global srcdir
 226     global subdir
 227
 228     set testname "ar thin archive"
 229
 230     if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.o] {
 231         unresolved $testname
 232         return
 233     }
 234
 235     if [is_remote host] {
 236         set archive artest.a
 237         set objfile [remote_download host tmpdir/bintest.o]
 238         remote_file host delete $archive
 239     } else {
 240         set archive tmpdir/artest.a
 241         set objfile tmpdir/bintest.o
 242     }
 243
 244     remote_file build delete tmpdir/artest.a
 245
 246     set got [binutils_run $AR "rcT $archive ${objfile}"]
 247     if ![string match "" $got] {
 248         fail $testname
 249         return
 250     }
 251
 252     set got [binutils_run $NM "--print-armap $archive"]
 253     if { ![string match "*text_symbol in *bintest.o*" $got] \
 254          || ![string match "*data_symbol in *bintest.o*" $got] \
 255          || ![string match "*common_symbol in *bintest.o*" $got] \
 256          || [string match "*static_text_symbol in *bintest.o*" $got] \
 257          || [string match "*static_data_symbol in *bintest.o*" $got] \
 258          || [string match "*external_symbol in *bintest.o*" $got] } {
 259         fail $testname
 260         return
 261     }
 262
 263     pass $testname
 264 }
 265
 266 # Test building a thin archive with a nested archive.
 267
 268 proc thin_archive_with_nested { } {
 269     global AR
 270     global AS
 271     global NM
 272     global srcdir
 273     global subdir
 274
 275     set testname "ar thin archive with nested archive"
 276
 277     if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.o] {
 278         unresolved $testname
 279         return
 280     }
 281
 282     if [is_remote host] {
 283         set archive artest.a
 284         set archive2 artest2.a
 285         set objfile [remote_download host tmpdir/bintest.o]
 286         remote_file host delete $archive
 287     } else {
 288         set archive tmpdir/artest.a
 289         set archive2 tmpdir/artest2.a
 290         set objfile tmpdir/bintest.o
 291     }
 292
 293     remote_file build delete tmpdir/artest.a
 294
 295     set got [binutils_run $AR "rc $archive ${objfile}"]
 296     if ![string match "" $got] {
 297         fail $testname
 298         return
 299     }
 300
 301     remote_file build delete tmpdir/artest2.a
 302
 303     set got [binutils_run $AR "rcT $archive2 ${archive}"]
 304     if ![string match "" $got] {
 305         fail $testname
 306         return
 307     }
 308
 309     set got [binutils_run $NM "--print-armap $archive"]
 310     if { ![string match "*text_symbol in *bintest.o*" $got] \
 311          || ![string match "*data_symbol in *bintest.o*" $got] \
 312          || ![string match "*common_symbol in *bintest.o*" $got] \
 313          || [string match "*static_text_symbol in *bintest.o*" $got] \
 314          || [string match "*static_data_symbol in *bintest.o*" $got] \
 315          || [string match "*external_symbol in *bintest.o*" $got] } {
 316         fail $testname
 317         return
 318     }
 319
 320     pass $testname
 321 }
 322
 323 # Test POSIX-compatible argument parsing.
 324
 325 proc argument_parsing { } {
 326     global AR
 327     global AS
 328     global srcdir
 329     global subdir
 330
 331     set testname "ar argument parsing"
 332
 333     if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.o] {
 334         unresolved $testname
 335         return
 336     }
 337
 338     if [is_remote host] {
 339         set archive artest.a
 340         set objfile [remote_download host tmpdir/bintest.o]
 341         remote_file host delete $archive
 342     } else {
 343         set archive tmpdir/artest.a
 344         set objfile tmpdir/bintest.o
 345     }
 346
 347     remote_file build delete tmpdir/artest.a
 348
 349     set got [binutils_run $AR "-r -c $archive ${objfile}"]
 350     if ![string match "" $got] {
 351         fail $testname
 352         return
 353     }
 354
 355     pass $testname
 356 }
 357
 358 # Test building a deterministic archive.
 359
 360 proc deterministic_archive { } {
 361     global AR
 362     global AS
 363     global NM
 364     global srcdir
 365     global subdir
 366
 367     set testname "ar deterministic archive"
 368
 369     if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.o] {
 370         unresolved $testname
 371         return
 372     }
 373
 374     if [is_remote host] {
 375         set archive artest.a
 376         set objfile [remote_download host tmpdir/bintest.o]
 377         remote_file host delete $archive
 378     } else {
 379         set archive tmpdir/artest.a
 380         set objfile tmpdir/bintest.o
 381     }
 382
 383     remote_file build delete tmpdir/artest.a
 384
 385     set got [binutils_run $AR "rcD $archive ${objfile}"]
 386     if ![string match "" $got] {
 387         fail $testname
 388         return
 389     }
 390
 391     set got [binutils_run $AR "tv $archive"]
 392     # This only checks the file mode and uid/gid.  We can't easily match
 393     # date because it's printed with the user's timezone.
 394     if ![string match "rw-r--r-- 0/0 *bintest.o*" $got] {
 395         fail $testname
 396         return
 397     }
 398
 399     pass $testname
 400 }
 401
 402 proc unique_symbol { } {
 403     global AR
 404     global AS
 405     global NM
 406     global srcdir
 407     global subdir
 408
 409     set testname "ar unique symbol in archive"
 410
 411     if ![binutils_assemble $srcdir/$subdir/unique.s tmpdir/unique.o] {
 412         unresolved $testname
 413     }
 414
 415     if [is_remote host] {
 416         set archive artest.a
 417         set objfile [remote_download host tmpdir/unique.o]
 418         remote_file host delete $archive
 419     } else {
 420         set archive tmpdir/artest.a
 421         set objfile tmpdir/unique.o
 422     }
 423
 424     remote_file build delete tmpdir/artest.a
 425
 426     set got [binutils_run $AR "-s -r -c $archive ${objfile}"]
 427     if ![string match "" $got] {
 428         fail $testname
 429         return
 430     }
 431
 432     set got [binutils_run $NM "--print-armap $archive"]
 433     if ![string match "*foo in *unique.o*" $got] {
 434         fail $testname
 435         return
 436     }
 437
 438     pass $testname
 439 }
 440
 441 # Test deleting an element.
 442
 443 proc delete_an_element { } {
 444     global AR
 445     global AS
 446     global srcdir
 447     global subdir
 448
 449     set testname "ar deleting an element"
 450
 451     if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.o] {
 452         unresolved $testname
 453         return
 454     }
 455
 456     if [is_remote host] {
 457         set archive artest.a
 458         set objfile [remote_download host tmpdir/bintest.o]
 459         remote_file host delete $archive
 460     } else {
 461         set archive tmpdir/artest.a
 462         set objfile tmpdir/bintest.o
 463     }
 464
 465     remote_file build delete tmpdir/artest.a
 466
 467     set got [binutils_run $AR "-r -c $archive ${objfile}"]
 468     if ![string match "" $got] {
 469         fail $testname
 470         return
 471     }
 472
 473     set got [binutils_run $AR "-d $archive ${objfile}"]
 474     if ![string match "" $got] {
 475         fail $testname
 476         return
 477     }
 478
 479     pass $testname
 480 }
 481
 482 # Test moving an element.
 483
 484 proc move_an_element { } {
 485     global AR
 486     global AS
 487     global srcdir
 488     global subdir
 489
 490     set testname "ar moving an element"
 491
 492     if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.o] {
 493         unresolved $testname
 494         return
 495     }
 496
 497     if [is_remote host] {
 498         set archive artest.a
 499         set objfile [remote_download host tmpdir/bintest.o]
 500         remote_file host delete $archive
 501     } else {
 502         set archive tmpdir/artest.a
 503         set objfile tmpdir/bintest.o
 504     }
 505
 506     remote_file build delete tmpdir/artest.a
 507
 508     set got [binutils_run $AR "-r -c $archive ${objfile}"]
 509     if ![string match "" $got] {
 510         fail $testname
 511         return
 512     }
 513
 514     set got [binutils_run $AR "-m $archive ${objfile}"]
 515     if ![string match "" $got] {
 516         fail $testname
 517         return
 518     }
 519
 520     pass $testname
 521 }
 522
 523 # Run the tests.
 524
 525 long_filenames
 526 symbol_table
 527 thin_archive
 528 thin_archive_with_nested
 529 argument_parsing
 530 deterministic_archive
 531 delete_an_element
 532 move_an_element
 533 if { [is_elf_format]
 534      && ![istarget "*-*-hpux*"]
 535      && ![istarget "msp*-*-*"] } {
 536     unique_symbol
 537 }