This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

PATCH: Remove *-dg code duplication


For no good reason whatsoever, all of the *-dg.exp drivers contained
huge amounts of duplicated code.

Tested on i686-pc-linux-gnu, applied on the mainline.

--
Mark Mitchell
CodeSourcery, LLC
mark@codesourcery.com

2003-05-16  Mark Mitchell  <mark@codesourcery.com>

	* lib/gcc-dg.exp (gcc-dg-test): Rename to ...
	(gcc-dg-test-1): ... this.  Add target_compile parameter.  Add
	support for "repo" mode.
	* lib/g++-dg.exp: Use gcc-dg.exp to implement all functionality.
	* lib/g77-dg.exp: Likewise.
	* lib/obj-dg.exp: Likewise.
	
Index: lib/g++-dg.exp
===================================================================
RCS file: /cvs/gcc/gcc/gcc/testsuite/lib/g++-dg.exp,v
retrieving revision 1.9
diff -c -5 -p -r1.9 g++-dg.exp
*** lib/g++-dg.exp	1 May 2003 02:02:32 -0000	1.9
--- lib/g++-dg.exp	16 May 2003 18:56:14 -0000
***************
*** 14,113 ****
  # along with this program; if not, write to the Free Software
  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
  
  # Define g++ callbacks for dg.exp.
  
! load_lib dg.exp
! load_lib file-format.exp
! load_lib target-supports.exp
! load_lib scanasm.exp
  
  proc g++-dg-test { prog do_what extra_tool_flags } {
!     # Set up the compiler flags, based on what we're going to do.
! 
!     set options [list]
! 
!     # Tests should be able to use "dg-do repo".  However, the dg test
!     # driver checks the argument to dg-do against a list of acceptable
!     # options, and "repo" is not among them.  Therefore, we resort to
!     # this ugly approach.
!     if [string match "*-frepo*" $extra_tool_flags] then {
! 	set do_what "repo"
!     }
! 
!     switch $do_what {
! 	"preprocess" {
! 	    set compile_type "preprocess"
! 	    set output_file "[file rootname [file tail $prog]].i"
! 	}
! 	"compile" {
! 	    set compile_type "assembly"
! 	    set output_file "[file rootname [file tail $prog]].s"
! 	}
! 	"assemble" {
! 	    set compile_type "object"
! 	    set output_file "[file rootname [file tail $prog]].o"
! 	}
! 	"precompile" {
! 	    set compile_type "precompiled_header"
! 	    set output_file "[file tail $prog].gch"
! 	}
! 	"link" {
! 	    set compile_type "executable"
! 	    set output_file "[file rootname [file tail $prog]].exe"
! 	    # The following line is needed for targets like the i960 where
! 	    # the default output file is b.out.  Sigh.
! 	}
! 	"repo" {
! 	    set compile_type "object"
! 	    set output_file "[file rootname [file tail $prog]].o"
! 	}
! 	"run" {
! 	    set compile_type "executable"
! 	    # FIXME: "./" is to cope with "." not being in $PATH.
! 	    # Should this be handled elsewhere?
! 	    # YES.
! 	    set output_file "./[file rootname [file tail $prog]].exe"
! 	    # This is the only place where we care if an executable was
! 	    # created or not.  If it was, dg.exp will try to run it.
! 	    remote_file build delete $output_file;
! 	}
! 	default {
! 	    perror "$do_what: not a valid dg-do keyword"
! 	    return ""
! 	}
!     }
! 
!     if { $extra_tool_flags != "" } {
! 	lappend options "additional_flags=$extra_tool_flags"
!     }
! 
!     set comp_output [g++_target_compile "$prog" "$output_file" "$compile_type" $options];
! 
!     if { $do_what == "repo" } {
! 	set object_file "$output_file"
! 	set output_file "[file rootname [file tail $prog]].exe"
! 	concat comp_output \
! 	       [g++_target_compile "$object_file" "$output_file" "executable" $options]
!     }
! 
!     return [list $comp_output $output_file]
  }
  
  
  proc g++-dg-prune { system text } {
!     set text [prune_gcc_output $text]
! 
!     # If we see "region xxx is full" then the testcase is too big for ram.
!     # This is tricky to deal with in a large testsuite like c-torture so
!     # deal with it here.  Just mark the testcase as unsupported.
!     if [regexp "(^|\n)\[^\n\]*: region \[^\n\]* is full" $text] {
! 	# The format here is important.  See dg.exp.
! 	return "::unsupported::memory full"
!     }
! 
!     return $text
  }
  
  # Record additional sources files that must be compiled along with the
  # main source file.
  
--- 14,32 ----
  # along with this program; if not, write to the Free Software
  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
  
  # Define g++ callbacks for dg.exp.
  
! load_lib gcc-dg.exp
  
  proc g++-dg-test { prog do_what extra_tool_flags } {
!     return [gcc-dg-test-1 g++_target_compile $prog $do_what $extra_tool_flags]
  }
  
  
  proc g++-dg-prune { system text } {
!     return [gcc-dg-prune $system $text]
  }
  
  # Record additional sources files that must be compiled along with the
  # main source file.
  
Index: lib/g77-dg.exp
===================================================================
RCS file: /cvs/gcc/gcc/gcc/testsuite/lib/g77-dg.exp,v
retrieving revision 1.5
diff -c -5 -p -r1.5 g77-dg.exp
*** lib/g77-dg.exp	8 Feb 2002 00:38:29 -0000	1.5
--- lib/g77-dg.exp	16 May 2003 18:56:14 -0000
***************
*** 1,6 ****
! #   Copyright (C) 1997, 1999, 2000 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.
--- 1,6 ----
! #   Copyright (C) 1997, 1999, 2000, 2003 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.
***************
*** 12,167 ****
  # 
  # 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 dg.exp
! load_lib file-format.exp
! load_lib target-supports.exp
! load_lib scanasm.exp
! load_lib prune.exp
! 
! if ![info exists TORTURE_OPTIONS] {
!     # It is theoretically beneficial to group all of the O2/O3 options together,
!     # as in many cases the compiler will generate identical executables for
!     # all of them--and the c-torture testsuite will skip testing identical
!     # executables multiple times.
!     # Also note that -finline-functions is explicitly included in one of the
!     # items below, even though -O3 is also specified, because some ports may
!     # choose to disable inlining functions by default, even when optimizing.
!     set TORTURE_OPTIONS [list \
! 	{ -O0 } \
! 	{ -O1 } \
! 	{ -O2 } \
! 	{ -O3 -fomit-frame-pointer } \
! 	{ -O3 -fomit-frame-pointer -funroll-loops } \
! 	{ -O3 -fomit-frame-pointer -funroll-all-loops -finline-functions } \
! 	{ -O3 -g } \
! 	{ -Os } ]
! }
! 
! 
! # Split TORTURE_OPTIONS into two choices: one for testcases with loops and
! # one for testcases without loops.
! 
! set torture_with_loops $TORTURE_OPTIONS
! set torture_without_loops ""
! foreach option $TORTURE_OPTIONS {
!     if ![string match "*loop*" $option] {
! 	lappend torture_without_loops $option
!     }
! }
  
  # Define g77 callbacks for dg.exp.
  
  proc g77-dg-test { prog do_what extra_tool_flags } {
!     # Set up the compiler flags, based on what we're going to do.
! 
!     switch $do_what {
! 	"preprocess" {
! 	    set compile_type "preprocess"
! 	    set output_file "[file rootname [file tail $prog]].i"
! 	}
! 	"compile" {
! 	    set compile_type "assembly"
! 	    set output_file "[file rootname [file tail $prog]].s"
! 	}
! 	"assemble" {
! 	    set compile_type "object"
! 	    set output_file "[file rootname [file tail $prog]].o"
! 	}
! 	"link" {
! 	    set compile_type "executable"
! 	    set output_file "[file rootname [file tail $prog]].exe"
! 	    # The following line is needed for targets like the i960 where
! 	    # the default output file is b.out.  Sigh.
! 	}
! 	"run" {
! 	    set compile_type "executable"
! 	    # FIXME: "./" is to cope with "." not being in $PATH.
! 	    # Should this be handled elsewhere?
! 	    # YES.
! 	    set output_file "./[file rootname [file tail $prog]].exe"
! 	    # This is the only place where we care if an executable was
! 	    # created or not.  If it was, dg.exp will try to run it.
! 	    remote_file build delete $output_file;
! 	}
! 	default {
! 	    perror "$do_what: not a valid dg-do keyword"
! 	    return ""
! 	}
!     }
!     set options ""
!     if { $extra_tool_flags != "" } {
! 	lappend options "additional_flags=$extra_tool_flags"
!     }
! 
!     set comp_output [g77_target_compile "$prog" "$output_file" "$compile_type" $options];
  
      # Put the error message on the same line as the line number
      # Remove the line of source code with the error and
      # the "     ^" that points to error
      regsub -all "\n\[^\n\]*\n *\\^\n" $comp_output "" comp_output 
  
      return [list $comp_output $output_file]
  }
  
  proc g77-dg-prune { system text } {
!     set text [prune_gcc_output $text]
! 
!     # If we see "region xxx is full" then the testcase is too big for ram.
!     # This is tricky to deal with in a large testsuite like c-torture so
!     # deal with it here.  Just mark the testcase as unsupported.
!     if [regexp "(^|\n)\[^\n\]*: region \[^\n\]* is full" $text] {
! 	# The format here is important.  See dg.exp.
! 	return "::unsupported::memory full"
!     }
! 
!     return $text
  }
  
  # Utility routines.
  
- #
- # search_for -- looks for a string match in a file
- #
- proc search_for { file pattern } {
-     set fd [open $file r]
-     while { [gets $fd cur_line]>=0 } {
- 	if [string match "*$pattern*" $cur_line] then {
- 	    close $fd
- 	    return 1
- 	}
-     }
-     close $fd
-     return 0
- }
- 
  # Modified dg-runtest that can cycle through a list of optimization options
  # as c-torture does.
  proc g77-dg-runtest { testcases default-extra-flags } {
!     global runtests
! 
!     foreach test $testcases {
! 	# If we're only testing specific files and this isn't one of 
! 	# them, skip it.
! 	if ![runtest_file_p $runtests $test] {
! 	    continue
!         }
! 
! 	# Look for a loop within the source code - if we don't find one,
! 	# don't pass -funroll[-all]-loops.
! 	global torture_with_loops torture_without_loops
! 	if [expr [search_for $test "do *\[0-9\]"]+[search_for $test "end *do"]] {
! 	    set option_list $torture_with_loops
! 	} else {
! 	    set option_list $torture_without_loops
! 	}
! 
! 	set nshort [file tail [file dirname $test]]/[file tail $test]
! 
! 	foreach flags $option_list {
! 	    verbose "Testing $nshort, $flags" 1
! 	    dg-test $test $flags ${default-extra-flags}
! 	}
!     }
  }
--- 12,46 ----
  # 
  # 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 g77 callbacks for dg.exp.
  
  proc g77-dg-test { prog do_what extra_tool_flags } {
!     set result \
! 	[gcc-dg-test-1 g77_target_compile $prog $do_what $extra_tool_flags]
!     
!     set comp_output [lindex $result 0]
!     set output_file [lindex $result 1]
  
      # Put the error message on the same line as the line number
      # Remove the line of source code with the error and
      # the "     ^" that points to error
      regsub -all "\n\[^\n\]*\n *\\^\n" $comp_output "" comp_output 
  
      return [list $comp_output $output_file]
  }
  
  proc g77-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 g77-dg-runtest { testcases default-extra-flags } {
!     return [gcc-dg-runtest $testcases ${default-extra-flags}]
  }
Index: lib/gcc-dg.exp
===================================================================
RCS file: /cvs/gcc/gcc/gcc/testsuite/lib/gcc-dg.exp,v
retrieving revision 1.13
diff -c -5 -p -r1.13 gcc-dg.exp
*** lib/gcc-dg.exp	2 Mar 2003 01:52:46 -0000	1.13
--- lib/gcc-dg.exp	16 May 2003 18:56:14 -0000
***************
*** 1,6 ****
! #   Copyright (C) 1997, 1999, 2000 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.
--- 1,6 ----
! #   Copyright (C) 1997, 1999, 2000, 2003 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.
*************** foreach option $TORTURE_OPTIONS {
*** 51,63 ****
      }
  }
  
  # Define gcc callbacks for dg.exp.
  
! proc gcc-dg-test { prog do_what extra_tool_flags } {
      # Set up the compiler flags, based on what we're going to do.
  
      switch $do_what {
  	"preprocess" {
  	    set compile_type "preprocess"
  	    set output_file "[file rootname [file tail $prog]].i"
  	}
--- 51,73 ----
      }
  }
  
  # Define gcc callbacks for dg.exp.
  
! proc gcc-dg-test-1 { target_compile prog do_what extra_tool_flags } {
      # Set up the compiler flags, based on what we're going to do.
  
+     set options [list]
+ 
+     # Tests should be able to use "dg-do repo".  However, the dg test
+     # driver checks the argument to dg-do against a list of acceptable
+     # options, and "repo" is not among them.  Therefore, we resort to
+     # this ugly approach.
+     if [string match "*-frepo*" $extra_tool_flags] then {
+ 	set do_what "repo"
+     }
+ 
      switch $do_what {
  	"preprocess" {
  	    set compile_type "preprocess"
  	    set output_file "[file rootname [file tail $prog]].i"
  	}
*************** proc gcc-dg-test { prog do_what extra_to
*** 77,86 ****
--- 87,100 ----
  	    set compile_type "executable"
  	    set output_file "[file rootname [file tail $prog]].exe"
  	    # The following line is needed for targets like the i960 where
  	    # the default output file is b.out.  Sigh.
  	}
+ 	"repo" {
+ 	    set compile_type "object"
+ 	    set output_file "[file rootname [file tail $prog]].o"
+ 	}
  	"run" {
  	    set compile_type "executable"
  	    # FIXME: "./" is to cope with "." not being in $PATH.
  	    # Should this be handled elsewhere?
  	    # YES.
*************** proc gcc-dg-test { prog do_what extra_to
*** 92,109 ****
  	default {
  	    perror "$do_what: not a valid dg-do keyword"
  	    return ""
  	}
      }
!     set options ""
      if { $extra_tool_flags != "" } {
  	lappend options "additional_flags=$extra_tool_flags"
      }
  
!     set comp_output [gcc_target_compile "$prog" "$output_file" "$compile_type" $options];
  
      return [list $comp_output $output_file]
  }
  
  proc gcc-dg-prune { system text } {
      set text [prune_gcc_output $text]
  
--- 106,134 ----
  	default {
  	    perror "$do_what: not a valid dg-do keyword"
  	    return ""
  	}
      }
! 
      if { $extra_tool_flags != "" } {
  	lappend options "additional_flags=$extra_tool_flags"
      }
  
!     set comp_output [$target_compile "$prog" "$output_file" "$compile_type" $options];
! 
!     if { $do_what == "repo" } {
! 	set object_file "$output_file"
! 	set output_file "[file rootname [file tail $prog]].exe"
! 	concat comp_output \
! 	       [$target_compile "$object_file" "$output_file" "executable" $options]
!     }
  
      return [list $comp_output $output_file]
+ }
+ 
+ proc gcc-dg-test { prog do_what extra_tool_flags } {
+     return [gcc-dg-test-1 gcc_target_compile $prog $do_what $extra_tool_flags]
  }
  
  proc gcc-dg-prune { system text } {
      set text [prune_gcc_output $text]
  
Index: lib/objc-dg.exp
===================================================================
RCS file: /cvs/gcc/gcc/gcc/testsuite/lib/objc-dg.exp,v
retrieving revision 1.2
diff -c -5 -p -r1.2 objc-dg.exp
*** lib/objc-dg.exp	22 Jan 2002 22:08:49 -0000	1.2
--- lib/objc-dg.exp	16 May 2003 18:56:14 -0000
***************
*** 1,6 ****
! #   Copyright (C) 1997, 1999, 2000, 2001 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.
--- 1,6 ----
! #   Copyright (C) 1997, 1999, 2000, 2001, 2003 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.
***************
*** 12,164 ****
  # 
  # 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 dg.exp
! load_lib file-format.exp
! load_lib target-supports.exp
! load_lib scanasm.exp
! 
! # For prune_gcc_output.
! load_lib gcc.exp
! 
! if ![info exists TORTURE_OPTIONS] {
!     # It is theoretically beneficial to group all of the O2/O3 options together,
!     # as in many cases the compiler will generate identical executables for
!     # all of them--and the c-torture testsuite will skip testing identical
!     # executables multiple times.
!     # Also note that -finline-functions is explicitly included in one of the
!     # items below, even though -O3 is also specified, because some ports may
!     # choose to disable inlining functions by default, even when optimizing.
!     set TORTURE_OPTIONS [list \
! 	{ -O0 } \
! 	{ -O1 } \
! 	{ -O2 } \
! 	{ -O3 -fomit-frame-pointer } \
! 	{ -O3 -fomit-frame-pointer -funroll-loops } \
! 	{ -O3 -fomit-frame-pointer -funroll-all-loops -finline-functions } \
! 	{ -O3 -g } \
! 	{ -Os } ]
! }
! 
! 
! # Split TORTURE_OPTIONS into two choices: one for testcases with loops and
! # one for testcases without loops.
! 
! set torture_with_loops $TORTURE_OPTIONS
! set torture_without_loops ""
! foreach option $TORTURE_OPTIONS {
!     if ![string match "*loop*" $option] {
! 	lappend torture_without_loops $option
!     }
! }
  
  # Define gcc callbacks for dg.exp.
  
  proc objc-dg-test { prog do_what extra_tool_flags } {
!     # Set up the compiler flags, based on what we're going to do.
! 
!     switch $do_what {
! 	"preprocess" {
! 	    set compile_type "preprocess"
! 	    set output_file "[file rootname [file tail $prog]].i"
! 	}
! 	"compile" {
! 	    set compile_type "assembly"
! 	    set output_file "[file rootname [file tail $prog]].s"
! 	}
! 	"assemble" {
! 	    set compile_type "object"
! 	    set output_file "[file rootname [file tail $prog]].o"
! 	}
! 	"link" {
! 	    set compile_type "executable"
! 	    set output_file "[file rootname [file tail $prog]].exe"
! 	    # The following line is needed for targets like the i960 where
! 	    # the default output file is b.out.  Sigh.
! 	}
! 	"run" {
! 	    set compile_type "executable"
! 	    # FIXME: "./" is to cope with "." not being in $PATH.
! 	    # Should this be handled elsewhere?
! 	    # YES.
! 	    set output_file "./[file rootname [file tail $prog]].exe"
! 	    # This is the only place where we care if an executable was
! 	    # created or not.  If it was, dg.exp will try to run it.
! 	    remote_file build delete $output_file;
! 	}
! 	default {
! 	    perror "$do_what: not a valid dg-do keyword"
! 	    return ""
! 	}
!     }
!     set options ""
!     if { $extra_tool_flags != "" } {
! 	lappend options "additional_flags=$extra_tool_flags"
!     }
! 
!     set comp_output [objc_target_compile "$prog" "$output_file" "$compile_type" $options];
! 
!     return [list $comp_output $output_file]
  }
  
  proc objc-dg-prune { system text } {
!     set text [prune_gcc_output $text]
! 
!     # If we see "region xxx is full" then the testcase is too big for ram.
!     # This is tricky to deal with in a large testsuite like c-torture so
!     # deal with it here.  Just mark the testcase as unsupported.
!     if [regexp "(^|\n)\[^\n\]*: region \[^\n\]* is full" $text] {
! 	# The format here is important.  See dg.exp.
! 	return "::unsupported::memory full"
!     }
! 
!     return $text
  }
  
  # Utility routines.
  
- #
- # search_for -- looks for a string match in a file
- #
- proc search_for { file pattern } {
-     set fd [open $file r]
-     while { [gets $fd cur_line]>=0 } {
- 	if [string match "*$pattern*" $cur_line] then {
- 	    close $fd
- 	    return 1
- 	}
-     }
-     close $fd
-     return 0
- }
- 
  # Modified dg-runtest that can cycle through a list of optimization options
  # as c-torture does.
  proc objc-dg-runtest { testcases default-extra-flags } {
!     global runtests
! 
!     foreach test $testcases {
! 	# If we're only testing specific files and this isn't one of 
! 	# them, skip it.
! 	if ![runtest_file_p $runtests $test] {
! 	    continue
!         }
! 
! 	# Look for a loop within the source code - if we don't find one,
! 	# don't pass -funroll[-all]-loops.
! 	global torture_with_loops torture_without_loops
! 	if [expr [search_for $test "for*("]+[search_for $test "while*("]] {
! 	    set option_list $torture_with_loops
! 	} else {
! 	    set option_list $torture_without_loops
! 	}
! 
! 	set nshort [file tail [file dirname $test]]/[file tail $test]
! 
! 	foreach flags $option_list {
! 	    verbose "Testing $nshort, $flags" 1
! 	    dg-test $test $flags ${default-extra-flags}
! 	}
!     }
  }
--- 12,35 ----
  # 
  # 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 objc-dg-test { prog do_what extra_tool_flags } {
!     return [gcc-dg-test-1 objc_target_compile $prog $do_what $extra_tool_flags]
  }
  
  proc objc-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 objc-dg-runtest { testcases default-extra-flags } {
!     return [gcc-dg-runtest $testcases ${default-extra-flags}]
  }


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]