[PATCH] Detect frame size overflow (2)

[James A. Morrison]

Eric Botcazou <ebotcazou@adacore.com> writes:

>> This is OK for mainline.
>
> Thanks for the quick review.
>
>> I was wondering whether it would be possible to add a new gnat.dg/
>> subdirectory to the current dejagnu testing infrastructure?  I notice
>> that you even provide a nice Ada testcase with your posting, but
>> because GCC's Ada testing currently just tracks the "official" ACATS
>> testsuite, its difficult to add new tests not covered by ACATS
>> functionality.
>
> Absolutely. Long overdue. Laziness. Thanks for the sting. :-)
>
>> Over the years hundreds of Ada test cases have been posted to gcc-patches,
>> only to be lost to the mailing list archives.
>
> "Hundreds" is a bit of an overstatement, "dozens" is more realistic I'd think.
> I'll make a pass over the archives and try to rescue as many of them as I can.

 I've got about 250 emails to gcc-patches saved.  Most of those have test
cases, but some are simply links to a new standard.  I've also got a cvs
checkout with 50-100 tests, I think these are all attached to the bugzilla
bug.  So hundreds is accurate.

>
>
> I've attached the skeleton of the harness for gnat.dg.  Very limited for the 
> time being, as it only supports dg-compile (and dg-assemble).  Tested on 
> x86/Linux and x86-64/Linux.

 Have you tried dg-do { run } on any testcase?  I think this change should
go in once dg-do { run } also works.  I took a look at my old patch, in
ada.dg, I've got ada_{pass,fail,finish} functions, are those functions
superfluous?

> 2006-03-11  Eric Botcazou  <ebotcazou@adacore.com>
>
> ada/
> 	* Make-lang.in: Add check-gnat to lang_checks.
> 	Rename existing check-gnat into check-acats.
>
> testsuite/
>
> 	* lib/gnat.exp: New driver.
> 	* lib/gnat-dg.exp: Likewise.
> 	* gnat.dg: New directory.
> 	* gnat.dg/dg.exp: New driver.
> 	* gnat.dg/frame_overflow.adb: New test.
>
>
> -- 
> Eric Botcazou
>
> Index: Make-lang.in
> ===================================================================
> --- Make-lang.in	(revision 111926)
> +++ Make-lang.in	(working copy)
> @@ -818,16 +818,18 @@ ada.stagefeedback: stagefeedback-start
>  	-$(MV) ada/*$(objext) ada/*.ali ada/b_*.c stagefeedback/ada
>  	-$(MV) ada/stamp-* stagefeedback/ada
>  
> -check-ada: check-gnat
> +lang_checks += check-gnat
> +
> +check-ada: check-acats check-gnat
>  
>  ACATSDIR = $(TESTSUITEDIR)/ada/acats
>  
> -check-gnat:
> +check-acats:
>  	test -d $(ACATSDIR) || mkdir -p $(ACATSDIR)
>  	testdir=`cd ${srcdir}/${ACATSDIR}; ${PWD_COMMAND}`; \
>  	export testdir; cd $(ACATSDIR); $(SHELL) $${testdir}/run_acats $(CHAPTERS)
>  
> -.PHONY: check-gnat
> +.PHONY: check-acats
>  
>  
>  # Bootstrapping targets for just GNAT - use the same stage directories
>
> # Copyright (C) 2006 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, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
>
> load_lib libgloss.exp
> load_lib prune.exp
> load_lib gcc-defs.exp
>
> #
> # GNAT_UNDER_TEST is the compiler under test.
> #
>
> #
> # default_gnat_version -- extract and print the version number of the compiler
> #
>
> proc default_gnat_version { } {
>     global GNAT_UNDER_TEST
>
>     gnat_init
>
>     # ignore any arguments after the command
>     set compiler [lindex $GNAT_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"
>     }
> }
>
> #
> # gnat_version -- Call default_gnat_version, so we can override it if needed.
> #
>
> proc gnat_version { } {
>     default_gnat_version
> }
>
> #
> # gnat_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.
> #
>
> proc gnat_init { args } {
>     global tmpdir
>     global base_dir
>     global GNAT_UNDER_TEST
>     global TOOL_EXECUTABLE
>     global TESTING_IN_BUILD_TREE
>
>     if ![info exists GNAT_UNDER_TEST] then {
> 	if [info exists TOOL_EXECUTABLE] {
> 	    set GNAT_UNDER_TEST $TOOL_EXECUTABLE;
> 	} else {
> 	    if { [is_remote host] || ! [info exists TESTING_IN_BUILD_TREE] } {
> 		set GNAT_UNDER_TEST "[find_gcc]"
> 	    } else {
> 		set GNAT_UNDER_TEST "[find_gcc] -I$base_dir/../../ada/rts"
> 	    }
> 	}
>     }
>
>     if ![info exists tmpdir] then {
> 	set tmpdir /tmp
>     }
> }
>
> #
> # gnat_target_compile -- compile a source file
> #
>
> proc gnat_target_compile { source dest type options } {
>     global tmpdir
>     global GNAT_UNDER_TEST
>     global TOOL_OPTIONS
>
>     # 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]
>     }
>     lappend options "compiler=$GNAT_UNDER_TEST"
>     set options [dg-additional-files-options $options $source]
>     return [target_compile $source $dest $type $options]
> }
>
> # Copyright (C) 2006 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  
>
> # Define gnat callbacks for dg.exp.
>
> load_lib gcc-dg.exp
>
> proc gnat-dg-test { prog do_what extra_tool_flags } {
>     return [gcc-dg-test-1 gnat_target_compile $prog $do_what $extra_tool_flags]
> }
>
>
> proc gnat-dg-prune { system text } {
>     return [gcc-dg-prune $system $text]
> }
>
> # GCC Ada testsuite that uses the `dg.exp' driver.
> # Copyright (C) 2006 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  
>
> # Load support procs.
> load_lib gnat-dg.exp
>
> # If a testcase doesn't have special options, use these.
> #  -gnatwZ: turn off size/align warnings for unchecked conversion
> global DEFAULT_ADAFLAGS
> if ![info exists DEFAULT_ADAFLAGS] then {
>     set DEFAULT_ADAFLAGS " -gnatwZ"
> }
>
> # Initialize `dg'.
> dg-init
>
> # Gather a list of all tests.
> set tests [lsort [find $srcdir/$subdir *.adb]]
>
> # Main loop.
> dg-runtest $tests "" $DEFAULT_ADAFLAGS
>
> # All done.
> dg-finish
>
> -- { dg-do compile }
>
> procedure frame_overflow is
>
>    type Bitpos_Range_T is new Positive;
>    type Bitmap_Array_T is array (Bitpos_Range_T) of Boolean;
>
>    type Bitmap_T is record
>       Bits : Bitmap_Array_T := (others => False);
>    end record;
>    
>    function -- { dg-error "too large" "" { target ilp32 } }
>      Set_In (Bitmap : Bitmap_T; Bitpos : Bitpos_Range_T)  return Bitmap_T
>    is
>       Result: Bitmap_T := Bitmap;
>    begin
>       Result.Bits (Bitpos) := True;
>       return Result;
>    end;
>
>    function -- { dg-error "too large" "" { target ilp32 } }
>      Negate (Bitmap : Bitmap_T) return Bitmap_T is
>       Result: Bitmap_T;
>    begin
>       for E in Bitpos_Range_T loop
> 	 Result.Bits (E) := not Bitmap.Bits (E);
>       end loop;
>       return Result;
>   end;
>
> begin
>    null;
> end;

-- 
Thanks,
Jim

http://www.csclub.uwaterloo.ca/~ja2morri/
http://phython.blogspot.com
http://open.nit.ca/wiki/?page=jim