1#   Copyright (C) 1995-2016 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
22if ![is_remote host] {
23    if {[which $AR] == 0} then {
24        perror "$AR does not exist"
25        return
26    }
27}
28
29if { [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
37proc 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
186proc 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
233proc 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
290proc 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
364proc 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
399proc 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    pass $testname
439}
440
441proc unique_symbol { } {
442    global AR
443    global AS
444    global NM
445    global srcdir
446    global subdir
447
448    set testname "ar unique symbol in archive"
449
450    if ![binutils_assemble $srcdir/$subdir/unique.s tmpdir/unique.o] {
451	unresolved $testname
452    }
453
454    if [is_remote host] {
455	set archive artest.a
456	set objfile [remote_download host tmpdir/unique.o]
457	remote_file host delete $archive
458    } else {
459	set archive tmpdir/artest.a
460	set objfile tmpdir/unique.o
461    }
462
463    remote_file build delete tmpdir/artest.a
464
465    set got [binutils_run $AR "-s -r -c $archive ${objfile}"]
466    if ![string match "" $got] {
467	fail $testname
468	return
469    }
470
471    set got [binutils_run $NM "--print-armap $archive"]
472    if ![string match "*foo in *unique.o*" $got] {
473	fail $testname
474	return
475    }
476
477    pass $testname
478}
479
480# Test deleting an element.
481
482proc delete_an_element { } {
483    global AR
484    global AS
485    global srcdir
486    global subdir
487
488    set testname "ar deleting an element"
489
490    if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.o] {
491	unresolved $testname
492	return
493    }
494
495    if [is_remote host] {
496	set archive artest.a
497	set objfile [remote_download host tmpdir/bintest.o]
498	remote_file host delete $archive
499    } else {
500	set archive tmpdir/artest.a
501	set objfile tmpdir/bintest.o
502    }
503
504    remote_file build delete tmpdir/artest.a
505
506    set got [binutils_run $AR "-r -c $archive ${objfile}"]
507    if ![string match "" $got] {
508	fail $testname
509	return
510    }
511
512    set got [binutils_run $AR "-d $archive ${objfile}"]
513    if ![string match "" $got] {
514	fail $testname
515	return
516    }
517
518    pass $testname
519}
520
521# Test moving an element.
522
523proc move_an_element { } {
524    global AR
525    global AS
526    global srcdir
527    global subdir
528
529    set testname "ar moving an element"
530
531    if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.o] {
532	unresolved $testname
533	return
534    }
535
536    if [is_remote host] {
537	set archive artest.a
538	set objfile [remote_download host tmpdir/bintest.o]
539	remote_file host delete $archive
540    } else {
541	set archive tmpdir/artest.a
542	set objfile tmpdir/bintest.o
543    }
544
545    remote_file build delete tmpdir/artest.a
546
547    set got [binutils_run $AR "-r -c $archive ${objfile}"]
548    if ![string match "" $got] {
549	fail $testname
550	return
551    }
552
553    set got [binutils_run $AR "-m $archive ${objfile}"]
554    if ![string match "" $got] {
555	fail $testname
556	return
557    }
558
559    pass $testname
560}
561
562# PR 19775: Test creating and listing archives with an empty element.
563
564proc empty_archive { } {
565    global AR
566    global srcdir
567    global subdir
568
569    set testname "archive with empty element"
570
571    # FIXME: There ought to be a way to dynamically create an empty file.
572    set empty $srcdir/$subdir/empty
573
574    if [is_remote host] {
575	set archive artest.a
576	set objfile [remote_download host $empty]
577	remote_file host delete $archive
578    } else {
579	set archive tmpdir/artest.a
580	set objfile $empty
581    }
582
583    remote_file build delete tmpdir/artest.a
584
585    set got [binutils_run $AR "-r -c $archive ${objfile}"]
586    if ![string match "" $got] {
587	fail $testname
588	return
589    }
590
591    # This commmand used to fail with: "Malformed archive".
592    set got [binutils_run $AR "-t $archive"]
593    if ![string match "empty
594" $got] {
595	fail $testname
596	return
597    }
598
599    pass $testname
600}
601
602# Run the tests.
603
604# Only run the bfdtest checks if the programs exist.  Since these
605# programs are built but not installed, running the testsuite on an
606# installed toolchain will produce ERRORs about missing bfdtest1 and
607# bfdtest2 executables.
608if { ![istarget "tic30-*-*"] && [file exists $base_dir/bfdtest1] && [file exists $base_dir/bfdtest2] } {
609    set bfdtests [list bfdtest1 bfdtest2]
610
611    long_filenames $bfdtests
612    thin_archive $bfdtests
613    thin_archive_with_nested $bfdtests
614}
615
616symbol_table
617argument_parsing
618deterministic_archive
619delete_an_element
620move_an_element
621empty_archive
622
623if { [is_elf_format] && [supports_gnu_unique] } {
624    unique_symbol
625}
626