[RFA: and RFC:] run_dump_test in ld: extensions and globality oftestsuite functions.

[Hans-Peter Nilsson <hp at bitrange dot com>]

I like run_dump_test.  I'd like to use it for ld tests, where IMHO
infrastructure is lacking: it's not simple enough to add new tests.  I
imported it to the ld testsuite and added a few extra gadgets that make
sense when linking, like multiple sources and expect failures with error
messages; see patch.  For example, here's a test-case for correctly linking
a relocation at just the end of the range, for a new target I hope to
finish soon (Murphy, please spare me):

---------------
#source: start.s
#source: getaa.s
#source: pad2p18m32.s
#source: pad16.s
#source: pad4.s
#source: a.s
#as: -no-expand
#ld:
#objdump: -dr

.*:     file format elf64-mmix

Disassembly of section \.text:

00000000000200b0 <_start>:
   200b0:	e3fd0001 	setl \$253,0x1

00000000000200b4 <getaa>:
   200b4:	e3fd0002 	setl \$253,0x2
   200b8:	f47bffff 	geta \$123,600b4 <a>
   200bc:	e3fd0003 	setl \$253,0x3
	\.\.\.

00000000000600b4 <a>:
   600b4:	e3fd0004 	setl \$253,0x4
---------------

and here's one for just *beyond* end of the range:

---------------
#source: start.s
#source: a.s
#source: pad2p18m32.s
#source: pad16.s
#source: pad4.s
#source: pad4.s
#source: pad4.s
#source: getaa.s
#as: -no-expand
#ld:
#error: relocation truncated to fit: R_MMIX_ADDR19 a$
---------------

The .s files quoted above are still hoarded up, away from your peering
eyes, but I think you can guess what they contain.  I tried to make use of
the dejagnu "dg" framework, but ran into problems like finding a way to
use multiple source files, and including the test directives in the
expected output rather than the source.

I've noticed a few different issues though.

- The ld tests are run relative from "ld" and stores test files in
  "ld/tmpdir".  Gas tests are run relative from "gas/testsuite" and test
  files are stored in that directory.  I guess we can add a testdir
  argument and pass it to a run_dump_general, but it seems better to make
  ld do like gas so they can more easily share common testsuite functions
  without tweaks or parameters.  There's the gcc -B-reason to why ld does
  that, but I believe the symlink could be in the ld/testsuite objdir,
  i.e. "-B./" when tweaked.  Any reason to not do that?

- With the patch below, we'll have e.g. run_dump_test and regexp_diff in
  gas/testsuite and another set in ld/testsuite.  They should be one and
  the same, in some common place.  The question is, where?  Suggestion:
  libiberty/testsuite/lib.

- You'll notice that I had to add some global variables to
  ld/testsuite/config/default.exp to avoid hacking up run_dump_test too
  much.  I hope there's no problem associated with that; I could not think
  of any.

Ideas for future work: <mumble> external-body (expected regexp_diff output
found in another file), "grep" analyzer, cascading of analyzers (like "nm"
then "grep"), "expected-not" (must not match) </mumble>.

Here's a patch, so there's the choice of adding this now and solve the
issues noted above later.  (BTW, I now understand (two other meanings to)
why it's called DejaGNU. :-)

So perhaps it's reasonable to ask:
Ok to commit?

ld/testsuite:

	* config/default.exp (AS, GASP, OBJDUMP, NM, NMFLAGS, OBJCOPY,
	OBJCOPYFLAGS, READELF, READELFFLAGS, LD, LDFLAGS): Provide
	default.

	* lib/ld-lib.exp (run_dump_test): Import from gas testsuite.  Add
	new options "ld", "source", "xfail", "target", "notarget" and
	"error".
	(slurp_options, regexp_diff, file_contents, verbose_eval): Import
	from gas testsuite.

Index: lib/ld-lib.exp
===================================================================
RCS file: /cvs/src/src/ld/testsuite/lib/ld-lib.exp,v
retrieving revision 1.8
diff -p -c -r1.8 ld-lib.exp
*** ld-lib.exp	2001/03/13 06:14:29	1.8
--- ld-lib.exp	2001/06/06 01:04:16
*************** proc simple_diff { file_1 file_2 } {
*** 393,398 ****
--- 393,889 ----
      }
  }

+ # run_dump_test FILE
+ # Copied from gas testsuite, tweaked and further extended.
+ #
+ # Assemble a .s file, then run some utility on it and check the output.
+ #
+ # There should be an assembly language file named FILE.s in the test
+ # suite directory, and a pattern file called FILE.d.  `run_dump_test'
+ # will assemble FILE.s, run some tool like `objdump', `objcopy', or
+ # `nm' on the .o file to produce textual output, and then analyze that
+ # with regexps.  The FILE.d file specifies what program to run, and
+ # what to expect in its output.
+ #
+ # The FILE.d file begins with zero or more option lines, which specify
+ # flags to pass to the assembler, the program to run to dump the
+ # assembler's output, and the options it wants.  The option lines have
+ # the syntax:
+ #
+ #         # OPTION: VALUE
+ #
+ # OPTION is the name of some option, like "name" or "objdump", and
+ # VALUE is OPTION's value.  The valid options are described below.
+ # Whitespace is ignored everywhere, except within VALUE.  The option
+ # list ends with the first line that doesn't match the above syntax
+ # (hmm, not great for error detection).
+ #
+ # The interesting options are:
+ #
+ #   name: TEST-NAME
+ #	The name of this test, passed to DejaGNU's `pass' and `fail'
+ #       commands.  If omitted, this defaults to FILE, the root of the
+ #       .s and .d files' names.
+ #
+ #   as: FLAGS
+ #	When assembling, pass FLAGS to the assembler.
+ #       If assembling several files, you can pass different assembler
+ #       options in the "source" directives.  See below.
+ #
+ #   ld: FLAGS
+ #       Link assembled files using FLAGS, in the order of the "source"
+ #       directives, when using multiple files.
+ #
+ #   PROG: PROGRAM-NAME
+ #       The name of the program to run to analyze the .o file produced
+ #       by the assembler or the linker output.  This can be omitted;
+ #       run_dump_test will guess which program to run by seeing which of
+ #       the flags options below is present.
+ #
+ #   objdump: FLAGS
+ #   nm: FLAGS
+ #   objcopy: FLAGS
+ #	Use the specified program to analyze the assembler or linker
+ #       output file, and pass it FLAGS, in addition to the output name.
+ #
+ #   source: SOURCE [FLAGS]
+ #	Assemble the file SOURCE.s using the flags in the "as" directive
+ #       and the (optional) FLAGS.  If omitted, the source defaults to
+ #       FILE.s.
+ #       This is useful if several .d files want to share a .s file.
+ #       More than one "source" directive can be given, which is useful
+ #       when testing linking.
+ #
+ #   xfail: TARGET
+ #       The test is expected to fail on TARGET.  This may occur more than
+ #       once.
+ #
+ #   target: TARGET
+ #       Only run the test for TARGET.  This may occur more than once; the
+ #       target being tested must match at least one.
+ #
+ #   notarget: TARGET
+ #       Do not run the test for TARGET.  This may occur more than once;
+ #       the target being tested must not match any of them.
+ #
+ #   error: REGEX
+ #	An error with message matching REGEX must be emitted for the test
+ #	to pass.  The PROG, objdump, nm and objcopy options have no
+ #	meaning and need not supplied if this is present.
+ #
+ # Each option may occur at most once unless otherwise mentioned.
+ #
+ # After the option lines come regexp lines.  `run_dump_test' calls
+ # `regexp_diff' to compare the output of the dumping tool against the
+ # regexps in FILE.d.  `regexp_diff' is defined later in this file; see
+ # further comments there.
+
+ proc run_dump_test { name } {
+     global subdir srcdir
+     global OBJDUMP NM AS OBJCOPY READELF LD
+     global OBJDUMPFLAGS NMFLAGS ASFLAGS OBJCOPYFLAGS READELFFLAGS LDFLAGS
+     global host_triplet runtests
+
+     if [string match "*/*" $name] {
+ 	set file $name
+ 	set name [file tail $name]
+     } else {
+ 	set file "$srcdir/$subdir/$name"
+     }
+
+     if ![runtest_file_p $runtests $name] then {
+ 	return
+     }
+
+     set opt_array [slurp_options "${file}.d"]
+     if { $opt_array == -1 } {
+ 	perror "error reading options from $file.d"
+ 	unresolved $subdir/$name
+ 	return
+     }
+     set dumpfile tmpdir/dump.out
+     set run_ld 0
+     set opts(as) {}
+     set opts(ld) {}
+     set opts(xfail) {}
+     set opts(target) {}
+     set opts(notarget) {}
+     set opts(objdump) {}
+     set opts(nm) {}
+     set opts(objcopy) {}
+     set opts(readelf) {}
+     set opts(name) {}
+     set opts(PROG) {}
+     set opts(source) {}
+     set opts(error) {}
+     set asflags{${file}.s} {}
+
+     foreach i $opt_array {
+ 	set opt_name [lindex $i 0]
+ 	set opt_val [lindex $i 1]
+ 	if ![info exists opts($opt_name)] {
+ 	    perror "unknown option $opt_name in file $file.d"
+ 	    unresolved $subdir/$name
+ 	    return
+ 	}
+
+ 	switch -- $opt_name {
+ 	    xfail {}
+ 	    target {}
+ 	    notarget {}
+ 	    source {
+ 		# Move any source-specific as-flags to a separate array to
+ 		# simplify processing.
+ 		if { [llength $opt_val] > 1 } {
+ 		    set asflags([lindex $opt_val 0]) [lrange $opt_val 1 end]
+ 		    set opt_val [lindex $opt_val 0]
+ 		} else {
+ 		    set asflags($opt_val) {}
+ 		}
+ 	    }
+ 	    default {
+ 		if [string length $opts($opt_name)] {
+ 		    perror "option $opt_name multiply set in $file.d"
+ 		    unresolved $subdir/$name
+ 		    return
+ 		}
+
+ 		# A single "# ld:" with no options should do the right thing.
+ 		if { $opt_name == "ld" } {
+ 		    set run_ld 1
+ 		}
+ 	    }
+ 	}
+ 	set opts($opt_name) [concat $opts($opt_name) $opt_val]
+     }
+
+     # Decide early whether we should run the test for this target.
+     if { [llength $opts(target)] > 0 } {
+ 	set targmatch 0
+ 	foreach targ $opts(target) {
+ 	    if [istarget $targ] {
+ 		set targmatch 1
+ 		break
+ 	    }
+ 	}
+ 	if { $targmatch == 0 } {
+ 	    return
+ 	}
+     }
+     foreach targ $opts(notarget) {
+ 	if [istarget $targ] {
+ 	    return
+ 	}
+     }
+
+     if {$opts(PROG) != ""} {
+ 	switch -- $opts(PROG) {
+ 	    objdump
+ 		{ set program objdump }
+ 	    nm
+ 		{ set program nm }
+ 	    objcopy
+ 		{ set program objcopy }
+ 	    readelf
+ 		{ set program readelf }
+ 	    default
+ 		{ perror "unrecognized program option $opts(PROG) in $file.d"
+ 		  unresolved $subdir/$name
+ 		  return }
+ 	}
+     } elseif { $opts(error) != "" } {
+ 	# It's meaningless to require an output-testing method when we
+ 	# expect an error.  For simplicity, we fake an arbitrary method.
+ 	set program "nm"
+     } else {
+ 	# Guess which program to run, by seeing which option was specified.
+ 	set program ""
+ 	foreach p {objdump objcopy nm readelf} {
+ 	    if {$opts($p) != ""} {
+ 		if {$program != ""} {
+ 		    perror "ambiguous dump program in $file.d"
+ 		    unresolved $subdir/$name
+ 		    return
+ 		} else {
+ 		    set program $p
+ 		}
+ 	    }
+ 	}
+ 	if {$program == ""} {
+ 	    perror "dump program unspecified in $file.d"
+ 	    unresolved $subdir/$name
+ 	    return
+ 	}
+     }
+
+     set progopts1 $opts($program)
+     eval set progopts \$[string toupper $program]FLAGS
+     eval set binary \$[string toupper $program]
+     if { $opts(name) == "" } {
+ 	set testname "$subdir/$name"
+     } else {
+ 	set testname $opts(name)
+     }
+
+     if { $opts(source) == "" } {
+ 	set sourcefiles [list ${file}.s]
+     } else {
+ 	set sourcefiles {}
+ 	foreach sf $opts(source) {
+ 	    lappend sourcefiles "$srcdir/$subdir/$sf"
+ 	    # Must have asflags indexed on source name.
+ 	    set asflags($srcdir/$subdir/$sf) $asflags($sf)
+ 	}
+     }
+
+     # Time to setup xfailures.
+     foreach targ $opts(xfail) {
+ 	setup_xfail $targ
+     }
+
+     # Assemble each file.
+     set objfiles {}
+     for { set i 0 } { $i < [llength $sourcefiles] } { incr i } {
+ 	set sourcefile [lindex $sourcefiles $i]
+
+ 	set objfile "tmpdir/dump$i.o"
+ 	lappend objfiles $objfile
+ 	set cmd "$AS $ASFLAGS $opts(as) $asflags($sourcefile) -o $objfile $sourcefile"
+
+ 	send_log "$cmd\n"
+ 	set cmdret [catch "exec $cmd" comp_output]
+ 	set comp_output [prune_warnings $comp_output]
+
+ 	# We accept errors at assembly stage too, unless we're supposed to
+ 	# link something.
+ 	if { $cmdret != 0 || ![string match "" $comp_output] } then {
+ 	    send_log "$comp_output\n"
+ 	    verbose "$comp_output" 3
+ 	    if { $opts(error) != "" && $run_ld == 0 } {
+ 		if [regexp $opts(error) $comp_output] {
+ 		    pass $testname
+ 		    return
+ 		}
+ 	    }
+ 	    fail $testname
+ 	    return
+ 	}
+     }
+
+     # Perhaps link the file(s).
+     if { $run_ld } {
+ 	set objfile "tmpdir/dump"
+ 	set cmd "$LD $LDFLAGS $opts(ld) -o $objfile $objfiles"
+
+ 	send_log "$cmd\n"
+ 	set cmdret [catch "exec $cmd" comp_output]
+ 	set comp_output [prune_warnings $comp_output]
+
+ 	if { $cmdret != 0 || ![string match "" $comp_output] } then {
+ 	    verbose -log "failed with: <$comp_output>, expected: <$opts(error)>"
+ 	    send_log "$comp_output\n"
+ 	    verbose "$comp_output" 3
+ 	    if { $opts(error) != "" } {
+ 		if [regexp $opts(error) $comp_output] {
+ 		    pass $testname
+ 		    return
+ 		}
+ 	    }
+ 	    fail $testname
+ 	    return
+ 	}
+     } else {
+ 	set objfile "tmpdir/dump0.o"
+     }
+
+     # We must not have expected failure if we get here.
+     if { $opts(error) != "" } {
+ 	fail $testname
+     }
+
+     if { [which $binary] == 0 } {
+ 	untested $testname
+ 	return
+     }
+
+     if { $progopts1 == "" } { set $progopts1 "-r" }
+     verbose "running $binary $progopts $progopts1" 3
+
+     # Objcopy, unlike the other two, won't send its output to stdout,
+     # so we have to run it specially.
+     if { $program == "objcopy" } {
+ 	set cmd "$binary $progopts $progopts1 $objfile $dumpfile"
+ 	send_log "$cmd\n"
+ 	catch "exec $cmd" comp_output
+ 	set comp_output [prune_warnings $comp_output]
+ 	if ![string match "" $comp_output] then {
+ 	    send_log "$comp_output\n"
+ 	    fail $testname
+ 	    return
+ 	}
+     } else {
+ 	set cmd "$binary $progopts $progopts1 $objfile > $dumpfile"
+ 	send_log "$cmd\n"
+ 	catch "exec $cmd" comp_output
+ 	set comp_output [prune_warnings $comp_output]
+ 	if ![string match "" $comp_output] then {
+ 	    send_log "$comp_output\n"
+ 	    fail $testname
+ 	    return
+ 	}
+     }
+
+     verbose_eval {[file_contents $dumpfile]} 3
+     if { [regexp_diff $dumpfile "${file}.d"] } then {
+ 	fail $testname
+ 	verbose "output is [file_contents $dumpfile]" 2
+ 	return
+     }
+
+     pass $testname
+ }
+
+ proc slurp_options { file } {
+     if [catch { set f [open $file r] } x] {
+ 	#perror "couldn't open `$file': $x"
+ 	perror "$x"
+ 	return -1
+     }
+     set opt_array {}
+     # whitespace expression
+     set ws  {[ 	]*}
+     set nws {[^ 	]*}
+     # whitespace is ignored anywhere except within the options list;
+     # option names are alphabetic only
+     set pat "^#${ws}(\[a-zA-Z\]*)$ws:${ws}(.*)$ws\$"
+     while { [gets $f line] != -1 } {
+ 	set line [string trim $line]
+ 	# Whitespace here is space-tab.
+ 	if [regexp $pat $line xxx opt_name opt_val] {
+ 	    # match!
+ 	    lappend opt_array [list $opt_name $opt_val]
+ 	} else {
+ 	    break
+ 	}
+     }
+     close $f
+     return $opt_array
+ }
+
+ # regexp_diff, copied from gas, based on simple_diff above.
+ #	compares two files line-by-line
+ #	file1 contains strings, file2 contains regexps and #-comments
+ #	blank lines are ignored in either file
+ #	returns non-zero if differences exist
+ #
+ proc regexp_diff { file_1 file_2 } {
+
+     set eof -1
+     set end_1 0
+     set end_2 0
+     set differences 0
+     set diff_pass 0
+
+     if [file exists $file_1] then {
+ 	set file_a [open $file_1 r]
+     } else {
+ 	warning "$file_1 doesn't exist"
+ 	return 1
+     }
+
+     if [file exists $file_2] then {
+ 	set file_b [open $file_2 r]
+     } else {
+ 	fail "$file_2 doesn't exist"
+ 	close $file_a
+ 	return 1
+     }
+
+     verbose " Regexp-diff'ing: $file_1 $file_2" 2
+
+     while { 1 } {
+ 	set line_a ""
+ 	set line_b ""
+ 	while { [string length $line_a] == 0 } {
+ 	    if { [gets $file_a line_a] == $eof } {
+ 		set end_1 1
+ 		break
+ 	    }
+ 	}
+ 	while { [string length $line_b] == 0 || [string match "#*" $line_b] } {
+ 	    if [ string match "#pass" $line_b ] {
+ 		set end_2 1
+ 		set diff_pass 1
+ 		break
+ 	    } elseif [ string match "#..." $line_b ] {
+ 		if { [gets $file_b line_b] == $eof } {
+ 		    set end_2 1
+ 		    break
+ 		}
+ 		verbose "looking for \"^$line_b$\"" 3
+ 		while { ![regexp "^$line_b$" "$line_a"] } {
+ 		    verbose "skipping    \"$line_a\"" 3
+ 		    if { [gets $file_a line_a] == $eof } {
+ 			set end_1 1
+ 			break
+ 		    }
+ 		}
+ 		break
+ 	    }
+ 	    if { [gets $file_b line_b] == $eof } {
+ 		set end_2 1
+ 		break
+ 	    }
+ 	}
+
+         if { $diff_pass } {
+             break
+         } elseif { $end_1 && $end_2 } {
+             break
+         } elseif { $end_1 } {
+             send_log "extra regexps in $file_2 starting with \"^$line_b$\"\nEOF from $file_1\n"
+             verbose "extra regexps in $file_2 starting with \"^$line_b$\"\nEOF from $file_1" 3
+             set differences 1
+             break
+         } elseif { $end_2 } {
+             send_log "extra lines in $file_1 starting with \"^$line_a$\"\nEOF from $file_2\n"
+             verbose "extra lines in $file_1 starting with \"^$line_a$\"\nEOF from $file_2\n" 3
+             set differences 1
+             break
+         } else {
+             verbose "regexp \"^$line_b$\"\nline   \"$line_a\"" 3
+             if ![regexp "^$line_b$" "$line_a"] {
+ 		send_log "regexp_diff match failure\n"
+ 		send_log "regexp \"^$line_b$\"\nline   \"$line_a\"\n"
+ 		set differences 1
+             }
+         }
+     }
+
+     if { $differences == 0 && !$diff_pass && [eof $file_a] != [eof $file_b] } {
+ 	send_log "$file_1 and $file_2 are different lengths\n"
+ 	verbose "$file_1 and $file_2 are different lengths" 3
+ 	set differences 1
+     }
+
+     close $file_a
+     close $file_b
+
+     return $differences
+ }
+
+ proc file_contents { filename } {
+     set file [open $filename r]
+     set contents [read $file]
+     close $file
+     return $contents
+ }
+
+ proc verbose_eval { expr { level 1 } } {
+     global verbose
+     if $verbose>$level then { eval verbose "$expr" $level }
+ }
+
  # This definition is taken from an unreleased version of DejaGnu.  Once
  # that version gets released, and has been out in the world for a few
  # months at least, it may be safe to delete this copy.
Index: config/default.exp
===================================================================
RCS file: /cvs/src/src/ld/testsuite/config/default.exp,v
retrieving revision 1.2
diff -p -c -r1.2 default.exp
*** default.exp	2001/03/13 06:14:27	1.2
--- default.exp	2001/06/06 00:39:31
*************** proc ld_exec { target output } {
*** 170,172 ****
--- 170,224 ----
  	default_ld_exec $target $output
  }

+ # From gas-defs.exp, to support run_dump_test.
+ if ![info exists AS] then {
+     set AS $as
+ }
+
+ if ![info exists GASP] then {
+     set GASP [findfile $base_dir/../gas/gasp-new $base_dir/../gas/gasp-new [transform gasp]]
+ }
+
+ if ![info exists ASFLAGS] then {
+     set ASFLAGS ""
+ }
+
+ if ![info exists OBJDUMP] then {
+     set OBJDUMP $objdump
+ }
+
+ if ![info exists OBJDUMPFLAGS] then {
+     set OBJDUMPFLAGS {}
+ }
+
+ if ![info exists NM] then {
+     set NM $nm
+ }
+
+ if ![info exists NMFLAGS] then {
+     set NMFLAGS {}
+ }
+
+ if ![info exists OBJCOPY] then {
+     set OBJCOPY $objcopy
+ }
+
+ if ![info exists OBJCOPYFLAGS] then {
+     set OBJCOPYFLAGS {}
+ }
+
+ if ![info exists READELF] then {
+     set READELF [findfile $base_dir/../binutils/readelf]
+ }
+
+ if ![info exists READELFFLAGS] then {
+     set READELFFLAGS {}
+ }
+
+ if ![info exists LD] then {
+     set LD [findfile $base_dir/ld-new ./ld-new [transform ld]]
+ }
+
+ if ![info exists LDFLAGS] then {
+     set LDFLAGS {}
+ }

brgds, H-P