1#   Copyright 1995, 1997, 2002, 2004 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 2 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
29# send_user "Version [binutil_version $AR]"
30
31# Test long file name support
32
33proc long_filenames { } {
34    global AR
35    global host_triplet
36
37    set testname "ar long file names"
38
39    set n1 "abcdefghijklmnopqrstuvwxyz1"
40    set n2 "abcdefghijklmnopqrstuvwxyz2"
41    set file1 tmpdir/$n1
42    set file2 tmpdir/$n2
43
44    remote_file build delete $file1
45
46    # Some file systems truncate file names at 14 characters, which
47    # makes it impossible to run this test.  Check for that now.
48    set status [catch "set f [open tmpdir/$n1 w]" errs]
49    if { $status != 0 } {
50	verbose -log "open tmpdir/$n1 returned $errs"
51	unsupported $testname
52	return
53    }
54    puts $f "first"
55    close $f
56
57
58    remote_file build delete $file2
59
60    set status [catch "set f [open tmpdir/$n2 w]" errs]
61    if { $status != 0 } {
62	verbose -log "open tmpdir/$n2 returned $errs"
63	unsupported $testname
64	return
65    }
66    puts $f "second"
67    close $f
68
69    if [is_remote host] {
70	set file1 [remote_download host $file1]
71	set file2 [remote_download host $file2]
72	set dest artest.a
73    } else {
74	set dest tmpdir/artest.a
75    }
76
77    remote_file host delete $dest
78
79    set got [binutils_run $AR "rc $dest $file1 $file2"]
80    if [is_remote host] {
81	remote_upload host $file1 tmpdir/$n1
82    }
83
84    set f [open tmpdir/$n1 r]
85    gets $f string
86    close $f
87    if ![string match "first" $string] {
88	verbose -log "reading tmpdir/$n1 returned $string"
89	unsupported $testname
90	return
91    }
92
93    remote_file host delete $dest
94    set got [binutils_run $AR "rc $dest $file1 $file2"]
95
96    if ![string match "" $got] {
97	fail $testname
98	return
99    }
100
101    remote_file build delete tmpdir/$n1
102    remote_file build delete tmpdir/$n2
103
104    set got [binutils_run $AR "t $dest"]
105    regsub "\[\r\n \t\]*$" "$got" "" got
106    if ![string match "$n1*$n2" $got] {
107	fail $testname
108	return
109    }
110
111    if [is_remote host] {
112	remote_file host delete $file1
113	remote_file host delete $file2
114    }
115
116    verbose -log "$AR x $dest"
117    set exec_output [binutils_run $AR "x $dest"]
118    set exec_output [prune_warnings $exec_output]
119    if ![string match "" $exec_output] {
120	verbose -log $exec_output
121	fail $testname
122	return
123    }
124
125    if [is_remote host] {
126	remote_upload host $n1 tmpdir/$n1
127	remote_upload host $n2 tmpdir/$n2
128	set file1 tmpdir/$n1
129	set file2 tmpdir/$n2
130    } else {
131	set file1 $n1
132	set file2 $n2
133    }
134
135    if ![file exists $file1] {
136	verbose -log "$file1 does not exist"
137	fail $testname
138	return
139    }
140    if ![file exists $file2] {
141	verbose -log "$file2 does not exist"
142	fail $testname
143	return
144    }
145
146    set f [open $file1 r]
147    if { [gets $f line] == -1 || $line != "first" } {
148	verbose -log "$file1 contents:"
149	verbose -log "$line"
150	close $f
151	fail $testname
152	return
153    }
154    close $f
155
156    set f [open $file2 r]
157    if { [gets $f line] == -1 || $line != "second" } {
158	verbose -log "$file2 contents:"
159	verbose -log "$line"
160	close $f
161	fail $testname
162	return
163    }
164    close $f
165
166    file delete $file1 $file2
167    pass $testname
168}
169
170# Test building the symbol table.
171
172proc symbol_table { } {
173    global AR
174    global AS
175    global NM
176    global srcdir
177    global subdir
178
179    set testname "ar symbol table"
180
181    if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.o] {
182	unresolved $testname
183	return
184    }
185
186    if [is_remote host] {
187	set archive artest.a
188	set objfile [remote_download host tmpdir/bintest.o]
189	remote_file host delete $archive
190    } else {
191	set archive tmpdir/artest.a
192	set objfile tmpdir/bintest.o
193    }
194
195    remote_file build delete tmpdir/artest.a
196
197    set got [binutils_run $AR "rc $archive ${objfile}"]
198    if ![string match "" $got] {
199	fail $testname
200	return
201    }
202
203    set got [binutils_run $NM "--print-armap $archive"]
204    if { ![string match "*text_symbol in bintest.o*" $got] \
205	 || ![string match "*data_symbol in bintest.o*" $got] \
206	 || ![string match "*common_symbol in bintest.o*" $got] \
207	 || [string match "*static_text_symbol in bintest.o*" $got] \
208	 || [string match "*static_data_symbol in bintest.o*" $got] \
209	 || [string match "*external_symbol in bintest.o*" $got] } {
210	fail $testname
211	return
212    }
213
214    pass $testname
215}
216
217# Test POSIX-compatible argument parsing.
218
219proc argument_parsing { } {
220    global AR
221    global AS
222    global srcdir
223    global subdir
224
225    set testname "ar argument parsing"
226
227    if ![binutils_assemble $srcdir/$subdir/bintest.s tmpdir/bintest.o] {
228	unresolved $testname
229	return
230    }
231
232    if [is_remote host] {
233	set archive artest.a
234	set objfile [remote_download host tmpdir/bintest.o]
235	remote_file host delete $archive
236    } else {
237	set archive tmpdir/artest.a
238	set objfile tmpdir/bintest.o
239    }
240
241    remote_file build delete tmpdir/artest.a
242
243    set got [binutils_run $AR "-r -c $archive ${objfile}"]
244    if ![string match "" $got] {
245	fail $testname
246	return
247    }
248
249    pass $testname
250}
251
252# Run the tests.
253
254long_filenames
255symbol_table
256argument_parsing
257