OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

gnatvsn.ads, [...] (Get_Gnat_build_Type): Renamed Build_Type and made constant.

Browse Source 
2007-04-06  Arnaud Charlet  <charlet@adacore.com>
	    Eric Botcazou <botcazou@adacore.com>

	* gnatvsn.ads, comperr.adb (Get_Gnat_build_Type): Renamed Build_Type
	and made constant.

	* comperr.ads, comperr.adb (Compiler_Abort): Add third parameter
	Fallback_Loc. Use it as the sloc info when Current_Error_Node doesn't
	carry any.

	* fe.h (Compiler_Abort): Add third parameter.

	* misc.c (internal_error_function): Build third argument from current
	input location and pass it to Compiler_Abort.

From-SVN: r123610
This commit is contained in:
Arnaud Charlet 2007-04-06 11:41:46 +02:00
parent 737053d61e
commit 8405d93cb8
5 changed files with 58 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
gcc/ada/comperr.adb
View File

@ -71,8 +71,9 @@ package body Comperr is
--------------------
procedure Compiler_Abort
(X : String;
Code : Integer := 0)
(X : String;
Code : Integer := 0;
Fallback_Loc : String := "")
is
-- The procedures below output a "bug box" with information about
-- the cause of the compiler abort and about the preferred method
@ -96,8 +97,8 @@ package body Comperr is
Write_Eol;
end End_Line;
Is_GPL_Version : constant Boolean := Get_Gnat_Build_Type = GPL;
Is_FSF_Version : constant Boolean := Get_Gnat_Build_Type = FSF;
Is_GPL_Version : constant Boolean := Gnatvsn.Build_Type = GPL;
Is_FSF_Version : constant Boolean := Gnatvsn.Build_Type = FSF;
-- Start of processing for Compiler_Abort
@ -213,10 +214,14 @@ package body Comperr is
-- Output source location information
if Sloc (Current_Error_Node) <= Standard_Location
or else Sloc (Current_Error_Node) = No_Location
then
Write_Str ("| No source file position information available");
if Sloc (Current_Error_Node) <= No_Location then
if Fallback_Loc'Length > 0 then
Write_Str ("| Error detected around ");
Write_Str (Fallback_Loc);
else
Write_Str ("| No source file position information available");
end if;
End_Line;
else
Write_Str ("| Error detected at ");

32
gcc/ada/comperr.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -31,14 +31,18 @@
package Comperr is
procedure Compiler_Abort
(X : String;
Code : Integer := 0);
-- Signals an internal compiler error. Never returns control. Depending
-- on processing may end up raising Unrecoverable_Error, or exiting
-- directly. The message output is a "bug box" containing the
-- string passed as an argument. The node in Current_Error_Node is used
-- to provide the location where the error should be signalled. The
-- message includes the node id, and the code parameter if it is positive.
(X : String;
Code : Integer := 0;
Fallback_Loc : String := "");
-- Signals an internal compiler error. Never returns control. Depending on
-- processing may end up raising Unrecoverable_Error, or exiting directly.
-- The message output is a "bug box" containing the first string passed as
-- an argument. The Sloc field of the node in Current_Error_Node is used to
-- provide the location where the error should be signalled. If this Sloc
-- value is set to No_Location or any of the other special location values,
-- then the Fallback_Loc argument string is used instead. The message text
-- includes the node id, and the code parameter if it is positive.
--
-- Note that this is only used at the outer level (to handle constraint
-- errors or assert errors etc.) In the normal logic of the compiler we
-- always use pragma Assert to check for errors, and if necessary an
@ -64,10 +68,10 @@ package Comperr is
-- Most typically this file, if present, will be in the directory
-- containing the run-time sources.
-- If this file is present, then it is a plain ASCII file, whose
-- contents replace the remaining text. The lines in this file should be
-- 72 characters or less to avoid misformatting the right boundary of the
-- box. Note that the file does not contain the vertical bar characters or
-- any leading spaces in lines.
-- If this file is present, then it is a plain ASCII file, whose contents
-- replace the remaining text. The lines in this file should be seventy-two
-- characters or less to avoid misformatting the right boundary of the box.
-- Note that the file does not contain the vertical bar characters or any
-- leading spaces in lines.
end Comperr;

2
gcc/ada/fe.h
View File

@ -36,7 +36,7 @@
/* comperr: */
#define Compiler_Abort comperr__compiler_abort
extern int Compiler_Abort (Fat_Pointer, int) ATTRIBUTE_NORETURN;
extern int Compiler_Abort (Fat_Pointer, int, Fat_Pointer) ATTRIBUTE_NORETURN;
/* csets: */

6
gcc/ada/gnatvsn.ads
View File

@ -46,10 +46,10 @@ package Gnatvsn is
-- to e.g. pragma Ident.
type Gnat_Build_Type is (FSF, GPL);
-- See Get_Gnat_Build_Type below for the meaning of these values.
-- See Build_Type below for the meaning of these values.
function Get_Gnat_Build_Type return Gnat_Build_Type;
-- This function returns one of the following values of Gnat_Build_Type:
Build_Type : constant Gnat_Build_Type := FSF;
-- Kind of GNAT build:
--
-- FSF
-- GNAT FSF version. This version of GNAT is part of a Free Software

37
gcc/ada/misc.c
View File

@ -378,10 +378,10 @@ static void
internal_error_function (const char *msgid, va_list *ap)
{
text_info tinfo;
char *buffer;
char *p;
String_Template temp;
Fat_Pointer fp;
char *buffer, *p, *loc;
String_Template temp, temp_loc;
Fat_Pointer fp, fp_loc;
expanded_location s;
/* Reset the pretty-printer. */
pp_clear_output_area (global_dc->printer);
@ -408,8 +408,20 @@ internal_error_function (const char *msgid, va_list *ap)
fp.Bounds = &temp;
fp.Array = buffer;
s = expand_location (input_location);
#ifdef USE_MAPPED_LOCATION
if (flag_show_column && s.column != 0)
asprintf (&loc, "%s:%d:%d", s.file, s.line, s.column);
else
#endif
asprintf (&loc, "%s:%d", s.file, s.line);
temp_loc.Low_Bound = 1;
temp_loc.High_Bound = strlen (loc);
fp_loc.Bounds = &temp_loc;
fp_loc.Array = loc;
Current_Error_Node = error_gnat_node;
Compiler_Abort (fp, -1);
Compiler_Abort (fp, -1, fp_loc);
}
/* Perform all the initialization steps that are language-specific. */
@ -751,21 +763,19 @@ gnat_get_alias_set (tree type)
return -1;
}
/* GNU_TYPE is a type. Return its maxium size in bytes, if known,
/* GNU_TYPE is a type. Return its maximum size in bytes, if known,
as a constant when possible. */
static tree
gnat_type_max_size (tree gnu_type)
{
/* First see what we can get from TYPE_SIZE_UNIT, which might not be
constant even for simple expressions if it has already been gimplified
and replaced by a VAR_DECL. */
/* First see what we can get from TYPE_SIZE_UNIT, which might not
be constant even for simple expressions if it has already been
elaborated and possibly replaced by a VAR_DECL. */
tree max_unitsize = max_size (TYPE_SIZE_UNIT (gnu_type), true);
/* If we don't have a constant, see what we can get from TYPE_ADA_SIZE,
typically not gimplified. */
which should stay untouched. */
if (!host_integerp (max_unitsize, 1)
&& (TREE_CODE (gnu_type) == RECORD_TYPE
|| TREE_CODE (gnu_type) == UNION_TYPE
@ -775,8 +785,7 @@ gnat_type_max_size (tree gnu_type)
tree max_adasize = max_size (TYPE_ADA_SIZE (gnu_type), true);
/* If we have succeeded in finding a constant, round it up to the
type's alignment and return the result in byte units. */
type's alignment and return the result in units. */
if (host_integerp (max_adasize, 1))
max_unitsize
= size_binop (CEIL_DIV_EXPR,