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