binutils/testsuite/binutils-all/ar.exp

   1 #   Copyright (C) 1995-2022 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         unsupported $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         unsupported $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         unsupported $testname
 306         return
 307     }
 308
 309     if [is_remote host] {
 310         set archive artest.a
 311         set archive2 artest2.a
 312         set archive3 artest3.a
 313         set objfile [remote_download host tmpdir/bintest.${obj}]
 314         remote_file host delete $archive
 315     } else {
 316         set archive tmpdir/artest.a
 317         set archive2 tmpdir/artest2.a
 318         set archive3 tmpdir/artest3.a
 319         set objfile tmpdir/bintest.${obj}
 320     }
 321
 322     remote_file build delete tmpdir/artest.a
 323
 324     set got [binutils_run $AR "rc $archive ${objfile}"]
 325     if ![string match "" $got] {
 326         fail $testname
 327         return
 328     }
 329
 330     remote_file build delete tmpdir/artest2.a
 331
 332     set got [binutils_run $AR "rcT $archive2 ${archive}"]
 333     if ![string match "" $got] {
 334         fail $testname
 335         return
 336     }
 337
 338     remote_file build delete tmpdir/artest3.a
 339
 340     set got [binutils_run $AR "rc --thin $archive3 ${archive}"]
 341     if ![string match "" $got] {
 342         fail $testname
 343         return
 344     }
 345
 346     foreach bfdtest $bfdtests {
 347         set exec_output [binutils_run "$base_dir/$bfdtest" "$archive"]
 348         if ![string match "" $exec_output] {
 349             verbose -log $exec_output
 350             fail "$testname ($bfdtest)"
 351             return
 352         }
 353
 354         set exec_output [binutils_run "$base_dir/$bfdtest" "$archive2"]
 355         if ![string match "" $exec_output] {
 356             verbose -log $exec_output
 357             fail "$testname ($bfdtest)"
 358             return
 359         }
 360
 361         set exec_output [binutils_run "$base_dir/$bfdtest" "$archive3"]
 362         if ![string match "" $exec_output] {
 363             verbose -log $exec_output
 364             fail "$testname ($bfdtest)"
 365             return
 366         }
 367     }
 368
 369     set got [binutils_run $NM "--print-armap $archive"]
 370     if { ![string match "*text_symbol in *bintest.${obj}*" $got] \
 371          || ![string match "*data_symbol in *bintest.${obj}*" $got] \
 372          || ![string match "*common_symbol in *bintest.${obj}*" $got] \
 373          || [string match "*static_text_symbol in *bintest.${obj}*" $got] \
 374          || [string match "*static_data_symbol in *bintest.${obj}*" $got] \
 375          || [string match "*external_symbol in *bintest.${obj}*" $got] } {
 376         fail $testname
 377         return
 378     }
 379
 380     pass $testname
 381 }
 382
 383 # Test POSIX-compatible argument parsing.
 384
 385 proc argument_parsing { } {
 386     global AR
 387     global AS
 388     global srcdir
 389     global subdir
 390     global obj
 391
 392     set testname "ar argument parsing"
 393
 394     if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
 395         unsupported $testname
 396         return
 397     }
 398
 399     if [is_remote host] {
 400         set archive artest.a
 401         set objfile [remote_download host tmpdir/bintest.${obj}]
 402         remote_file host delete $archive
 403     } else {
 404         set archive tmpdir/artest.a
 405         set objfile tmpdir/bintest.${obj}
 406     }
 407
 408     remote_file build delete tmpdir/artest.a
 409
 410     set got [binutils_run $AR "-r -c $archive ${objfile}"]
 411     if ![string match "" $got] {
 412         fail $testname
 413         return
 414     }
 415
 416     pass $testname
 417 }
 418
 419 # Test building a deterministic archive.
 420
 421 proc deterministic_archive { } {
 422     global AR
 423     global AS
 424     global NM
 425     global srcdir
 426     global subdir
 427     global obj
 428
 429     set testname "ar deterministic archive"
 430
 431     if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
 432         unsupported $testname
 433         return
 434     }
 435
 436     if [is_remote host] {
 437         set archive artest.a
 438         set objfile [remote_download host tmpdir/bintest.${obj}]
 439         remote_file host delete $archive
 440     } else {
 441         set archive tmpdir/artest.a
 442         set objfile tmpdir/bintest.${obj}
 443     }
 444
 445     remote_file build delete tmpdir/artest.a
 446
 447     set got [binutils_run $AR "rcD $archive ${objfile}"]
 448     if ![string match "" $got] {
 449         fail $testname
 450         return
 451     }
 452
 453     set got [binutils_run $AR "tv $archive"]
 454     # This only checks the file mode and uid/gid.  We can't easily match
 455     # date because it's printed with the user's timezone.
 456     if ![string match "rw-r--r-- 0/0 *bintest.${obj}*" $got] {
 457         fail $testname
 458         return
 459     }
 460
 461     set got [binutils_run $AR "tvO $archive"]
 462     if ![string match "rw-r--r-- 0/0 *bintest.${obj} 0x*" $got] {
 463         fail $testname
 464         return
 465     }
 466
 467     pass $testname
 468 }
 469
 470 proc unique_symbol { } {
 471     global AR
 472     global AS
 473     global NM
 474     global srcdir
 475     global subdir
 476     global obj
 477
 478     set testname "ar unique symbol in archive"
 479
 480     if ![binutils_assemble $srcdir/$subdir/unique.s tmpdir/unique.${obj}] {
 481         unsupported $testname
 482         return
 483     }
 484
 485     if [is_remote host] {
 486         set archive artest.a
 487         set objfile [remote_download host tmpdir/unique.${obj}]
 488         remote_file host delete $archive
 489     } else {
 490         set archive tmpdir/artest.a
 491         set objfile tmpdir/unique.${obj}
 492     }
 493
 494     remote_file build delete tmpdir/artest.a
 495
 496     set got [binutils_run $AR "-s -r -c $archive ${objfile}"]
 497     if ![string match "" $got] {
 498         fail $testname
 499         return
 500     }
 501
 502     set got [binutils_run $NM "--print-armap $archive"]
 503     if ![string match "*foo in *unique.${obj}*" $got] {
 504         fail $testname
 505         return
 506     }
 507
 508     pass $testname
 509 }
 510
 511 # Test deleting an element.
 512
 513 proc delete_an_element { } {
 514     global AR
 515     global AS
 516     global srcdir
 517     global subdir
 518     global obj
 519
 520     set testname "ar deleting an element"
 521
 522     if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
 523         unsupported $testname
 524         return
 525     }
 526
 527     if [is_remote host] {
 528         set archive artest.a
 529         set objfile [remote_download host tmpdir/bintest.${obj}]
 530         remote_file host delete $archive
 531     } else {
 532         set archive tmpdir/artest.a
 533         set objfile tmpdir/bintest.${obj}
 534     }
 535
 536     remote_file build delete tmpdir/artest.a
 537
 538     set got [binutils_run $AR "-r -c $archive ${objfile}"]
 539     if ![string match "" $got] {
 540         fail $testname
 541         return
 542     }
 543
 544     set got [binutils_run $AR "-d $archive ${objfile}"]
 545     if ![string match "" $got] {
 546         fail $testname
 547         return
 548     }
 549
 550     pass $testname
 551 }
 552
 553 # Test moving an element.
 554
 555 proc move_an_element { } {
 556     global AR
 557     global AS
 558     global srcdir
 559     global subdir
 560     global obj
 561
 562     set testname "ar moving an element"
 563
 564     if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
 565         unsupported $testname
 566         return
 567     }
 568
 569     if [is_remote host] {
 570         set archive artest.a
 571         set objfile [remote_download host tmpdir/bintest.${obj}]
 572         remote_file host delete $archive
 573     } else {
 574         set archive tmpdir/artest.a
 575         set objfile tmpdir/bintest.${obj}
 576     }
 577
 578     remote_file build delete tmpdir/artest.a
 579
 580     set got [binutils_run $AR "-r -c $archive ${objfile}"]
 581     if ![string match "" $got] {
 582         fail $testname
 583         return
 584     }
 585
 586     set got [binutils_run $AR "-m $archive ${objfile}"]
 587     if ![string match "" $got] {
 588         fail $testname
 589         return
 590     }
 591
 592     pass $testname
 593 }
 594
 595 # PR 19775: Test creating and listing archives with an empty element.
 596
 597 proc empty_archive { } {
 598     global AR
 599     global srcdir
 600     global subdir
 601
 602     set testname "archive with empty element"
 603
 604     # FIXME: There ought to be a way to dynamically create an empty file.
 605     set empty $srcdir/$subdir/empty
 606
 607     if [is_remote host] {
 608         set archive artest.a
 609         set objfile [remote_download host $empty]
 610         remote_file host delete $archive
 611     } else {
 612         set archive tmpdir/artest.a
 613         set objfile $empty
 614     }
 615
 616     remote_file build delete tmpdir/artest.a
 617
 618     set got [binutils_run $AR "-r -c $archive ${objfile}"]
 619     if ![string match "" $got] {
 620         fail $testname
 621         return
 622     }
 623
 624     # This commmand used to fail with: "Malformed archive".
 625     set got [binutils_run $AR "-t $archive"]
 626     if ![string match "empty
" $got] {
 627         fail $testname
 628         return
 629     }
 630
 631     pass $testname
 632 }
 633
 634 # Test extracting an element.
 635
 636 proc extract_an_element { } {
 637     global AR
 638     global AS
 639     global srcdir
 640     global subdir
 641     global obj
 642
 643     set testname "ar extracting an element"
 644
 645     if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
 646         unsupported $testname
 647         return
 648     }
 649
 650     set archive artest.a
 651
 652     if [is_remote host] {
 653         set objfile [remote_download host tmpdir/bintest.${obj}]
 654         remote_file host delete $archive
 655     } else {
 656         set objfile tmpdir/bintest.${obj}
 657     }
 658
 659     remote_file build delete $archive
 660
 661     set got [binutils_run $AR "-r -c $archive ${objfile}"]
 662     if ![string match "" $got] {
 663         fail $testname
 664         return
 665     }
 666
 667     set got [binutils_run $AR "--output=tmpdir -x $archive ${objfile}"]
 668     if ![string match "" $got] {
 669         fail $testname
 670         return
 671     }
 672
 673     remote_file build delete $archive
 674     remote_file build delete tmpdir/$archive
 675
 676     pass $testname
 677 }
 678
 679 proc many_files { } {
 680     global AR
 681     global AS
 682     global srcdir
 683     global subdir
 684     global obj
 685
 686     set testname "ar many files"
 687
 688     set ofiles {}
 689     set max_file 150
 690     for { set i 0 } { $i < $max_file } { incr i } {
 691         set sfile "tmpdir/d-$i.s"
 692         if [catch { set ofd [open $sfile w] } x] {
 693             perror "$x"
 694             unresolved $testname
 695             return
 696         }
 697
 698         puts $ofd " .globl data_sym$i"
 699         puts $ofd " .data"
 700         puts $ofd "data_sym$i:"
 701         puts $ofd " .long $i"
 702         close $ofd
 703
 704         set ofile "tmpdir/d-$i.${obj}"
 705         if ![binutils_assemble $sfile $ofile] {
 706             unsupported $testname
 707             return
 708         }
 709
 710         set objfile $ofile
 711         if [is_remote host] {
 712             remote_file host delete $sfile
 713             set objfile [remote_download host $ofile]
 714             remote_file build delete $ofile
 715         }
 716         remote_file build delete $sfile
 717         lappend ofiles $objfile
 718     }
 719
 720     set archive tmpdir/many.a
 721     remote_file host delete $archive
 722
 723     set got [binutils_run $AR "cr $archive $ofiles"]
 724     if ![string match "" $got] {
 725         fail $testname
 726         return
 727     }
 728
 729     remote_file host delete $archive
 730     eval remote_file host delete $ofiles
 731
 732     pass $testname
 733 }
 734
 735 proc test_add_dependencies { } {
 736     global AR
 737     global AS
 738     global srcdir
 739     global subdir
 740     global obj
 741
 742     set testname "ar adding library dependencies"
 743
 744     if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
 745         unsupported $testname
 746         return
 747     }
 748
 749     if [is_remote host] {
 750         set archive artest.a
 751         set objfile [remote_download host tmpdir/bintest.${obj}]
 752         remote_file host delete $archive
 753     } else {
 754         set archive tmpdir/artest.a
 755         set objfile tmpdir/bintest.${obj}
 756     }
 757
 758     remote_file build delete tmpdir/artest.a
 759
 760     set got [binutils_run $AR "-r -c $archive --record-libdeps /foo/bar ${objfile}"]
 761     if ![string match "" $got] {
 762         fail $testname
 763         return
 764     }
 765
 766     set got [binutils_run $AR "-t $archive"]
 767     if ![string match "*bintest.${obj}
__.LIBDEP*" $got] {
 768         fail $testname
 769         return
 770     }
 771
 772     pass $testname
 773 }
 774
 775 # Run the tests.
 776
 777 # Only run the bfdtest checks if the programs exist.  Since these
 778 # programs are built but not installed, running the testsuite on an
 779 # installed toolchain will produce ERRORs about missing bfdtest1 and
 780 # bfdtest2 executables.
 781 if { [file exists $base_dir/bfdtest1] && [file exists $base_dir/bfdtest2] } {
 782     set bfdtests [list bfdtest1 bfdtest2]
 783
 784     long_filenames $bfdtests
 785
 786     # xcoff, ecoff, and vms archive support doesn't handle thin archives
 787     if { ![is_xcoff_format]
 788          && ![istarget "*-*-*ecoff"]
 789          && ![istarget "*-*-vms"] } {
 790         thin_archive $bfdtests
 791         thin_archive_with_nested $bfdtests
 792     }
 793 }
 794
 795 symbol_table
 796 argument_parsing
 797 deterministic_archive
 798 delete_an_element
 799 move_an_element
 800 empty_archive
 801 extract_an_element
 802 many_files
 803 test_add_dependencies
 804
 805 if { [is_elf_format] && [supports_gnu_unique] } {
 806     unique_symbol
 807 }