binutils/testsuite/binutils-all/ar.exp

   1 #   Copyright (C) 1995-2020 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 3 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
  22 if ![is_remote host] {
  23     if {[which $AR] == 0} then {
  24         perror "$AR does not exist"
  25         return
  26     }
  27 }
  28
  29 set obj o
  30 if { [istarget "*-*-vms"] } then {
  31     set obj obj
  32 }
  33
  34 # send_user "Version [binutil_version $AR]"
  35
  36 # Test long file name support
  37
  38 proc long_filenames { bfdtests } {
  39     global AR
  40     global host_triplet
  41     global base_dir
  42
  43     set testname "ar long file names"
  44
  45     set n1 "abcdefghijklmnopqrstuvwxyz1"
  46     set n2 "abcdefghijklmnopqrstuvwxyz2"
  47     set file1 tmpdir/$n1
  48     set file2 tmpdir/$n2
  49
  50     remote_file build delete $file1
  51     remote_file host delete $n1
  52
  53     # Some file systems truncate file names at 14 characters, which
  54     # makes it impossible to run this test.  Check for that now.
  55     set status [catch "set f [open tmpdir/$n1 w]" errs]
  56     if { $status != 0 } {
  57         verbose -log "open tmpdir/$n1 returned $errs"
  58         unsupported $testname
  59         return
  60     }
  61     puts $f "first"
  62     close $f
  63
  64     remote_file build delete $file2
  65     remote_file host delete $n2
  66
  67     set status [catch "set f [open tmpdir/$n2 w]" errs]
  68     if { $status != 0 } {
  69         verbose -log "open tmpdir/$n2 returned $errs"
  70         unsupported $testname
  71         return
  72     }
  73     puts $f "second"
  74     close $f
  75
  76     if [is_remote host] {
  77         set file1 [remote_download host $file1]
  78         set file2 [remote_download host $file2]
  79         set dest artest.a
  80     } else {
  81         set dest tmpdir/artest.a
  82     }
  83
  84     remote_file host delete $dest
  85
  86     set got [binutils_run $AR "rc $dest $file1 $file2"]
  87     if [is_remote host] {
  88         remote_upload host $file1 tmpdir/$n1
  89     }
  90
  91     set f [open tmpdir/$n1 r]
  92     gets $f string
  93     close $f
  94     if ![string match "first" $string] {
  95         verbose -log "reading tmpdir/$n1 returned $string"
  96         unsupported $testname
  97         return
  98     }
  99
 100     remote_file host delete $dest
 101     set got [binutils_run $AR "rc $dest $file1 $file2"]
 102
 103     if ![string match "" $got] {
 104         fail $testname
 105         return
 106     }
 107
 108     remote_file build delete tmpdir/$n1
 109     remote_file build delete tmpdir/$n2
 110
 111     set got [binutils_run $AR "t $dest"]
 112     regsub "\[\r\n \t\]*$" "$got" "" got
 113     if ![string match "$n1*$n2" $got] {
 114         fail $testname
 115         return
 116     }
 117
 118     if [is_remote host] {
 119         remote_file host delete $file1
 120         remote_file host delete $file2
 121     }
 122
 123     set exec_output [binutils_run $AR "x $dest"]
 124     set exec_output [prune_warnings $exec_output]
 125     if ![string match "" $exec_output] {
 126         verbose -log $exec_output
 127         fail $testname
 128         return
 129     }
 130
 131     foreach bfdtest $bfdtests {
 132         set exec_output [binutils_run "$base_dir/$bfdtest" "$dest"]
 133         if ![string match "" $exec_output] {
 134             verbose -log $exec_output
 135             fail "$testname ($bfdtest)"
 136             return
 137         }
 138     }
 139
 140     if [is_remote host] {
 141         remote_upload host $n1 tmpdir/$n1
 142         remote_upload host $n2 tmpdir/$n2
 143         set file1 tmpdir/$n1
 144         set file2 tmpdir/$n2
 145     } else {
 146         set file1 $n1
 147         set file2 $n2
 148     }
 149
 150     if ![file exists $file1] {
 151         verbose -log "$file1 does not exist"
 152         fail $testname
 153         return
 154     }
 155     if ![file exists $file2] {
 156         verbose -log "$file2 does not exist"
 157         fail $testname
 158         return
 159     }
 160
 161     set f [open $file1 r]
 162     if { [gets $f line] == -1 || $line != "first" } {
 163         verbose -log "$file1 contents:"
 164         verbose -log "$line"
 165         close $f
 166         fail $testname
 167         return
 168     }
 169     close $f
 170
 171     set f [open $file2 r]
 172     if { [gets $f line] == -1 || $line != "second" } {
 173         verbose -log "$file2 contents:"
 174         verbose -log "$line"
 175         close $f
 176         fail $testname
 177         return
 178     }
 179     close $f
 180
 181     file delete $file1 $file2
 182     pass $testname
 183 }
 184
 185 # Test building the symbol table.
 186
 187 proc symbol_table { } {
 188     global AR
 189     global AS
 190     global NM
 191     global srcdir
 192     global subdir
 193     global obj
 194
 195     set testname "ar symbol table"
 196
 197     if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
 198         unresolved $testname
 199         return
 200     }
 201
 202     if [is_remote host] {
 203         set archive artest.a
 204         set objfile [remote_download host tmpdir/bintest.${obj}]
 205         remote_file host delete $archive
 206     } else {
 207         set archive tmpdir/artest.a
 208         set objfile tmpdir/bintest.${obj}
 209     }
 210
 211     remote_file build delete tmpdir/artest.a
 212
 213     set got [binutils_run $AR "rc $archive ${objfile}"]
 214     if ![string match "" $got] {
 215         fail $testname
 216         return
 217     }
 218
 219     set got [binutils_run $NM "--print-armap $archive"]
 220     if { ![string match "*text_symbol in bintest.${obj}*" $got] \
 221          || ![string match "*data_symbol in bintest.${obj}*" $got] \
 222          || ![string match "*common_symbol in bintest.${obj}*" $got] \
 223          || [string match "*static_text_symbol in bintest.${obj}*" $got] \
 224          || [string match "*static_data_symbol in bintest.${obj}*" $got] \
 225          || [string match "*external_symbol in bintest.${obj}*" $got] } {
 226         fail $testname
 227         return
 228     }
 229
 230     pass $testname
 231 }
 232
 233 # Test building a thin archive.
 234
 235 proc thin_archive { bfdtests } {
 236     global AR
 237     global AS
 238     global NM
 239     global srcdir
 240     global subdir
 241     global base_dir
 242     global obj
 243
 244     set testname "ar thin archive"
 245
 246     if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
 247         unresolved $testname
 248         return
 249     }
 250
 251     if [is_remote host] {
 252         set archive artest.a
 253         set objfile [remote_download host tmpdir/bintest.${obj}]
 254         remote_file host delete $archive
 255     } else {
 256         set archive tmpdir/artest.a
 257         set objfile tmpdir/bintest.${obj}
 258     }
 259
 260     remote_file build delete tmpdir/artest.a
 261
 262     set got [binutils_run $AR "rcT $archive ${objfile}"]
 263     if ![string match "" $got] {
 264         fail $testname
 265         return
 266     }
 267
 268     foreach bfdtest $bfdtests {
 269         set exec_output [binutils_run "$base_dir/$bfdtest" "$archive"]
 270         if ![string match "" $exec_output] {
 271             verbose -log $exec_output
 272             fail "$testname ($bfdtest)"
 273             return
 274         }
 275     }
 276
 277     set got [binutils_run $NM "--print-armap $archive"]
 278     if { ![string match "*text_symbol in *bintest.${obj}*" $got] \
 279          || ![string match "*data_symbol in *bintest.${obj}*" $got] \
 280          || ![string match "*common_symbol in *bintest.${obj}*" $got] \
 281          || [string match "*static_text_symbol in *bintest.${obj}*" $got] \
 282          || [string match "*static_data_symbol in *bintest.${obj}*" $got] \
 283          || [string match "*external_symbol in *bintest.${obj}*" $got] } {
 284         fail $testname
 285         return
 286     }
 287
 288     pass $testname
 289 }
 290
 291 # Test building a thin archive with a nested archive.
 292
 293 proc thin_archive_with_nested { bfdtests } {
 294     global AR
 295     global AS
 296     global NM
 297     global srcdir
 298     global subdir
 299     global base_dir
 300     global obj
 301
 302     set testname "ar thin archive with nested archive"
 303
 304     if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
 305         unresolved $testname
 306         return
 307     }
 308
 309     if [is_remote host] {
 310         set archive artest.a
 311         set archive2 artest2.a
 312         set objfile [remote_download host tmpdir/bintest.${obj}]
 313         remote_file host delete $archive
 314     } else {
 315         set archive tmpdir/artest.a
 316         set archive2 tmpdir/artest2.a
 317         set objfile tmpdir/bintest.${obj}
 318     }
 319
 320     remote_file build delete tmpdir/artest.a
 321
 322     set got [binutils_run $AR "rc $archive ${objfile}"]
 323     if ![string match "" $got] {
 324         fail $testname
 325         return
 326     }
 327
 328     remote_file build delete tmpdir/artest2.a
 329
 330     set got [binutils_run $AR "rcT $archive2 ${archive}"]
 331     if ![string match "" $got] {
 332         fail $testname
 333         return
 334     }
 335
 336     foreach bfdtest $bfdtests {
 337         set exec_output [binutils_run "$base_dir/$bfdtest" "$archive"]
 338         if ![string match "" $exec_output] {
 339             verbose -log $exec_output
 340             fail "$testname ($bfdtest)"
 341             return
 342         }
 343
 344         set exec_output [binutils_run "$base_dir/$bfdtest" "$archive2"]
 345         if ![string match "" $exec_output] {
 346             verbose -log $exec_output
 347             fail "$testname ($bfdtest)"
 348             return
 349         }
 350     }
 351
 352     set got [binutils_run $NM "--print-armap $archive"]
 353     if { ![string match "*text_symbol in *bintest.${obj}*" $got] \
 354          || ![string match "*data_symbol in *bintest.${obj}*" $got] \
 355          || ![string match "*common_symbol in *bintest.${obj}*" $got] \
 356          || [string match "*static_text_symbol in *bintest.${obj}*" $got] \
 357          || [string match "*static_data_symbol in *bintest.${obj}*" $got] \
 358          || [string match "*external_symbol in *bintest.${obj}*" $got] } {
 359         fail $testname
 360         return
 361     }
 362
 363     pass $testname
 364 }
 365
 366 # Test POSIX-compatible argument parsing.
 367
 368 proc argument_parsing { } {
 369     global AR
 370     global AS
 371     global srcdir
 372     global subdir
 373     global obj
 374
 375     set testname "ar argument parsing"
 376
 377     if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
 378         unresolved $testname
 379         return
 380     }
 381
 382     if [is_remote host] {
 383         set archive artest.a
 384         set objfile [remote_download host tmpdir/bintest.${obj}]
 385         remote_file host delete $archive
 386     } else {
 387         set archive tmpdir/artest.a
 388         set objfile tmpdir/bintest.${obj}
 389     }
 390
 391     remote_file build delete tmpdir/artest.a
 392
 393     set got [binutils_run $AR "-r -c $archive ${objfile}"]
 394     if ![string match "" $got] {
 395         fail $testname
 396         return
 397     }
 398
 399     pass $testname
 400 }
 401
 402 # Test building a deterministic archive.
 403
 404 proc deterministic_archive { } {
 405     global AR
 406     global AS
 407     global NM
 408     global srcdir
 409     global subdir
 410     global obj
 411
 412     set testname "ar deterministic archive"
 413
 414     if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
 415         unresolved $testname
 416         return
 417     }
 418
 419     if [is_remote host] {
 420         set archive artest.a
 421         set objfile [remote_download host tmpdir/bintest.${obj}]
 422         remote_file host delete $archive
 423     } else {
 424         set archive tmpdir/artest.a
 425         set objfile tmpdir/bintest.${obj}
 426     }
 427
 428     remote_file build delete tmpdir/artest.a
 429
 430     set got [binutils_run $AR "rcD $archive ${objfile}"]
 431     if ![string match "" $got] {
 432         fail $testname
 433         return
 434     }
 435
 436     set got [binutils_run $AR "tv $archive"]
 437     # This only checks the file mode and uid/gid.  We can't easily match
 438     # date because it's printed with the user's timezone.
 439     if ![string match "rw-r--r-- 0/0 *bintest.${obj}*" $got] {
 440         fail $testname
 441         return
 442     }
 443
 444     set got [binutils_run $AR "tvO $archive"]
 445     if ![string match "rw-r--r-- 0/0 *bintest.${obj} 0x*" $got] {
 446         fail $testname
 447         return
 448     }
 449
 450     pass $testname
 451 }
 452
 453 proc unique_symbol { } {
 454     global AR
 455     global AS
 456     global NM
 457     global srcdir
 458     global subdir
 459     global obj
 460
 461     set testname "ar unique symbol in archive"
 462
 463     if ![binutils_assemble $srcdir/$subdir/unique.s tmpdir/unique.${obj}] {
 464         unresolved $testname
 465         return
 466     }
 467
 468     if [is_remote host] {
 469         set archive artest.a
 470         set objfile [remote_download host tmpdir/unique.${obj}]
 471         remote_file host delete $archive
 472     } else {
 473         set archive tmpdir/artest.a
 474         set objfile tmpdir/unique.${obj}
 475     }
 476
 477     remote_file build delete tmpdir/artest.a
 478
 479     set got [binutils_run $AR "-s -r -c $archive ${objfile}"]
 480     if ![string match "" $got] {
 481         fail $testname
 482         return
 483     }
 484
 485     set got [binutils_run $NM "--print-armap $archive"]
 486     if ![string match "*foo in *unique.${obj}*" $got] {
 487         fail $testname
 488         return
 489     }
 490
 491     pass $testname
 492 }
 493
 494 # Test deleting an element.
 495
 496 proc delete_an_element { } {
 497     global AR
 498     global AS
 499     global srcdir
 500     global subdir
 501     global obj
 502
 503     set testname "ar deleting an element"
 504
 505     if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
 506         unresolved $testname
 507         return
 508     }
 509
 510     if [is_remote host] {
 511         set archive artest.a
 512         set objfile [remote_download host tmpdir/bintest.${obj}]
 513         remote_file host delete $archive
 514     } else {
 515         set archive tmpdir/artest.a
 516         set objfile tmpdir/bintest.${obj}
 517     }
 518
 519     remote_file build delete tmpdir/artest.a
 520
 521     set got [binutils_run $AR "-r -c $archive ${objfile}"]
 522     if ![string match "" $got] {
 523         fail $testname
 524         return
 525     }
 526
 527     set got [binutils_run $AR "-d $archive ${objfile}"]
 528     if ![string match "" $got] {
 529         fail $testname
 530         return
 531     }
 532
 533     pass $testname
 534 }
 535
 536 # Test moving an element.
 537
 538 proc move_an_element { } {
 539     global AR
 540     global AS
 541     global srcdir
 542     global subdir
 543     global obj
 544
 545     set testname "ar moving an element"
 546
 547     if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
 548         unresolved $testname
 549         return
 550     }
 551
 552     if [is_remote host] {
 553         set archive artest.a
 554         set objfile [remote_download host tmpdir/bintest.${obj}]
 555         remote_file host delete $archive
 556     } else {
 557         set archive tmpdir/artest.a
 558         set objfile tmpdir/bintest.${obj}
 559     }
 560
 561     remote_file build delete tmpdir/artest.a
 562
 563     set got [binutils_run $AR "-r -c $archive ${objfile}"]
 564     if ![string match "" $got] {
 565         fail $testname
 566         return
 567     }
 568
 569     set got [binutils_run $AR "-m $archive ${objfile}"]
 570     if ![string match "" $got] {
 571         fail $testname
 572         return
 573     }
 574
 575     pass $testname
 576 }
 577
 578 # PR 19775: Test creating and listing archives with an empty element.
 579
 580 proc empty_archive { } {
 581     global AR
 582     global srcdir
 583     global subdir
 584
 585     set testname "archive with empty element"
 586
 587     # FIXME: There ought to be a way to dynamically create an empty file.
 588     set empty $srcdir/$subdir/empty
 589
 590     if [is_remote host] {
 591         set archive artest.a
 592         set objfile [remote_download host $empty]
 593         remote_file host delete $archive
 594     } else {
 595         set archive tmpdir/artest.a
 596         set objfile $empty
 597     }
 598
 599     remote_file build delete tmpdir/artest.a
 600
 601     set got [binutils_run $AR "-r -c $archive ${objfile}"]
 602     if ![string match "" $got] {
 603         fail $testname
 604         return
 605     }
 606
 607     # This commmand used to fail with: "Malformed archive".
 608     set got [binutils_run $AR "-t $archive"]
 609     if ![string match "empty
" $got] {
 610         fail $testname
 611         return
 612     }
 613
 614     pass $testname
 615 }
 616
 617 # Test extracting an element.
 618
 619 proc extract_an_element { } {
 620     global AR
 621     global AS
 622     global srcdir
 623     global subdir
 624     global obj
 625
 626     set testname "ar extracting an element"
 627
 628     if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
 629         unresolved $testname
 630         return
 631     }
 632
 633     set archive artest.a
 634
 635     if [is_remote host] {
 636         set objfile [remote_download host tmpdir/bintest.${obj}]
 637         remote_file host delete $archive
 638     } else {
 639         set objfile tmpdir/bintest.${obj}
 640     }
 641
 642     remote_file build delete $archive
 643
 644     set got [binutils_run $AR "-r -c $archive ${objfile}"]
 645     if ![string match "" $got] {
 646         fail $testname
 647         return
 648     }
 649
 650     set got [binutils_run $AR "--output=tmpdir -x $archive ${objfile}"]
 651     if ![string match "" $got] {
 652         fail $testname
 653         return
 654     }
 655
 656     remote_file build delete $archive
 657     remote_file build delete tmpdir/$archive
 658
 659     pass $testname
 660 }
 661
 662 proc many_files { } {
 663     global AR
 664     global AS
 665     global srcdir
 666     global subdir
 667     global obj
 668
 669     set testname "ar many files"
 670
 671     set ofiles {}
 672     set max_file 150
 673     for { set i 0 } { $i < $max_file } { incr i } {
 674         set sfile "tmpdir/d-$i.s"
 675         if [catch { set ofd [open $sfile w] } x] {
 676             perror "$x"
 677             unresolved $testname
 678             return
 679         }
 680
 681         puts $ofd " .globl data_sym$i"
 682         puts $ofd " .data"
 683         puts $ofd "data_sym$i:"
 684         puts $ofd " .long $i"
 685         close $ofd
 686
 687         set ofile "tmpdir/d-$i.${obj}"
 688         if ![binutils_assemble $sfile $ofile] {
 689             unresolved $testname
 690             return
 691         }
 692
 693         set objfile $ofile
 694         if [is_remote host] {
 695             remote_file host delete $sfile
 696             set objfile [remote_download host $ofile]
 697             remote_file build delete $ofile
 698         }
 699         remote_file build delete $sfile
 700         lappend ofiles $objfile
 701     }
 702
 703     set archive tmpdir/many.a
 704     remote_file host delete $archive
 705
 706     set got [binutils_run $AR "cr $archive $ofiles"]
 707     if ![string match "" $got] {
 708         fail $testname
 709         return
 710     }
 711
 712     remote_file host delete $archive
 713     eval remote_file host delete $ofiles
 714
 715     pass $testname
 716 }
 717
 718 # Run the tests.
 719
 720 # Only run the bfdtest checks if the programs exist.  Since these
 721 # programs are built but not installed, running the testsuite on an
 722 # installed toolchain will produce ERRORs about missing bfdtest1 and
 723 # bfdtest2 executables.
 724 if { [file exists $base_dir/bfdtest1] && [file exists $base_dir/bfdtest2] } {
 725     set bfdtests [list bfdtest1 bfdtest2]
 726
 727     long_filenames $bfdtests
 728
 729     # xcoff, ecoff, and vms archive support doesn't handle thin archives
 730     if { ![istarget "*-*-aix*"]
 731          && ![istarget "*-*-*ecoff"]
 732          && ![istarget "*-*-vms"] } {
 733         thin_archive $bfdtests
 734         thin_archive_with_nested $bfdtests
 735     }
 736 }
 737
 738 symbol_table
 739 argument_parsing
 740 deterministic_archive
 741 delete_an_element
 742 move_an_element
 743 empty_archive
 744 extract_an_element
 745 many_files
 746
 747 if { [is_elf_format] && [supports_gnu_unique] } {
 748     unique_symbol
 749 }