FDO insane profile

[official-gcc.git] / libjava / testsuite / libjava.mauve / mauve.exp

# Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation.
# Written by Tom Tromey <tromey@cygnus.com>.
# Incorporate Mauve into libjava's DejaGNU test suite framework.

# FIXME: should be able to compile from source as well as from .class.


# Compute list of files to compile.  Returns list of all files
# representing classes that must be tested.  Result parameter `uses'
# maps source file names onto list of objects required for link.
proc mauve_compute_uses {aName} {
  upvar $aName uses
  global env runtests

  set fd [open classes r]
  set line [read $fd]
  close $fd

  foreach item [split $line] {
    if {$item == ""} then {
      continue
    }
    set item [join [split $item .] /].java

    # User might have specified "mauve.exp=something.java".
    if {! [runtest_file_p $runtests $item]} {
      continue
    }

    # Look for Uses line in source file.
    set fd [open $env(MAUVEDIR)/$item r]
    set ufiles [list $item]
    set dir [file dirname $item]
    while {[gets $fd sline] != -1} {
      if {[regsub -- {^// Uses:} $sline {} sline]} then {
        foreach uf [split $sline] {
          if {$uf != ""} then {
            lappend ufiles $dir/$uf
          }
        }
      }
    }
    close $fd

    set uses($item) {}
    foreach file $ufiles {
      set file [file rootname $file].o
      lappend uses($item) $file
      # Now add all inner classes
      foreach inner [glob -nocomplain [file rootname $file]$*.class] {
        # Prevent excessive escaping by replacing $ with a ^ in the .o name
        set inner [file rootname $inner].o
        regsub -all "\\$" $inner "\^" inner
        lappend uses($item) $inner
      }
    }
  }

  return [lsort [array names uses]]
}

# Find Mauve sources.  At end, env(MAUVEDIR) points to sources.
# Returns 0 if sources not found, 1 otherwise.
proc find_mauve_sources {} {
  global env srcdir

  if {[info exists env(MAUVEDIR)]} {
    return 1
  } elseif {[file isdirectory $srcdir/libjava.mauve/mauve]} {
    set env(MAUVEDIR) $srcdir/libjava.mauve/mauve
    return 1
  }

  return 0
}

# Find all the harness files and return a list of them, with no
# suffix.
proc mauve_find_harness_files {} {
  set result {}
  foreach file [glob -nocomplain -- *.class gnu/testlet/*.class] {
    lappend result [file root $file]
  }
  return $result
}

# Run all the Mauve tests.  Return 1 on success, 0 on any failure.  If
# the tests are skipped, that is treated like success.
proc test_mauve {} {
  global srcdir objdir subdir env

  if {! [find_mauve_sources]} then {
    verbose "MAUVEDIR not set; not running Mauve tests"
    return 1
  }

  # Run in subdir so we don't overwrite our own Makefile.
  catch {system "rm -rf mauve-build"}
  file mkdir mauve-build
  # Some weirdness to set srcdir correctly.
  set here [pwd]
  cd $srcdir
  set full_srcdir [pwd]
  cd $here/mauve-build

  global env libgcj_jar
  global GCJ_UNDER_TEST
  global TOOL_EXECUTABLE

  if ![info exists GCJ_UNDER_TEST] {
    if [info exists TOOL_EXECUTABLE] {
      set GCJ_UNDER_TEST $TOOL_EXECUTABLE;
    } else {
      if [info exists env(GCJ)] {
        set GCJ_UNDER_TEST env(GCJ)
      } else {
        set GCJ_UNDER_TEST "[find_gcj]"
      }
    }
  }

  # Append -B and -I so that libgcj.spec and libgcj.jar are found
  # before they're installed.
  # Append -Wno-deprecated since Mauve tests lots of deprecated stuff.
  set env(GCJ) "$GCJ_UNDER_TEST -Wno-deprecated -B$objdir/../ -I$libgcj_jar"

  if {[catch {
    system "$env(MAUVEDIR)/configure --with-gcj 2>&1"
  } msg]} then {
    fail "Mauve configure"
    verbose "configure failed with $msg"
    return 0
  }
  pass "Mauve configure"

  # Copy appropriate tags file locally.
  set fd [open $full_srcdir/../mauve-libgcj r]
  set c [read $fd]
  close $fd
  set fd [open mauve-libgcj w]
  puts -nonewline $fd $c
  close $fd

  catch {system "ln -s $full_srcdir/libjava.mauve/xfails xfails"}

  if {[catch {
    system "make KEYS=libgcj classes.stamp 2>&1"
  } msg]} then {
    fail "Mauve build"
    verbose "build failed with $msg"
    return 0
  }
  pass "Mauve build"

  set srcfile $full_srcdir/$subdir/DejaGNUTestHarness.java
  if {! [bytecompile_file $srcfile [pwd] $env(MAUVEDIR):[pwd]]} then {
    fail "Compile DejaGNUTestHarness.java"
    return 0
  }
  pass "Compile DejaGNUTestHarness.java"

  # Compute list of files to test, and also all files to build.
  set choices [mauve_compute_uses uses]

  # Compute flags to use to do the build.
  set compile_args [libjava_arguments]
  set link_args [concat [libjava_arguments link] \
                   [list "additional_flags=--main=DejaGNUTestHarness"]]

  if {[string match "*libtool*" $compile_args]} {
    set objext lo
  } else {
    set objext o
  }

  set ok 1
  set objlist {}
  foreach base [mauve_find_harness_files] {
    set file $base.class
    set obj $base.$objext
    set x [libjava_prune_warnings \
             [target_compile [pwd]/$file $obj object $compile_args]]
    if {$x != ""} then {
      fail "Compile $obj"
      set ok 0
    } else {
      pass "Compile $obj"
    }
    lappend objlist $obj
  }
  if {! $ok} then {
    return 0
  }

  set proc_ok 1
  set Executable DejaGNUTestHarness
  foreach file $choices {
    # Turn `java/lang/Foo.java' into `java.lang.Foo'.
    set class [file rootname $file]
    regsub -all -- / $class . class

    set ok 1
    set this_olist {}
    foreach obj $uses($file) {
      set obj [file rootname $obj].$objext
      lappend this_olist $obj
      if {! [file exists $obj]} then {
        verbose "compiling $obj for test of $class"
        # The .class file does contain a $, but we can quote it between "'"s.
        set srcfile [file rootname $obj].class
        regsub -all "\\^" $srcfile "\$" srcfile
        set x [libjava_prune_warnings \
                 [libjava_tcompile '[pwd]/$srcfile' $obj object $compile_args]]
        if {$x != ""} then {
          fail "Compile $obj for $class"
          set ok 0
          break
        }
        pass "Compile $obj for $class"
      }
    }
    if {! $ok} then {
      set proc_ok 0
      continue
    }

    set x [libjava_prune_warnings \
             [libjava_tcompile [concat $this_olist $objlist] \
                $Executable executable $link_args]]
    if {$x != ""} then {
      set proc_ok 0
      fail "Link for $class"
      continue
    }
    pass "Link for $class"

    set result [libjava_load [pwd]/DejaGNUTestHarness \
                  "$env(MAUVEDIR) $class" ""]

    # Extract pass/failure info from output.
    foreach line [split [lindex $result 1] \n] {
      if {[regexp -- {^(PASS|FAIL|XFAIL|XPASS): (.*)$} $line ignore what msg]} then {
        if {$what == "XFAIL" || $what == "XPASS"} then {
          setup_xfail *-*-*
        }
        if {$what == "PASS" || $what == "XPASS"} then {
          pass $msg
        } else {
          set proc_ok 0
          fail $msg
        }
      }
    }
  }

  return $proc_ok
}

# Run all the Mauve tests in a sim environment.  In this case, the
# program cannot use argv[] because there's no way to pass in the
# command line, so tha name of the class to test is substituted by
# patching the source of the DejaGNUTestHarness.  Return 1 on success,
# 0 on any failure.  If the tests are skipped, that is treated like
# success.
proc test_mauve_sim {} {
  global srcdir subdir env

  if {! [find_mauve_sources]} then {
    verbose "MAUVEDIR not set; not running Mauve tests"
    return 1
  }

  # Run in subdir so we don't overwrite our own Makefile.
  catch {system "rm -rf mauve-build"}
  file mkdir mauve-build
  # Some weirdness to set srcdir correctly.
  set here [pwd]
  cd $srcdir
  set full_srcdir [pwd]
  cd $here/mauve-build

  if {[catch {
    system "$env(MAUVEDIR)/configure --with-gcj 2>&1"
  } msg]} then {
    fail "Mauve configure"
    verbose "configure failed with $msg"
    return 0
  }
  pass "Mauve configure"

  # Copy appropriate tags file locally.
  set fd [open $full_srcdir/../mauve-libgcj r]
  set c [read $fd]
  close $fd
  set fd [open mauve-libgcj w]
  puts -nonewline $fd $c
  close $fd

  catch {system "ln -s $full_srcdir/libjava.mauve/xfails xfails"}

  if {[catch {
    system "make KEYS=libgcj classes.stamp 2>&1"
  } msg]} then {
    fail "Mauve build"
    verbose "build failed with $msg"
    return 0
  }
  pass "Mauve build"

  # Compute list of files to test, and also all files to build.
  set choices [mauve_compute_uses uses]

  # Compute flags to use to do the build.
  set compile_args [libjava_arguments]
  set link_args [concat [libjava_arguments link] \
                   [list "additional_flags=--main=DejaGNUTestHarness"]]

  set ok 1
  set objlist {}
  foreach base [mauve_find_harness_files] {
    set file $base.class
    set obj $base.o
    set x [libjava_prune_warnings \
             [target_compile [pwd]/$file $obj object $compile_args]]
    if {$x != ""} then {
      fail "Compile $obj"
      set ok 0
    } else {
      pass "Compile $obj"
    }
    lappend objlist $obj
  }
  if {! $ok} then {
    return 0
  }

  set proc_ok 1
  set Executable DejaGNUTestHarness
  foreach file $choices {
    # Turn `java/lang/Foo.java' into `java.lang.Foo'.
    
    set class [file rootname $file]
    regsub -all -- / $class . class

    set ok 1
    foreach obj $uses($file) {
      if {! [file exists $obj]} then {
        verbose "compiling $obj for test of $class"
        set srcfile [file rootname $obj].class
        set x [libjava_prune_warnings \
                 [target_compile [pwd]/$srcfile $obj object $compile_args]]
        if {$x != ""} then {
          fail "Compile $obj for $class"
          set ok 0
          break
        }
        pass "Compile $obj for $class"
      }
    }
    if {! $ok} then {
      set proc_ok 0
      continue
    }

    set infile $full_srcdir/$subdir/DejaGNUTestHarness.java
    set srcfile DejaGNUTestHarness.java
    set f [open $infile r]
    set d [open gnu/testlet/$srcfile w]
    while {[gets $f line] >= 0} {
        if [regexp {harness\.runtest \(args\[1\]\)} $line] then {
            regsub {args\[1\]} $line "\"$class\"" out
        } else {
            set out $line
        }
        puts $d $out
    }
    close $f
    close $d

    if {! [bytecompile_file [pwd]/gnu/testlet/$srcfile [pwd]/gnu/testlet \
               $env(MAUVEDIR):[pwd]]} then {
        fail "Compile DejaGNUTestHarness.java"
        return 0
    }

    set x [libjava_prune_warnings \
             [target_compile DejaGNUTestHarness.class \
                DejaGNUTestHarness.o object $compile_args]]
    if {$x != ""} then {
        fail "Compile DejaGNUTestHarness.java"
        set proc_ok 0
        continue
    }

    set x [libjava_prune_warnings \
             [target_compile [concat $uses($file) $objlist] \
                $Executable executable $link_args]]
    if {$x != ""} then {
      set proc_ok 0
      fail "Link for $class"
      continue
    }
    pass "Link for $class"

    set result [libjava_load [pwd]/DejaGNUTestHarness \
                  "$env(MAUVEDIR) $class" ""]

    # Extract pass/failure info from output.
    foreach line [split [lindex $result 1] \n] {
      if {[regexp -- {^(PASS|FAIL|XFAIL|XPASS): (.*)$} $line ignore what msg]} then {
        if {$what == "XFAIL" || $what == "XPASS"} then {
          setup_xfail *-*-*
        }
        if {$what == "PASS" || $what == "XPASS"} then {
          pass $msg
        } else {
          set proc_ok 0
          fail $msg
        }
      }
    }
  }

  return $proc_ok
}

proc gcj_run_mauve_tests {} {
  # The test_mauve* procs will change the current directory.  It's
  # simpler to fix this up here than to keep track of this in the
  # procs.
  set here [pwd]
  if { [board_info target exists is_simulator] } {
    set r [test_mauve_sim]
  } else {
    set r [test_mauve]
  }
  cd $here

  if {$r} {
    # No need to keep the build around.  FIXME: this knows how the
    # tests work.  This whole file could use a rewrite.
    system "rm -rf mauve-build"
  }
}

gcj_run_mauve_tests