gas/testsuite/gas/sh/arch/arch.exp

   1 # Copyright (C) 2004, 2005, 2007, 2008
   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 return
 209
 210 #########################################################################
 211 # Generate one sh*.s file for each architecture defined in sh-opc.h
 212 # This will contain all the instructions valid on that platform
 213 #
 214 # This code produces pass or fail reports for each instruction
 215 # in order to ensure that problems are visible to the developer,
 216 # rather than just warnings hidden in the log file.
 217
 218 # These variables will contains the architecture
 219 # and instruction data extracted from sh-opc.h
 220 array set arches {}
 221 set archcount 0
 222 array set insns {}
 223 set insncount 0
 224
 225 # Pull the architecture inheritance macros out of sh-opc.h
 226 # Pull all the insns out of the sh-opc.h file.
 227 send_log "Reading sh-opc.h\n"
 228 send_log "========================================================\n"
 229 spawn -noecho cat "$srcdir/../../opcodes/sh-opc.h"   ;# -open doesn't seem to be reliable
 230 expect {
 231     -re {#define\s+arch_([^ ]*)_up\s*\(([^)]*)\)} {
 232         set arches($archcount) [string map {_ -} $expect_out(1,string)]
 233         set arches($archcount,descendents) [string map {_ -} $expect_out(2,string)]
 234         incr archcount
 235         pass "Architecture arch_$expect_out(1,string) read OK"
 236         exp_continue
 237     }
 238     # Match all 32 bit opcodes
 239     -re {(?x)           # enable expanded regexp syntax
 240          ^/\*           # open C comment at start of input
 241          (?:\s*\S+){2}  #   2 binary words (for 32 bit opcodes)
 242      \s+ ([^*]+?)       #   instruction mnemonics (must not leave comment)
 243      \s* \*/            # close C comment
 244      \s* \{             # open brace of data initialiser
 245          (?:[^\}]+\}){2}#   2 brace pairs (operands and nibbles)
 246      \s* ,              #   comma
 247      \s* arch_(\S+)_up  #   architecture name
 248      \s* \|             #   literal or
 249      \s* arch_op32      #   32 bit opcode indicator
 250      \s* \}             # close brace of data initialiser
 251         } {
 252             set insns(insn,$insncount) $expect_out(1,string)
 253             set insns(arch,$insncount) [string map {_ -} $expect_out(2,string)]
 254             set insns(context,$insncount) $expect_out(0,string)
 255             incr insncount
 256             pass "Instruction '$expect_out(1,string)' read OK"
 257             exp_continue
 258         }
 259     # Special case: Match the repeat pseudo op
 260     -re {(?x)           # enable expanded regexp syntax
 261          ^/\*           # open C comment at start of input
 262      \s* repeat         #   repeat does not have a bit pattern
 263      \s+ start\s+end    #   don't read fake operands as such (replaced below)
 264      \s+ ([^*]+?)       #   instruction operand
 265      \s* \*/            # close C comment
 266      \s* \{             # open brace of data initialiser
 267          (?:[^\}]+\}){2}#   2 brace pairs (operands and nibbles)
 268      \s* ,              #   comma
 269      \s* arch_(\S+)_up  #   architecture name
 270      \s* \}             # close brace of data initialiser
 271         } {
 272             set insns(insn,$insncount) "repeat 10 20 $expect_out(1,string)"
 273             set insns(arch,$insncount) [string map {_ -} $expect_out(2,string)]
 274             set insns(context,$insncount) $expect_out(0,string)
 275             incr insncount
 276             pass "Instruction '$expect_out(1,string)' read OK"
 277             exp_continue
 278         }
 279     # Match all 16 bit opcodes
 280     -re {(?x)           # enable expanded regexp syntax
 281          ^/\*           # open C comment at start of input
 282      \s* \S+            #   1 binary word (for 16 bit opcodes)
 283      \s+ ([^*]+?)       #   instruction mnemonics (must not leave comment)
 284      \s* \*/            # close C comment
 285      \s* \{             # open brace of data initialiser
 286          (?:[^\}]+\}){2}#   2 brace pairs (operands and nibbles)
 287      \s* ,              #   comma
 288      \s* arch_(\S+)_up  #   architecture name
 289      \s* \}             # close brace of data initialiser
 290         } {
 291             set insns(insn,$insncount) $expect_out(1,string)
 292             set insns(arch,$insncount) [string map {_ -} $expect_out(2,string)]
 293             set insns(context,$insncount) $expect_out(0,string)
 294             incr insncount
 295             pass "Instruction '$expect_out(1,string)' read OK"
 296             exp_continue
 297         }
 298     # Match all remaining possible instructions (error detection)
 299     -re {(?x)           # enable expanded regexp syntax
 300          ^/\*           # open C comment at start of input
 301          (?:[^*]*(?:\*[^/])?)+ # match contents of comment allowing *
 302          \*/            # close C comment
 303      \s* \{             # open brace of data initialiser
 304          (?:[^\}]+\}){2}#   2 brace pairs (operands and nibbles)
 305      \s* ,              #   comma
 306          [^\}]*
 307          arch           #   look for 'arch' anywhere before closing brace
 308          [^\}]*
 309          \}             # close brace of data initialiser
 310         } {
 311             fail "Found something that looks like an instruction but cannot be decoded:\n\t$expect_out(0,string)"
 312             exp_continue
 313         }
 314     # No match so move to next (possible) comment
 315     -re {^.+?((?=/\*)|(?=\#\s*define))} exp_continue
 316 }
 317 send_log "--------------------------------------------------------\n"
 318
 319 if {$archcount == 0} then {
 320     fail "Unable to read any architectures from sh-opc.h"
 321 } else {
 322     pass "Read architecture data from sh-opc.h"
 323 }
 324 if {$insncount == 0} then {
 325     fail "Unable to read any instructions from sh-opc.h"
 326 } else {
 327     pass "Read instruction data from sh-opc.h"
 328 }
 329
 330 # Munge the insns such that they will assemble
 331 # Each instruction in sh-opc.h has an example format
 332 # with placeholders for the parameters. These placeholders
 333 # need to be replaced with real registers and constants
 334 # as appropriate in order to assemble correctly.
 335 for {set i 0} {$i < $insncount} {incr i} {
 336     set out $insns(insn,$i)
 337     if {[regexp {AY_.{3,4}_N} $insns(context,$i)] == 1} then {
 338         regsub -nocase {<REG_N>} $out {r6} out
 339     } else {
 340         regsub -nocase {<REG_N>} $out {r4} out
 341     }
 342     regsub -nocase {<REG_M>} $out {r5} out
 343     if {[regexp {IMM0_20BY8} $insns(context,$i)] == 1} then {
 344         regsub -nocase {<imm>} $out {1024} out
 345     } else {
 346         regsub -nocase {<imm>} $out {4} out
 347     }
 348     regsub -nocase {<bdisp\d*>} $out {.+8} out
 349     regsub -nocase {<disp12>} $out {2048} out
 350     regsub -nocase {<disp\d*>} $out {8} out
 351     regsub -nocase {Rn_BANK} $out {r1_bank} out
 352     regsub -nocase {Rm_BANK} $out {r2_bank} out
 353     regsub -nocase {<F_REG_N>} $out {fr1} out
 354     regsub -nocase {<F_REG_M>} $out {fr2} out
 355     regsub -nocase {<D_REG_N>} $out {dr2} out
 356     regsub -nocase {<D_REG_M>} $out {dr4} out
 357     regsub -nocase {<V_REG_N>} $out {fv0} out
 358     regsub -nocase {<V_REG_M>} $out {fv4} out
 359     regsub -nocase {<DX_REG_N>} $out {xd2} out
 360     regsub -nocase {<DX_REG_M>} $out {xd4} out
 361     regsub -nocase (XMTRX_M4) $out {xmtrx} out
 362     regsub -nocase (<DSP_REG_X>) $out {x1} out
 363     regsub -nocase (<DSP_REG_Y>) $out {y0} out
 364     regsub -nocase (<DSP_REG_M>) $out {a1} out
 365     regsub -nocase (<DSP_REG_N>) $out {m0} out
 366     regsub -nocase (<REG_Axy>) $out {r1} out
 367     regsub -nocase (<REG_Ayx>) $out {r3} out
 368     regsub -nocase (<DSP_REG_XY>) $out {y1} out
 369     regsub -nocase (<DSP_REG_YX>) $out {y1} out
 370     regsub -nocase (<DSP_REG_AX>) $out {a0} out
 371     regsub -nocase (<DSP_REG_AY>) $out {a0} out
 372     regsub (Se) $out {x0} out
 373     regsub (Sf) $out {y0} out
 374     regsub (Dg) $out {m0} out
 375     # Put in a dct in order to differentiate between
 376     # conditional and non-conditional pabs and prnd
 377     # i.e. between sh-dsp and sh4al-dsp
 378     if {[regexp {PPIC} $insns(context,$i)] == 1} then {
 379         set out "dct $out"
 380     }
 381     # Make sure the proper alignments are ok.
 382     if [regexp {i8p4} $insns(context,$i)] {
 383       set out ".align 2\n\t$out"
 384     }
 385
 386     # Write back the results.
 387     set insns(insn,$i) $out
 388     set insns(context,$i) [string map {\n " " \r " "} $insns(context,$i)]
 389 }
 390
 391 # Initialise the data structure for the inheritance
 392 array set archtree {}
 393 for {set a 0} {$a < $archcount} {incr a} {
 394     set archtree($arches($a)) {}
 395 }
 396
 397 # For each architecture, extract its immediate parents
 398 for {set a 0} {$a < $archcount} {incr a} {
 399     set s $arches($a,descendents)
 400     regsub -all {[\s|]+} $s { } s
 401     foreach word [split $s { }] {
 402         # Word should be one of arch-..., | (or), or arch-...-up
 403         # We only want the -up information
 404         # Note that the _ -> - translation was done above
 405         if {[regexp {^arch-(.*)-up$} $word match arch] == 1} then {
 406             # $arch is the descendent of $arches($a),
 407             # so $arches($a) is the parent of $arch
 408             lappend archtree($arch) $arches($a)
 409         }
 410     }
 411 }
 412
 413 # Propagate the inhertances through the list
 414 # Iterate to ensure all inheritances are found (necessary?)
 415 set changesmade 1
 416 while {$changesmade == 1} {
 417     set changesmade 0
 418     foreach a [array names archtree] {
 419         foreach b [array names archtree] {
 420             # If arch 'a' is a parent of arch 'b' then b inherits from a
 421             if {[lsearch -exact $archtree($b) $a] != -1} then {
 422                 # Only add each arch if it is not already present
 423                 foreach arch $archtree($a) {
 424                     if {[lsearch -exact $archtree($b) $arch] == -1} then {
 425                         lappend archtree($b) $arch
 426                         set changesmade 1
 427                     }
 428                 }
 429             }
 430         }
 431     }
 432 }
 433
 434 # Generate the assembler file for each architecture
 435 # Also count up how many instructions should be valid for each architecture
 436 array set insns_valid {}
 437 for {set arch 0} {$arch < $archcount} {incr arch} {
 438     set insns_valid($arches($arch)) 0
 439     set fd [open $arches($arch).s w 0666]
 440     puts $fd "! Generated file. DO NOT EDIT.\n!"
 441     puts $fd "! This file was generated by gas/testsuite/gas/sh/arch/arch.exp ."
 442     puts $fd "! This file should contain every instruction valid on"
 443     puts $fd "! architecture $arches($arch) but no more."
 444     puts $fd "! If the tests are failing because the expected results"
 445     puts $fd "! have changed then run 'make check' and copy the new file"
 446     puts $fd "! from <objdir>/gas/testsuite/$arches($arch).s"
 447     puts $fd "! to   <srcdir>/gas/testsuite/gas/sh/arch/$arches($arch).s ."
 448     puts $fd "! Make sure there are no unexpected or missing instructions."
 449     puts $fd "\n\t.section .text"
 450     puts $fd "[string map {- _} $arches($arch)]:"
 451     puts $fd "! Instructions introduced into $arches($arch)"
 452     for {set i 0} {$i < $insncount} {incr i} {
 453         if [string equal $arches($arch) $insns(arch,$i)] then {
 454             puts $fd [format "\t%-25s ;!%s" $insns(insn,$i) $insns(context,$i)]
 455             incr insns_valid($arches($arch))
 456         }
 457     }
 458     puts $fd "\n! Instructions inherited from ancestors: [lsort -increasing $archtree($arches($arch))]"
 459     for {set i 0} {$i < $insncount} {incr i} {
 460         if {[string equal $arches($arch) $insns(arch,$i)] != 1 && [lsearch -exact $archtree($arches($arch)) $insns(arch,$i)] != -1} then {
 461             puts $fd [format "\t%-25s ;!%s" $insns(insn,$i) $insns(context,$i)]
 462             incr insns_valid($arches($arch))
 463         }
 464     }
 465     close $fd
 466 }
 467
 468
 469 ###################################################################
 470 # Compare the newly created sh*.s files with the existing
 471 # ones in the testsuite
 472
 473 for {set arch 0} {$arch < $archcount} {incr arch} {
 474     send_log "diff $srcdir/$subdir/$arches($arch).s $arches($arch).s\n"
 475     catch "exec diff $srcdir/$subdir/$arches($arch).s $arches($arch).s" diff_output
 476     if {[string equal $diff_output ""] == 0} then {
 477         send_log $diff_output
 478         fail "Check $arches($arch) architecture has not changed"
 479     } else {
 480         pass "Check $arches($arch) architecture has not changed"
 481     }
 482 }
 483
 484
 485 ###################################################################
 486 # Generate an assembler file with every instruction
 487 # Then use it to test how many failures there are for
 488 # each architecture. If this does not match the predicted value
 489 # then the assembler accepts too many instructions for a given
 490 # architecture.
 491
 492
 493 set fd [open "all_insns.s" w 0666]
 494 for {set i 0} {$i < $insncount} {incr i} {
 495     puts $fd [format "\t%-25s ;!%s" $insns(insn,$i) $insns(context,$i)]
 496 }
 497 close $fd
 498
 499 # Assemble the all_insns.s file for each isa and count how many failures there are
 500 foreach arch [array names insns_valid] {
 501     set errormessages 0
 502     set expected [expr $insncount - $insns_valid($arch)]
 503
 504     # The -Z option ensures that all error messages are output,
 505     # even those from later phases of assembly (such as offset range errors)
 506     send_log "$AS -Z -isa=$arch all_insns.s -o /dev/null\n"
 507     spawn $AS -Z -isa=$arch all_insns.s -o /dev/null
 508     expect Error: {incr errormessages; exp_continue}
 509
 510     if {$errormessages == $expected} then {
 511         pass "$expected insns should not assemble on $arch"
 512     } else {
 513         if {([istarget sh*-*-coff] || [istarget sh*-hms]) && [string match {*dsp} $arch]} {
 514             xfail "$expected insns should not assemble on $arch ($errormessages did not)"
 515         } else {
 516             fail "$expected insns should not assemble on $arch ($errormessages did not)"
 517         }
 518     }
 519 }
 520
 521
 522 } ;# istarget sh*-*-*