Hi,
A while ago Tim asked me to create a test for the treelang front
end accepting tabs in source code. Unfortunatly, the treelang
testsuite didn't act like the rest of the gcc testsuite. So,
instead of figuring what was going on in testsuite/treelang
I decided to allow the treelang testsuite to act like the rest
of the gcc testsuite.
What all the above means is one can now create treelang tests
and use '// { dg-do command }' and have the test do the right
thing.
Tested with make check-treelang with no failures. Ok for mainline?
Jim
2004-01-18 James A. Morrison <ja2morri@uwaterloo.ca>
* lib/treelang.exp: Fill out this file.
* lib/treelang-dg.exp: New File.
2004-01-18 James A. Morrison <ja2morri@uwaterloo.ca>
* compile/compile.exp: New File.
* compile/tabs.tree: Test whether the front end
compiles code with tabs in it.
Index: lib/treelang.exp
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/testsuite/lib/treelang.exp,v
retrieving revision 1.1
diff -u -r1.1 treelang.exp
--- lib/treelang.exp 5 May 2002 04:24:18 -0000 1.1
+++ lib/treelang.exp 19 Jan 2004 05:48:47 -0000
@@ -1,4 +1,5 @@
-# Copyright (C) 1988, 90, 91, 92, 95, 96, 1997, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
+# Copyright (C) 1992, 1993, 1994, 1996, 1997, 2000, 2001, 2002, 2004
+# Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
@@ -14,7 +15,269 @@
# along with this program; if not, write to the Free Software
# Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+# This file was written by Rob Savoye (rob@cygnus.com)
+# Currently maintained by James A. Morrison (ja2morri@uwaterloo.ca)
+
# Having this file here magically tells dejagnu that the treelang
# directory is worthy of testing
+# This file is basically treelang.exp with treelang replaced with treelang.
+
+# This file is loaded by the tool init file (eg: unix.exp). It provides
+# default definitions for treelang_start, etc. and other supporting cast members.
+
+# These globals are used by treelang_start if no compiler arguments are provided.
+# They are also used by the various testsuites to define the environment:
+# where to find stdio.h, libc.a, etc.
+
+load_lib libgloss.exp
+load_lib prune.exp
+load_lib gcc-defs.exp
+
+#
+# TREELANG_UNDER_TEST is the compiler under test.
+#
+
+#
+# default_treelang_version -- extract and print the version number of the compiler
+#
+
+proc default_treelang_version { } {
+ global TREELANG_UNDER_TEST
+
+ treelang_init;
+
+ # ignore any arguments after the command
+ set compiler [lindex $TREELANG_UNDER_TEST 0]
+
+ if ![is_remote host] {
+ set compiler_name [which $compiler];
+ } else {
+ set compiler_name $compiler;
+ }
+
+ # verify that the compiler exists
+ if { $compiler_name != 0 } then {
+ set tmp [remote_exec host "$compiler -v"]
+ set status [lindex $tmp 0];
+ set output [lindex $tmp 1];
+ regexp "version\[^\n\r\]*" $output version
+ if { $status == 0 && [info exists version] } then {
+ clone_output "$compiler_name $version\n"
+ } else {
+ clone_output "Couldn't determine version of $compiler_name: $output\n"
+ }
+ } else {
+ # compiler does not exist (this should have already been detected)
+ warning "$compiler does not exist"
+ }
+}
+
+# treelang_init -- called at the start of each .exp script.
+#
+# There currently isn't much to do, but always using it allows us to
+# make some enhancements without having to go back and rewrite the scripts.
+#
+
+set treelang_initialized 0
+
+proc treelang_init { args } {
+ global rootme
+ global tmpdir
+ global libdir
+ global gluefile wrap_flags
+ global treelang_initialized
+ global TREELANG_UNDER_TEST
+ global TOOL_EXECUTABLE
+ global treelang_libgcc_s_path
+
+ if { $treelang_initialized == 1 } { return; }
+
+ if ![info exists TREELANG_UNDER_TEST] then {
+ if [info exists TOOL_EXECUTABLE] {
+ set TREELANG_UNDER_TEST $TOOL_EXECUTABLE;
+ } else {
+ set TREELANG_UNDER_TEST [find_gcc]
+ }
+ }
+
+ if ![info exists tmpdir] then {
+ set tmpdir /tmp
+ }
+ if { [target_info needs_status_wrapper]!="" && ![info exists gluefile] } {
+ set gluefile ${tmpdir}/treelang-testglue.o;
+ set result [build_wrapper $gluefile];
+ if { $result != "" } {
+ set gluefile [lindex $result 0];
+ set wrap_flags [lindex $result 1];
+ } else {
+ unset gluefile
+ }
+ }
+
+ set treelang_libgcc_s_path "${rootme}"
+ set compiler [lindex $TREELANG_UNDER_TEST 0]
+ if { [is_remote host] == 0 && [which $compiler] != 0 } {
+ foreach i "[exec $compiler --print-multi-lib]" {
+ set mldir ""
+ regexp -- "\[a-z0-9=/\.-\]*;" $i mldir
+ set mldir [string trimright $mldir "\;@"]
+ if { "$mldir" == "." } {
+ continue
+ }
+ if { [llength [glob -nocomplain ${rootme}/${mldir}/libgcc_s*.so.*]] == 1 } {
+ append treelang_libgcc_s_path ":${rootme}/${mldir}"
+ }
+ }
+ }
+}
+
+proc treelang_target_compile { source dest type options } {
+ global rootme;
+ global tmpdir;
+ global gluefile wrap_flags;
+ global srcdir
+ global TREELANG_UNDER_TEST
+ global TOOL_OPTIONS
+ global ld_library_path
+ global treelang_libgcc_s_path
+
+ set ld_library_path ".:${treelang_libgcc_s_path}"
+ lappend options "libs=-ltreelang"
+
+ if { [target_info needs_status_wrapper]!="" && [info exists gluefile] } {
+ lappend options "libs=${gluefile}"
+ lappend options "ldflags=$wrap_flags"
+ }
+
+ # TOOL_OPTIONS must come first, so that it doesn't override testcase
+ # specific options.
+ if [info exists TOOL_OPTIONS] {
+ set options [concat "additional_flags=$TOOL_OPTIONS" $options];
+ }
+
+ # If we have built libtreelang along with the compiler (which usually
+ # _is not_ the case on Mac OS X systems), point the test harness
+ # at it (and associated headers).
+
+ return [target_compile $source $dest $type $options]
+}
+
+#
+# treelang_pass -- utility to record a testcase passed
+#
+
+proc treelang_pass { testcase cflags } {
+ if { "$cflags" == "" } {
+ pass "$testcase"
+ } else {
+ pass "$testcase, $cflags"
+ }
+}
+
+#
+# treelang_fail -- utility to record a testcase failed
+#
+
+proc treelang_fail { testcase cflags } {
+ if { "$cflags" == "" } {
+ fail "$testcase"
+ } else {
+ fail "$testcase, $cflags"
+ }
+}
+
+#
+# treelang_finish -- called at the end of every .exp script that calls treelang_init
+#
+# The purpose of this proc is to hide all quirks of the testing environment
+# from the testsuites. It also exists to undo anything that treelang_init did
+# (that needs undoing).
+#
+
+proc treelang_finish { } {
+ # The testing harness apparently requires this.
+ global errorInfo;
+
+ if [info exists errorInfo] then {
+ unset errorInfo
+ }
+
+ # Might as well reset these (keeps our caller from wondering whether
+ # s/he has to or not).
+ global prms_id bug_id
+ set prms_id 0
+ set bug_id 0
+}
+
+proc treelang_exit { } {
+ global gluefile;
+
+ if [info exists gluefile] {
+ file_on_build delete $gluefile;
+ unset gluefile;
+ }
+}
+
+# If this is an older version of dejagnu (without runtest_file_p),
+# provide one and assume the old syntax: foo1.exp bar1.c foo2.exp bar2.c.
+# This can be deleted after next dejagnu release.
+
+if { [info procs runtest_file_p] == "" } then {
+ proc runtest_file_p { runtests testcase } {
+ if { $runtests != "" && [regexp "\[.\]\[cC\]" $runtests] } then {
+ if { [lsearch $runtests [file tail $testcase]] >= 0 } then {
+ return 1
+ } else {
+ return 0
+ }
+ }
+ return 1
+ }
+}
+
+# Provide a definition of this if missing (delete after next dejagnu release).
+
+if { [info procs prune_warnings] == "" } then {
+ proc prune_warnings { text } {
+ return $text
+ }
+}
+
+# Utility used by mike-gcc.exp and c-torture.exp.
+# Check the compiler(/assembler/linker) output for text indicating that
+# the testcase should be marked as "unsupported".
+#
+# When dealing with a large number of tests, it's difficult to weed out the
+# ones that are too big for a particular cpu (eg: 16 bit with a small amount
+# of memory). There are various ways to deal with this. Here's one.
+# Fortunately, all of the cases where this is likely to happen will be using
+# gld so we can tell what the error text will look like.
+
+proc ${tool}_check_unsupported_p { output } {
+ if [regexp "(^|\n)\[^\n\]*: region \[^\n\]* is full" $output] {
+ return "memory full"
+ }
+ return ""
+}
+
+# Prune messages from treelang that aren't useful.
+
+proc prune_treelang_output { text } {
+ #send_user "Before:$text\n"
+ regsub -all "(^|\n)\[^\n\]*: In (function|method) \[^\n\]*" $text "" text
+ regsub -all "(^|\n)\[^\n\]*: At top level:\[^\n\]*" $text "" text
+
+ # It would be nice to avoid passing anything to treelang that would cause it to
+ # issue these messages (since ignoring them seems like a hack on our part),
+ # but that's too difficult in the general case. For example, sometimes
+ # you need to use -B to point treelang at crt0.o, but there are some targets
+ # that don't have crt0.o.
+ regsub -all "(^|\n)\[^\n\]*file path prefix \[^\n\]* never used" $text "" text
+ regsub -all "(^|\n)\[^\n\]*linker input file unused since linking not done" $text "" text
+
+ #send_user "After:$text\n"
+
+ return $text
+}
--- /dev/null 2004-01-11 20:18:29.000000000 -0500
+++ lib/treelang-dg.exp 2004-01-18 19:49:13.000000000 -0500
@@ -0,1 +1,37 @@
+# Copyright (C) 1997, 1999, 2000, 2001, 2003, 2004
+# Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+load_lib gcc-dg.exp
+
+# Define gcc callbacks for dg.exp.
+
+proc treelang-dg-test { prog do_what extra_tool_flags } {
+ return [gcc-dg-test-1 treelang_target_compile $prog $do_what $extra_tool_flags]
+}
+
+proc treelang-dg-prune { system text } {
+ return [gcc-dg-prune $system $text]
+}
+
+# Utility routines.
+
+# Modified dg-runtest that can cycle through a list of optimization options
+# as c-torture does.
+proc treelang-dg-runtest { testcases default-extra-flags } {
+ return [gcc-dg-runtest $testcases ${default-extra-flags}]
+}
--- /dev/null 2004-01-11 20:18:29.000000000 -0500
+++ treelang/compile/compile.exp 2004-01-19 00:45:38.000000000 -0500
@@ -0,1 +1,32 @@
+# Tests for treelang; run from gcc/treelang/Make-lang.in => gcc/Makefile
+
+# Copyright (C) 2004 by The Free Software Foundation
+
+# This program is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by the
+# Free Software Foundation; either version 2, or (at your option) any
+# later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+#
+# In other words, you are welcome to use, share and improve this program.
+# You are forbidden to forbid anyone else to use, share and improve
+# what you give them. Help stamp out software-hoarding!
+
+# Treelang tests that only need to compile.
+
+# Load support procs.
+load_lib treelang-dg.exp
+
+dg-init
+dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/*.tree]] "" ""
+dg-finish
--- /dev/null 2004-01-11 20:18:29.000000000 -0500
+++ treelang/compile/tabs.tree 2004-01-19 00:27:59.000000000 -0500
@@ -0,1 +1,12 @@
+// { dg-do compile }
+external_definition int main(int argc);
+
+main {
+ automatic int v1;
+ automatic int v2;
+ v1 = argc;
+ v2 = 3;
+
+ return v2;
+}