daily update
[external/binutils.git] / gas / testsuite / gas / sh / arch / arch.exp
1 # Copyright (C) 2004, 2005, 2007
2 # Free Software Foundation, Inc.
3
4 # This program is free software; you can redistribute it and/or modify
5 # it under the terms of the GNU General Public License as published by
6 # the Free Software Foundation; either version 3 of the License, or
7 # (at your option) any later version.
8
9 # This program is distributed in the hope that it will be useful,
10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12 # GNU General Public License for more details.
13
14 # You should have received a copy of the GNU General Public License
15 # along with this program; if not, write to the Free Software
16 # Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.  
17
18 # Please email any bugs, comments, and/or additions to this file to:
19 # binutils@sources.redhat.com
20
21 # This scripts tests all available SH architectures with all the assembler
22 # options related to the architecture. It ensures that those combinations
23 # which should not work do not work, and that those that should work
24 # produce the correct output architecture.
25 #
26 # It looks for files in the same directory as this file named sh*.s .
27 # Each file must contain all the instructions available within
28 # that architecture. The architecture name is inferred from the file name.
29 #
30 # The sh*.s files should NOT be hand edited. Whenever the script is run
31 # (e.g. with 'make check') it creates a set of new (usually identical) files
32 # in the <objdir>/gas/testsuite directory. These are compared against the
33 # old ones in the testsuite. When the expected results change (or new
34 # architectures are added) these new files can be used to replace the old
35 # ones with no modification required.
36 #
37 # The script generates the architecture/option permutations automatically,
38 # but it reads the expected results from the file arch_expected.txt (also
39 # found in the same directory as this script).
40 #
41 # The arch_expected.txt file should NOT be hand edited. Whenever the script
42 # is run (e.g. with 'make check') it creates a new (usually identical) file
43 # named arch_results.txt in the <objdir>/gas/testsuite directory. When the
44 # expected results change (or new architectures are added) this new file
45 # can be used to replace arch_expected.txt with no modification required.
46
47 if {[istarget sh*-*-*]} then {
48
49
50 # This procedure extracts the architecture name from the objdump output.
51 # If there is no architecture name (or objdump output changes significantly)
52 # then the behaviour is undefined, but it will most likely return junk.
53
54 proc get_sh_arch { ofile } {
55     global comp_output
56
57     objdump "-f $ofile"
58     send_log $comp_output
59
60     set comp_output [string replace $comp_output 0 \
61             [expr [string first "architecture:" $comp_output] + 13] ""]
62
63     return [string range $comp_output 0 [expr [string first "," $comp_output] - 1]]
64 }
65
66
67 # This procedure runs two tests:
68 #   Test 1: Check the assembler can assemble the given file with
69 #           given options.
70 #   Test 2: Check that the resultant architecture is as expected.
71 # It also writes an entry to the arch_results.txt file.
72
73 proc test_arch { file opt arch resultfile } {
74     global comp_output
75
76     set name [file tail $file]
77     set rootname [file rootname $name]
78
79     if [string equal $opt "default-options"] then {
80         gas_run $name "-o ${rootname}-#${opt}#.o" ""
81     } else {
82         gas_run $name "$opt -o ${rootname}-#${opt}#.o" ""
83     }
84
85     if [want_no_output "$rootname file should assemble with $opt"] then {
86         set result [get_sh_arch "${rootname}-#${opt}#.o"]
87         puts $resultfile [format "%-20s %-25s %s" $file $opt $result]
88
89         if {$result == $arch} then {
90             pass "$rootname file with $opt should assemble to arch $arch"
91             file delete "${rootname}-#${opt}#.o"
92         } else {
93             send_log $comp_output
94             fail "$rootname file with $opt should assemble to arch $arch"
95         }
96     } else {
97         puts $resultfile [format "%-20s %-25s ERROR" $file $opt]
98         untested "$rootname file with $opt should assemble to arch $arch"
99     }
100
101 }
102
103
104 # This procedure tests that a file that is not suposed to assemble
105 # with a given option does, in fact, not assemble.
106 # It also writes an entry to the arch_results.txt file.
107
108 proc test_arch_error { file opt resultfile} {
109     global comp_output
110
111     set name [file tail $file]
112     set rootname [file rootname $name]
113
114     if [string equal $opt "default-options"] then {
115         gas_run $name "-o ${rootname}-#${opt}#.o" ""
116     } else {
117         gas_run $name "$opt -o ${rootname}-#${opt}#.o" ""
118     }
119
120     if [string match "" $comp_output] then {
121         fail "$rootname file with $opt should not assemble"
122         puts $resultfile [format "%-20s %-25s [get_sh_arch ${rootname}-#${opt}#.o]" $file $opt]
123     } else {
124         pass "$rootname file with $opt should not assemble"
125         puts $resultfile [format "%-20s %-25s ERROR" $file $opt]
126     }
127 }   
128
129 # These tests are not suitable for sh-coff because
130 # coff does not store the architecture information.
131
132 if [istarget sh*-*-elf] then {
133     global subdir srcdir
134
135     # Find all the architectures and generate the
136     # list of options we will test.
137
138     set filelist [lsort -ascii [glob "$srcdir/$subdir/sh*.s"]]
139     set optlist {"default-options" "-dsp" "-isa=any" "-isa=dsp" "-isa=fp"}
140     foreach file $filelist {
141         set arch [file rootname [file tail $file]]
142         lappend optlist "-isa=$arch" "-isa=${arch}-up"
143     }
144
145     # Initialise the results file
146
147     set outfile [open "arch_results.txt" w 0666]
148     puts $outfile "# Generated file. DO NOT EDIT"
149     puts $outfile "#"
150     puts $outfile "# This file is generated by gas/testsuite/gas/sh/arch/arch.exp ."
151     puts $outfile "# It contains the expected results of the tests."
152     puts $outfile "# If the tests are failing because the expected results"
153     puts $outfile "# have changed then run 'make check' and copy the new file"
154     puts $outfile "# from <objdir>/gas/testsuite/arch_results.txt"
155     puts $outfile "# to   <srcdir>/gas/testsuite/gas/sh/arch/arch_expected.txt ."
156     puts $outfile "# Make sure the new expected results are ALL correct."
157     puts $outfile "#"
158     puts $outfile [format "# %-18s %-25s %s" "FILE" "OPTION" "OUTPUT"]
159     puts $outfile [format "# %-18s %-25s %s" "----" "------" "------"]
160
161     # Open the expected results file and skip the header
162
163     set infile [open "$srcdir/$subdir/arch_expected.txt" r]
164     while {[gets $infile line] >= 0 && [string match {\#*} $line]} {send_log "reading '$line'\n"}
165
166     foreach file $filelist {
167         foreach opt $optlist {
168             set name [file tail $file]
169             set rootname [file rootname $name]
170
171             # Decode the expected result from the file
172
173             scan $line "%s %s %s" exfile exopt exarch
174             send_log "exfile = '$exfile', exopt = '$exopt', exarch = '$exarch'\n"
175             send_log "  name = '$name',   opt = '$opt'\n"
176
177             if {[string equal $exfile $name] && [string equal $exopt $opt]} then {
178                 # The expected result file makes sense and
179                 # appears up-to-date (the file and options match)
180
181                 if {[string equal $exarch "ERROR"]} then {
182                     test_arch_error $name $opt $outfile
183                 } else {
184                     test_arch $name $opt $exarch $outfile
185                 }
186             } else {
187                 # The expected result file isn't right somehow
188                 # so just try any old test. This will cause
189                 # many failures, but will generate the results file.
190
191                 test_arch $name $opt $rootname $outfile
192             }
193
194             # Read the next line from the expected result file.
195             # This is at the end because the process of skipping
196             # the header reads the first real line
197
198             if [gets $infile line] then {
199                 send_log "reading '$line'\n"
200             }
201         }
202     }
203
204     close $infile
205     close $outfile
206 }
207
208
209 #########################################################################
210 # Generate one sh*.s file for each architecture defined in sh-opc.h
211 # This will contain all the instructions valid on that platform
212 #
213 # This code produces pass or fail reports for each instruction
214 # in order to ensure that problems are visible to the developer,
215 # rather than just warnings hidden in the log file.
216
217 # These variables will contains the architecture
218 # and instruction data extracted from sh-opc.h
219 array set arches {}
220 set archcount 0
221 array set insns {}
222 set insncount 0
223
224 # Pull the architecture inheritance macros out of sh-opc.h
225 # Pull all the insns out of the sh-opc.h file.
226 send_log "Reading sh-opc.h\n"
227 send_log "--------------------------------------------------------\n"
228 spawn -noecho cat "$srcdir/../../opcodes/sh-opc.h"   ;# -open doesn't seem to be reliable
229 expect {
230     -re {#define\s+arch_([^ ]*)_up\s*\(([^)]*)\)} {
231         set arches($archcount) [string map {_ -} $expect_out(1,string)]
232         set arches($archcount,descendents) [string map {_ -} $expect_out(2,string)]
233         incr archcount
234         pass "Architecture arch_$expect_out(1,string) read OK"
235         exp_continue
236     }
237     # Match all 32 bit opcodes
238     -re {(?x)           # enable expanded regexp syntax
239          ^/\*           # open C comment at start of input
240          (?:\s*\S+){2}  #   2 binary words (for 32 bit opcodes)
241      \s+ ([^*]+?)       #   instruction mnemonics (must not leave comment)
242      \s* \*/            # close C comment
243      \s* \{             # open brace of data initialiser
244          (?:[^\}]+\}){2}#   2 brace pairs (operands and nibbles)
245      \s* ,              #   comma
246      \s* arch_(\S+)_up  #   architecture name
247      \s* \|             #   literal or
248      \s* arch_op32      #   32 bit opcode indicator
249      \s* \}             # close brace of data initialiser
250         } {
251             set insns(insn,$insncount) $expect_out(1,string)
252             set insns(arch,$insncount) [string map {_ -} $expect_out(2,string)]
253             set insns(context,$insncount) $expect_out(0,string)
254             incr insncount
255             pass "Instruction '$expect_out(1,string)' read OK"
256             exp_continue
257         }
258     # Special case: Match the repeat pseudo op
259     -re {(?x)           # enable expanded regexp syntax
260          ^/\*           # open C comment at start of input
261      \s* repeat         #   repeat does not have a bit pattern
262      \s+ start\s+end    #   don't read fake operands as such (replaced below)
263      \s+ ([^*]+?)       #   instruction operand
264      \s* \*/            # close C comment
265      \s* \{             # open brace of data initialiser
266          (?:[^\}]+\}){2}#   2 brace pairs (operands and nibbles)
267      \s* ,              #   comma
268      \s* arch_(\S+)_up  #   architecture name
269      \s* \}             # close brace of data initialiser
270         } {
271             set insns(insn,$insncount) "repeat 10 20 $expect_out(1,string)"
272             set insns(arch,$insncount) [string map {_ -} $expect_out(2,string)]
273             set insns(context,$insncount) $expect_out(0,string)
274             incr insncount
275             pass "Instruction '$expect_out(1,string)' read OK"
276             exp_continue
277         }
278     # Match all 16 bit opcodes
279     -re {(?x)           # enable expanded regexp syntax
280          ^/\*           # open C comment at start of input
281      \s* \S+            #   1 binary word (for 16 bit opcodes)
282      \s+ ([^*]+?)       #   instruction mnemonics (must not leave comment)
283      \s* \*/            # close C comment
284      \s* \{             # open brace of data initialiser
285          (?:[^\}]+\}){2}#   2 brace pairs (operands and nibbles)
286      \s* ,              #   comma
287      \s* arch_(\S+)_up  #   architecture name
288      \s* \}             # close brace of data initialiser
289         } {
290             set insns(insn,$insncount) $expect_out(1,string)
291             set insns(arch,$insncount) [string map {_ -} $expect_out(2,string)]
292             set insns(context,$insncount) $expect_out(0,string)
293             incr insncount
294             pass "Instruction '$expect_out(1,string)' read OK"
295             exp_continue
296         }
297     # Match all remaining possible instructions (error detection)
298     -re {(?x)           # enable expanded regexp syntax
299          ^/\*           # open C comment at start of input
300          (?:[^*]*(?:\*[^/])?)+ # match contents of comment allowing *
301          \*/            # close C comment
302      \s* \{             # open brace of data initialiser
303          (?:[^\}]+\}){2}#   2 brace pairs (operands and nibbles)
304      \s* ,              #   comma
305          [^\}]*
306          arch           #   look for 'arch' anywhere before closing brace
307          [^\}]*
308          \}             # close brace of data initialiser
309         } {
310             fail "Found something that looks like an instruction but cannot be decoded:\n\t$expect_out(0,string)"
311             exp_continue
312         }
313     # No match so move to next (possible) comment
314     -re {^.+?((?=/\*)|(?=\#\s*define))} exp_continue
315 }
316 send_log "--------------------------------------------------------\n"
317
318 if {$archcount == 0} then {
319     fail "Unable to read any architectures from sh-opc.h"
320 } else {
321     pass "Read architecture data from sh-opc.h"
322 }
323 if {$insncount == 0} then {
324     fail "Unable to read any instructions from sh-opc.h"
325 } else {
326     pass "Read instruction data from sh-opc.h"
327 }
328
329 # Munge the insns such that they will assemble
330 # Each instruction in sh-opc.h has an example format
331 # with placeholders for the parameters. These placeholders
332 # need to be replaced with real registers and constants
333 # as appropriate in order to assemble correctly.
334 for {set i 0} {$i < $insncount} {incr i} {
335     set out $insns(insn,$i)
336     if {[regexp {AY_.{3,4}_N} $insns(context,$i)] == 1} then {
337         regsub -nocase {<REG_N>} $out {r6} out
338     } else {
339         regsub -nocase {<REG_N>} $out {r4} out
340     }
341     regsub -nocase {<REG_M>} $out {r5} out
342     if {[regexp {IMM0_20BY8} $insns(context,$i)] == 1} then {
343         regsub -nocase {<imm>} $out {1024} out
344     } else {
345         regsub -nocase {<imm>} $out {4} out
346     }
347     regsub -nocase {<bdisp\d*>} $out {.+8} out
348     regsub -nocase {<disp12>} $out {2048} out
349     regsub -nocase {<disp\d*>} $out {8} out
350     regsub -nocase {Rn_BANK} $out {r1_bank} out
351     regsub -nocase {Rm_BANK} $out {r2_bank} out
352     regsub -nocase {<F_REG_N>} $out {fr1} out
353     regsub -nocase {<F_REG_M>} $out {fr2} out
354     regsub -nocase {<D_REG_N>} $out {dr2} out
355     regsub -nocase {<D_REG_M>} $out {dr4} out
356     regsub -nocase {<V_REG_N>} $out {fv0} out
357     regsub -nocase {<V_REG_M>} $out {fv4} out
358     regsub -nocase {<DX_REG_N>} $out {xd2} out
359     regsub -nocase {<DX_REG_M>} $out {xd4} out
360     regsub -nocase (XMTRX_M4) $out {xmtrx} out
361     regsub -nocase (<DSP_REG_X>) $out {x1} out
362     regsub -nocase (<DSP_REG_Y>) $out {y0} out
363     regsub -nocase (<DSP_REG_M>) $out {a1} out
364     regsub -nocase (<DSP_REG_N>) $out {m0} out
365     regsub -nocase (<REG_Axy>) $out {r1} out
366     regsub -nocase (<REG_Ayx>) $out {r3} out
367     regsub -nocase (<DSP_REG_XY>) $out {y1} out
368     regsub -nocase (<DSP_REG_YX>) $out {y1} out
369     regsub -nocase (<DSP_REG_AX>) $out {a0} out
370     regsub -nocase (<DSP_REG_AY>) $out {a0} out
371     regsub (Se) $out {x0} out
372     regsub (Sf) $out {y0} out
373     regsub (Dg) $out {m0} out
374     # Put in a dct in order to differentiate between
375     # conditional and non-conditional pabs and prnd
376     # i.e. between sh-dsp and sh4al-dsp
377     if {[regexp {PPIC} $insns(context,$i)] == 1} then {
378         set out "dct $out"
379     }
380     # Make sure the proper alignments are ok.
381     if [regexp {i8p4} $insns(context,$i)] {
382       set out ".align 2\n\t$out"
383     }
384
385     # Write back the results.
386     set insns(insn,$i) $out
387     set insns(context,$i) [string map {\n " " \r " "} $insns(context,$i)]
388 }
389
390 # Initialise the data structure for the inheritance
391 array set archtree {}
392 for {set a 0} {$a < $archcount} {incr a} {
393     set archtree($arches($a)) {}
394 }
395
396 # For each architecture, extract its immediate parents
397 for {set a 0} {$a < $archcount} {incr a} {
398     set s $arches($a,descendents)
399     regsub -all {[\s|]+} $s { } s
400     foreach word [split $s { }] {
401         # Word should be one of arch-..., | (or), or arch-...-up
402         # We only want the -up information
403         # Note that the _ -> - translation was done above
404         if {[regexp {^arch-(.*)-up$} $word match arch] == 1} then {
405             # $arch is the descendent of $arches($a),
406             # so $arches($a) is the parent of $arch
407             lappend archtree($arch) $arches($a)
408         }
409     }
410 }
411
412 # Propagate the inhertances through the list
413 # Iterate to ensure all inheritances are found (necessary?)
414 set changesmade 1
415 while {$changesmade == 1} {
416     set changesmade 0
417     foreach a [array names archtree] {
418         foreach b [array names archtree] {
419             # If arch 'a' is a parent of arch 'b' then b inherits from a
420             if {[lsearch -exact $archtree($b) $a] != -1} then {
421                 # Only add each arch if it is not already present
422                 foreach arch $archtree($a) {
423                     if {[lsearch -exact $archtree($b) $arch] == -1} then {
424                         lappend archtree($b) $arch
425                         set changesmade 1
426                     }
427                 }
428             }
429         }
430     }
431 }
432
433 # Generate the assembler file for each architecture
434 # Also count up how many instructions should be valid for each architecture
435 array set insns_valid {}
436 for {set arch 0} {$arch < $archcount} {incr arch} {
437     set insns_valid($arches($arch)) 0
438     set fd [open $arches($arch).s w 0666]
439     puts $fd "! Generated file. DO NOT EDIT.\n!"
440     puts $fd "! This file was generated by gas/testsuite/gas/sh/arch/arch.exp ."
441     puts $fd "! This file should contain every instruction valid on"
442     puts $fd "! architecture $arches($arch) but no more."
443     puts $fd "! If the tests are failing because the expected results"
444     puts $fd "! have changed then run 'make check' and copy the new file"
445     puts $fd "! from <objdir>/gas/testsuite/$arches($arch).s"
446     puts $fd "! to   <srcdir>/gas/testsuite/gas/sh/arch/$arches($arch).s ."
447     puts $fd "! Make sure there are no unexpected or missing instructions."
448     puts $fd "\n\t.section .text"
449     puts $fd "[string map {- _} $arches($arch)]:"
450     puts $fd "! Instructions introduced into $arches($arch)"
451     for {set i 0} {$i < $insncount} {incr i} {
452         if [string equal $arches($arch) $insns(arch,$i)] then {
453             puts $fd [format "\t%-25s ;!%s" $insns(insn,$i) $insns(context,$i)]
454             incr insns_valid($arches($arch))
455         }
456     }
457     puts $fd "\n! Instructions inherited from ancestors: [lsort -increasing $archtree($arches($arch))]"
458     for {set i 0} {$i < $insncount} {incr i} {
459         if {[string equal $arches($arch) $insns(arch,$i)] != 1 && [lsearch -exact $archtree($arches($arch)) $insns(arch,$i)] != -1} then {
460             puts $fd [format "\t%-25s ;!%s" $insns(insn,$i) $insns(context,$i)]
461             incr insns_valid($arches($arch))
462         }
463     }
464     close $fd
465 }
466
467
468 ###################################################################
469 # Compare the newly created sh*.s files with the existing
470 # ones in the testsuite
471
472 for {set arch 0} {$arch < $archcount} {incr arch} {
473     send_log "diff $srcdir/$subdir/$arches($arch).s $arches($arch).s\n"
474     catch "exec diff $srcdir/$subdir/$arches($arch).s $arches($arch).s" diff_output
475     if {[string equal $diff_output ""] == 0} then {
476         send_log $diff_output
477         fail "Check $arches($arch) architecture has not changed"
478     } else {
479         pass "Check $arches($arch) architecture has not changed"
480     }
481 }
482
483
484 ###################################################################
485 # Generate an assembler file with every instruction
486 # Then use it to test how many failures there are for
487 # each architecture. If this does not match the predicted value
488 # then the assembler accepts too many instructions for a given
489 # architecture.
490
491
492 set fd [open "all_insns.s" w 0666]
493 for {set i 0} {$i < $insncount} {incr i} {
494     puts $fd [format "\t%-25s ;!%s" $insns(insn,$i) $insns(context,$i)]
495 }
496 close $fd
497
498 # Assemble the all_insns.s file for each isa and count how many failures there are
499 foreach arch [array names insns_valid] {
500     set errormessages 0
501     set expected [expr $insncount - $insns_valid($arch)]
502
503     # The -Z option ensures that all error messages are output,
504     # even those from later phases of assembly (such as offset range errors)
505     send_log "$AS -Z -isa=$arch all_insns.s -o /dev/null\n"
506     spawn $AS -Z -isa=$arch all_insns.s -o /dev/null
507     expect Error: {incr errormessages; exp_continue}
508
509     if {$errormessages == $expected} then {
510         pass "$expected insns should not assemble on $arch"
511     } else {
512         if {([istarget sh*-*-coff] || [istarget sh*-hms]) && [string match {*dsp} $arch]} {
513             xfail "$expected insns should not assemble on $arch ($errormessages did not)"
514         } else {
515             fail "$expected insns should not assemble on $arch ($errormessages did not)"
516         }
517     }
518 }
519
520
521 } ;# istarget sh*-*-*