1 # Copyright (C) 1995-2024 Free Software Foundation, Inc.
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.
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.
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.
17 # Please email any bugs, comments, and/or additions to this file to:
18 # bug-dejagnu@prep.ai.mit.edu
20 # Written by Ian Lance Taylor <ian@cygnus.com>
22 if ![is_remote host] {
23 if {[which $AR] == 0} then {
24 perror "$AR does not exist"
30 if { [istarget "*-*-vms"] } then {
34 # send_user "Version [binutil_version $AR]"
36 # Test long file name support
38 proc long_filenames { bfdtests } {
43 set testname "ar long file names"
45 set n1 "abcdefghijklmnopqrstuvwxyz1"
46 set n2 "abcdefghijklmnopqrstuvwxyz2"
50 remote_file build delete $file1
51 remote_file host delete $n1
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]
57 verbose -log "open tmpdir/$n1 returned $errs"
64 remote_file build delete $file2
65 remote_file host delete $n2
67 set status [catch "set f [open tmpdir/$n2 w]" errs]
69 verbose -log "open tmpdir/$n2 returned $errs"
77 set file1 [remote_download host $file1]
78 set file2 [remote_download host $file2]
81 set dest tmpdir/artest.a
84 remote_file host delete $dest
86 set got [binutils_run $AR "rc $dest $file1 $file2"]
88 remote_upload host $file1 tmpdir/$n1
91 set f [open tmpdir/$n1 r]
94 if ![string match "first" $string] {
95 verbose -log "reading tmpdir/$n1 returned $string"
100 remote_file host delete $dest
101 set got [binutils_run $AR "rc $dest $file1 $file2"]
103 if ![string match "" $got] {
108 remote_file build delete tmpdir/$n1
109 remote_file build delete tmpdir/$n2
111 set got [binutils_run $AR "t $dest"]
112 regsub "\[\r\n \t\]*$" "$got" "" got
113 if ![string match "$n1*$n2" $got] {
118 if [is_remote host] {
119 remote_file host delete $file1
120 remote_file host delete $file2
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
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)"
140 if [is_remote host] {
141 remote_upload host $n1 tmpdir/$n1
142 remote_upload host $n2 tmpdir/$n2
150 if ![file exists $file1] {
151 verbose -log "$file1 does not exist"
155 if ![file exists $file2] {
156 verbose -log "$file2 does not exist"
161 set f [open $file1 r]
162 if { [gets $f line] == -1 || $line != "first" } {
163 verbose -log "$file1 contents:"
171 set f [open $file2 r]
172 if { [gets $f line] == -1 || $line != "second" } {
173 verbose -log "$file2 contents:"
181 file delete $file1 $file2
185 # Test building the symbol table.
187 proc symbol_table { } {
195 set testname "ar symbol table"
197 if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
198 unsupported $testname
202 if [is_remote host] {
204 set objfile [remote_download host tmpdir/bintest.${obj}]
205 remote_file host delete $archive
207 set archive tmpdir/artest.a
208 set objfile tmpdir/bintest.${obj}
211 remote_file build delete tmpdir/artest.a
213 set got [binutils_run $AR "rc $archive ${objfile}"]
214 if ![string match "" $got] {
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] } {
233 # Test building a thin archive.
235 proc thin_archive { bfdtests } {
244 set testname "ar thin archive"
246 if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
247 unsupported $testname
251 if [is_remote host] {
253 set objfile [remote_download host tmpdir/bintest.${obj}]
254 remote_file host delete $archive
256 set archive tmpdir/artest.a
257 set objfile tmpdir/bintest.${obj}
260 remote_file build delete tmpdir/artest.a
262 set got [binutils_run $AR "rcT $archive ${objfile}"]
263 if ![string match "" $got] {
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)"
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] } {
291 # Test building a thin archive with a nested archive.
293 proc thin_archive_with_nested { bfdtests } {
302 set testname "ar thin archive with nested archive"
304 if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
305 unsupported $testname
309 if [is_remote host] {
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
316 set archive tmpdir/artest.a
317 set archive2 tmpdir/artest2.a
318 set archive3 tmpdir/artest3.a
319 set objfile tmpdir/bintest.${obj}
322 remote_file build delete tmpdir/artest.a
324 set got [binutils_run $AR "rc $archive ${objfile}"]
325 if ![string match "" $got] {
330 remote_file build delete tmpdir/artest2.a
332 set got [binutils_run $AR "rcT $archive2 ${archive}"]
333 if ![string match "" $got] {
338 remote_file build delete tmpdir/artest3.a
340 set got [binutils_run $AR "rc --thin $archive3 ${archive}"]
341 if ![string match "" $got] {
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)"
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)"
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)"
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] } {
383 # Test POSIX-compatible argument parsing.
385 proc argument_parsing { } {
392 set testname "ar argument parsing"
394 if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
395 unsupported $testname
399 if [is_remote host] {
401 set objfile [remote_download host tmpdir/bintest.${obj}]
402 remote_file host delete $archive
404 set archive tmpdir/artest.a
405 set objfile tmpdir/bintest.${obj}
408 remote_file build delete tmpdir/artest.a
410 set got [binutils_run $AR "-r -c $archive ${objfile}"]
411 if ![string match "" $got] {
419 # Test building a deterministic archive.
421 proc deterministic_archive { } {
429 set testname "ar deterministic archive"
431 if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
432 unsupported $testname
436 if [is_remote host] {
438 set objfile [remote_download host tmpdir/bintest.${obj}]
439 remote_file host delete $archive
441 set archive tmpdir/artest.a
442 set objfile tmpdir/bintest.${obj}
445 remote_file build delete tmpdir/artest.a
447 set got [binutils_run $AR "rcD $archive ${objfile}"]
448 if ![string match "" $got] {
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] {
461 set got [binutils_run $AR "tvO $archive"]
462 if ![string match "rw-r--r-- 0/0 *bintest.${obj} 0x*" $got] {
470 # Test replacing a member of a deterministic archive.
472 proc replacing_deterministic_member { } {
480 set testname "replacing deterministic member"
482 if [is_remote host] {
483 # The kind of filename trickery that we are about to
484 # play is hard to do if we have to operate remotely.
485 unsupported $testname
491 if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
492 unsupported $testname
496 # Wait a second and then build a second object file - with the same name
497 # as the first, but in a different directory.
499 if ![binutils_assemble $srcdir/$subdir/copytest.s tmpdir/ar/bintest.${obj}] {
500 unsupported $testname
504 set archive tmpdir/artest.a
505 set older_objfile tmpdir/bintest.${obj}
506 set newer_objfile tmpdir/ar/bintest.${obj}
507 set older_length [file size $older_objfile]
508 # set newer_length [file size $newer_objfile]
510 remote_file build delete tmpdir/artest.a
512 # Build the archive with the *newer* object file.
514 set got [binutils_run $AR "rcD $archive ${newer_objfile}"]
515 if ![string match "" $got] {
516 fail "$testname: (could not build archive)"
520 # Now replace the newer file with the older one. On a normal
521 # archive this will not work, but one created to be deterministic
522 # should always replace its members.
524 set got [binutils_run $AR "ruD $archive $older_objfile"]
525 # The archiver will warn that 'u' and 'D' do not work together
526 if ![string match "*not meaningful*" $got] {
527 fail "$testname: (failed to replace file)"
531 set got [binutils_run $AR "tvO $archive"]
532 if ![string match "rw-r--r-- 0/0 *${older_length} *bintest.${obj} 0x*" $got] {
533 fail "$testname (wrong size, expected: $older_length)"
540 # Test replacing a member of a non-deterministic archive.
541 # This test expects SOURCE_DATE_EPOCH to not be set in the environment.
543 proc replacing_non_deterministic_member { } {
551 set testname "replacing non-deterministic member"
553 if [is_remote host] {
554 # The kind of filename trickery that we are about to
555 # play is hard to do if we have to operate remotely.
556 unsupported $testname
562 if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
563 unsupported $testname
567 # Wait a second and then build a second object file - with the same name
568 # as the first, but in a different directory.
570 if ![binutils_assemble $srcdir/$subdir/copytest.s tmpdir/ar/bintest.${obj}] {
571 unsupported $testname
575 set archive tmpdir/artest.a
576 set older_objfile tmpdir/bintest.${obj}
577 set newer_objfile tmpdir/ar/bintest.${obj}
578 # set older_length [file size $older_objfile]
579 set newer_length [file size $newer_objfile]
581 remote_file build delete tmpdir/artest.a
583 # Build the archive with the *newer* object file.
585 set got [binutils_run $AR "rcU $archive ${newer_objfile}"]
586 if ![string match "" $got] {
587 fail "$testname: (could not build archive)"
591 # Now try to replace the newer file with the older one. This should not work.
593 set got [binutils_run $AR "ruU $archive $older_objfile"]
594 if ![string match "" $got] {
595 fail "$testname: (failed to replace file)"
599 # Since this archive is non-deterministic, we do not know what the
600 # user or group ids will be, so we have to use */* to match them.
601 set got [binutils_run $AR "tvO $archive"]
602 if ![string match "\[rw-\]* */* *${newer_length} *bintest.${obj} 0x*" $got] {
603 fail "$testname (wrong size, expected: $newer_length)"
610 # Test replacing a member of deterministic archive created by using SOURCE_DATE_EPOCH.
612 proc replacing_sde_deterministic_member { } {
620 set testname "replacing SOURCE_DATE_EPOCH deterministic member"
622 if [is_remote host] {
623 # The kind of filename trickery that we are about to
624 # play is hard to do if we have to operate remotely.
625 unsupported $testname
631 if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
632 unsupported $testname
636 # Wait a second and then build a second object file - with the same name
637 # as the first, but in a different directory.
639 if ![binutils_assemble $srcdir/$subdir/copytest.s tmpdir/ar/bintest.${obj}] {
640 unsupported $testname
644 set archive tmpdir/artest.a
645 set older_objfile tmpdir/bintest.${obj}
646 set newer_objfile tmpdir/ar/bintest.${obj}
647 set older_length [file size $older_objfile]
648 # set newer_length [file size $newer_objfile]
650 remote_file build delete tmpdir/artest.a
652 # Build the archive with the *newer* object file.
653 setenv SOURCE_DATE_EPOCH "1000"
655 set got [binutils_run $AR "rcU $archive ${newer_objfile}"]
656 if ![string match "" $got] {
657 fail "$testname: (could not build archive)"
658 unsetenv SOURCE_DATE_EPOCH
662 # Now replace the newer file with the older one. On a normal
663 # archive this will not work, but one created to be deterministic
664 # should always replace its members.
666 set got [binutils_run $AR "ruU $archive $older_objfile"]
667 if ![string match "" $got] {
668 fail "$testname: (failed to replace file)"
669 unsetenv SOURCE_DATE_EPOCH
673 # Since this archive has fixed source dates, but non-deterministic
674 # uid and gid values we have to use */* to match them.
675 set got [binutils_run $AR "tvO $archive"]
676 if ![string match "\[rw-\]* */* *${older_length} *bintest.${obj} 0x*" $got] {
677 fail "$testname (wrong size, expected: $older_length)"
678 unsetenv SOURCE_DATE_EPOCH
682 # FIXME - it would be nice if we could check to see that the time & date
683 # in the archive listing matches SOURCE_DATE_EPOCH.
685 unsetenv SOURCE_DATE_EPOCH
690 proc unique_symbol { } {
698 set testname "ar unique symbol in archive"
700 if ![binutils_assemble $srcdir/$subdir/unique.s tmpdir/unique.${obj}] {
701 unsupported $testname
705 if [is_remote host] {
707 set objfile [remote_download host tmpdir/unique.${obj}]
708 remote_file host delete $archive
710 set archive tmpdir/artest.a
711 set objfile tmpdir/unique.${obj}
714 remote_file build delete tmpdir/artest.a
716 set got [binutils_run $AR "-s -r -c $archive ${objfile}"]
717 if ![string match "" $got] {
722 set got [binutils_run $NM "--print-armap $archive"]
723 if ![string match "*foo in *unique.${obj}*" $got] {
731 # Test deleting an element.
733 proc delete_an_element { } {
740 set testname "ar deleting an element"
742 if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
743 unsupported $testname
747 if [is_remote host] {
749 set objfile [remote_download host tmpdir/bintest.${obj}]
750 remote_file host delete $archive
752 set archive tmpdir/artest.a
753 set objfile tmpdir/bintest.${obj}
756 remote_file build delete tmpdir/artest.a
758 set got [binutils_run $AR "-r -c $archive ${objfile}"]
759 if ![string match "" $got] {
764 set got [binutils_run $AR "-d $archive ${objfile}"]
765 if ![string match "" $got] {
773 # Test moving an element.
775 proc move_an_element { } {
782 set testname "ar moving an element"
784 if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
785 unsupported $testname
789 if [is_remote host] {
791 set objfile [remote_download host tmpdir/bintest.${obj}]
792 remote_file host delete $archive
794 set archive tmpdir/artest.a
795 set objfile tmpdir/bintest.${obj}
798 remote_file build delete tmpdir/artest.a
800 set got [binutils_run $AR "-r -c $archive ${objfile}"]
801 if ![string match "" $got] {
806 set got [binutils_run $AR "-m $archive ${objfile}"]
807 if ![string match "" $got] {
815 # PR 19775: Test creating and listing archives with an empty element.
817 proc empty_archive { } {
822 set testname "archive with empty element"
824 # FIXME: There ought to be a way to dynamically create an empty file.
825 set empty $srcdir/$subdir/empty
827 if [is_remote host] {
829 set objfile [remote_download host $empty]
830 remote_file host delete $archive
832 set archive tmpdir/artest.a
836 remote_file build delete tmpdir/artest.a
838 set got [binutils_run $AR "-r -c $archive ${objfile}"]
839 if ![string match "" $got] {
844 # This commmand used to fail with: "Malformed archive".
845 set got [binutils_run $AR "-t $archive"]
846 if ![string match "empty
855 # Test extracting an element.
857 proc extract_an_element { } {
864 set testname "ar extracting an element"
866 if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
867 unsupported $testname
873 if [is_remote host] {
874 set objfile [remote_download host tmpdir/bintest.${obj}]
875 remote_file host delete $archive
877 set objfile tmpdir/bintest.${obj}
880 remote_file build delete $archive
882 set got [binutils_run $AR "-r -c $archive ${objfile}"]
883 if ![string match "" $got] {
888 set got [binutils_run $AR "--output=tmpdir -x $archive ${objfile}"]
889 if ![string match "" $got] {
894 remote_file build delete $archive
895 remote_file build delete tmpdir/$archive
900 proc many_files { } {
907 set testname "ar many files"
911 for { set i 0 } { $i < $max_file } { incr i } {
912 set sfile "tmpdir/d-$i.s"
913 if [catch { set ofd [open $sfile w] } x] {
919 puts $ofd " .globl data_sym$i"
921 puts $ofd "data_sym$i:"
922 puts $ofd " .long $i"
925 set ofile "tmpdir/d-$i.${obj}"
926 if ![binutils_assemble $sfile $ofile] {
927 unsupported $testname
932 if [is_remote host] {
933 remote_file host delete $sfile
934 set objfile [remote_download host $ofile]
935 remote_file build delete $ofile
937 remote_file build delete $sfile
938 lappend ofiles $objfile
941 set archive tmpdir/many.a
942 remote_file host delete $archive
944 set got [binutils_run $AR "cr $archive $ofiles"]
945 if ![string match "" $got] {
950 remote_file host delete $archive
951 eval remote_file host delete $ofiles
956 proc test_add_dependencies { } {
963 set testname "ar adding library dependencies"
965 if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.${obj}] {
966 unsupported $testname
970 if [is_remote host] {
972 set objfile [remote_download host tmpdir/bintest.${obj}]
973 remote_file host delete $archive
975 set archive tmpdir/artest.a
976 set objfile tmpdir/bintest.${obj}
979 remote_file build delete tmpdir/artest.a
981 set got [binutils_run $AR "-r -c $archive --record-libdeps /foo/bar ${objfile}"]
982 if ![string match "" $got] {
987 set got [binutils_run $AR "-t $archive"]
988 if ![string match "*bintest.${obj}
999 # Only run the bfdtest checks if the programs exist. Since these
1000 # programs are built but not installed, running the testsuite on an
1001 # installed toolchain will produce ERRORs about missing bfdtest1 and
1002 # bfdtest2 executables.
1003 if { [file exists $base_dir/bfdtest1] && [file exists $base_dir/bfdtest2] } {
1004 set bfdtests [list bfdtest1 bfdtest2]
1006 long_filenames $bfdtests
1008 # xcoff, ecoff, and vms archive support doesn't handle thin archives
1009 if { ![is_xcoff_format]
1010 && ![istarget "*-*-*ecoff"]
1011 && ![istarget "*-*-vms"] } {
1012 thin_archive $bfdtests
1013 thin_archive_with_nested $bfdtests
1019 deterministic_archive
1020 replacing_deterministic_member
1021 replacing_non_deterministic_member
1022 replacing_sde_deterministic_member
1028 test_add_dependencies
1030 if { [is_elf_format] && [supports_gnu_unique] } {