[multiple changes]

2012-07-09  Tristan Gingold  <gingold@adacore.com>

	* seh_init.c (__gnat_SEH_error_handler): On Win64 and SEH,
	return for unknown exceptions.
	* raise-gcc.c (__gnat_personality_seh0): Call __gnat_SEH_error_handler.

2012-07-09  Joel Brobecker  <brobecker@adacore.com brobecker>

	* exp_dbug.ads (No_Dollar_In_Label): Delete.

2012-07-09  Vincent Pucci  <pucci@adacore.com>

	* sem_ch13.adb (Check_Overloaded_Name): New routine.

2012-07-09  Vincent Pucci  <pucci@adacore.com>

	* freeze.adb (Freeze_Record_Type): Analyze the delayed aspects of the
	components in a record type.

2012-07-09  Pascal Obry  <obry@adacore.com>

	* prj-util.ads: Minor reformatting.

From-SVN: r189369
This commit is contained in:
Arnaud Charlet 2012-07-09 12:46:00 +02:00
parent 31821c0f03
commit b3f532ce53
7 changed files with 121 additions and 44 deletions

View File

@ -1,3 +1,26 @@
2012-07-09 Tristan Gingold <gingold@adacore.com>
* seh_init.c (__gnat_SEH_error_handler): On Win64 and SEH,
return for unknown exceptions.
* raise-gcc.c (__gnat_personality_seh0): Call __gnat_SEH_error_handler.
2012-07-09 Joel Brobecker <brobecker@adacore.com brobecker>
* exp_dbug.ads (No_Dollar_In_Label): Delete.
2012-07-09 Vincent Pucci <pucci@adacore.com>
* sem_ch13.adb (Check_Overloaded_Name): New routine.
2012-07-09 Vincent Pucci <pucci@adacore.com>
* freeze.adb (Freeze_Record_Type): Analyze the delayed aspects of the
components in a record type.
2012-07-09 Pascal Obry <obry@adacore.com>
* prj-util.ads: Minor reformatting.
2012-07-09 Tristan Gingold <gingold@adacore.com>
* raise-gcc.c (db_indent): Simplify style, improve comments.

View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1996-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1996-2012, 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- --
@ -411,14 +411,6 @@ package Exp_Dbug is
-- Conversion between Entities and External Names --
----------------------------------------------------
No_Dollar_In_Label : constant Boolean := True;
-- True iff the target does not allow dollar signs ("$") in external names
-- ??? We want to migrate all platforms to use the same convention. As a
-- first step, we force this constant to always be True. This constant will
-- eventually be deleted after we have verified that the migration does not
-- cause any unforeseen adverse impact. We chose "__" because it is
-- supported on all platforms, which is not the case of "$".
procedure Get_External_Name
(Entity : Entity_Id;
Has_Suffix : Boolean);

View File

@ -1906,8 +1906,34 @@ package body Freeze is
Comp := First_Entity (Rec);
Prev := Empty;
while Present (Comp) loop
-- Deal with delayed aspect specifications for components. The
-- analysis of the aspect is required to be delayed to the freeze
-- point, thus we analyze the pragma or attribute definition
-- clause in the tree at this point. We also analyze the aspect
-- specification node at the freeze point when the aspect doesn't
-- correspond to pragma/attribute definition clause.
-- First handle the component case
if Ekind (Comp) = E_Component
and then Has_Delayed_Aspects (Comp)
then
Push_Scope (Rec);
-- The visibility to the discriminants must be restored in
-- order to properly analyze the aspects.
if Has_Discriminants (Rec) then
Install_Discriminants (Rec);
Analyze_Aspects_At_Freeze_Point (Comp);
Uninstall_Discriminants (Rec);
else
Analyze_Aspects_At_Freeze_Point (Comp);
end if;
Pop_Scope;
end if;
-- Handle the component and discriminant case
if Ekind (Comp) = E_Component
or else Ekind (Comp) = E_Discriminant

View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2012, 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- --
@ -60,8 +60,8 @@ package Prj.Util is
-- Describe parameters???
procedure Duplicate
(This : in out Name_List_Index;
Shared : Shared_Project_Tree_Data_Access);
(This : in out Name_List_Index;
Shared : Shared_Project_Tree_Data_Access);
-- Duplicate a name list
function Value_Of
@ -203,14 +203,14 @@ package Prj.Util is
-- the flag Source_Info_File_Exists to True for the tree.
type Source_Info_Data is record
Project : Name_Id;
Language : Name_Id;
Kind : Source_Kind;
Display_Path_Name : Name_Id;
Path_Name : Name_Id;
Unit_Name : Name_Id := No_Name;
Index : Int := 0;
Naming_Exception : Naming_Exception_Type := No;
Project : Name_Id;
Language : Name_Id;
Kind : Source_Kind;
Display_Path_Name : Name_Id;
Path_Name : Name_Id;
Unit_Name : Name_Id := No_Name;
Index : Int := 0;
Naming_Exception : Naming_Exception_Type := No;
end record;
-- Data read from a source info file for a single source

View File

@ -1182,11 +1182,22 @@ __gnat_Unwind_ForcedUnwind (_Unwind_Exception *e,
#endif /* __USING_SJLJ_EXCEPTIONS__ */
#ifdef __SEH__
#define STATUS_USER_DEFINED (1U << 29)
EXCEPTION_DISPOSITION __gnat_SEH_error_handler
(struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*);
EXCEPTION_DISPOSITION
__gnat_personality_seh0 (PEXCEPTION_RECORD ms_exc, void *this_frame,
PCONTEXT ms_orig_context,
PDISPATCHER_CONTEXT ms_disp)
{
/* Possibly transform run-time errors into Ada exceptions. As a small
optimization, we call __gnat_SEH_error_handler only on non-user
exceptions. */
if (!(ms_exc->ExceptionCode & STATUS_USER_DEFINED))
__gnat_SEH_error_handler (ms_exc, this_frame, ms_orig_context, ms_disp);
return _GCC_specific_handler (ms_exc, this_frame, ms_orig_context,
ms_disp, __gnat_personality_imp);
}

View File

@ -178,9 +178,15 @@ __gnat_SEH_error_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
msg = "EXCEPTION_STACK_OVERFLOW";
break;
default:
default:
#if defined (_WIN64) && defined (__SEH__)
/* On Windows x64, do not transform other exception as they could
be caught by user (when SEH is used to propagate exceptions). */
return;
#else
exception = &program_error;
msg = "unhandled signal";
#endif
}
#if ! defined (_WIN64)

View File

@ -6350,25 +6350,18 @@ package body Sem_Ch13 is
-- but Expression (Ident) is a preanalyzed copy of the expression,
-- preanalyzed just after the freeze point.
begin
-- Case of aspects Dimension, Dimension_System and Synchronization
procedure Check_Overloaded_Name;
-- For aspects whose expression is simply a name, this routine checks if
-- the name is overloaded or not. If so, it verifies there is an
-- interpretation that matches the entity obtained at the freeze point,
-- otherwise the compiler complains.
if A_Id = Aspect_Synchronization then
return;
-- Case of stream attributes, just have to compare entities. However,
-- the expression is just a name (possibly overloaded), and there may
-- be stream operations declared for unrelated types, so we just need
-- to verify that one of these interpretations is the one available at
-- at the freeze point.
elsif A_Id = Aspect_Input or else
A_Id = Aspect_Output or else
A_Id = Aspect_Read or else
A_Id = Aspect_Write
then
Analyze (End_Decl_Expr);
---------------------------
-- Check_Overloaded_Name --
---------------------------
procedure Check_Overloaded_Name is
begin
if not Is_Overloaded (End_Decl_Expr) then
Err := Entity (End_Decl_Expr) /= Entity (Freeze_Expr);
@ -6391,6 +6384,29 @@ package body Sem_Ch13 is
end loop;
end;
end if;
end Check_Overloaded_Name;
-- Start of processing for Check_Aspect_At_End_Of_Declarations
begin
-- Case of aspects Dimension, Dimension_System and Synchronization
if A_Id = Aspect_Synchronization then
return;
-- Case of stream attributes, just have to compare entities. However,
-- the expression is just a name (possibly overloaded), and there may
-- be stream operations declared for unrelated types, so we just need
-- to verify that one of these interpretations is the one available at
-- at the freeze point.
elsif A_Id = Aspect_Input or else
A_Id = Aspect_Output or else
A_Id = Aspect_Read or else
A_Id = Aspect_Write
then
Analyze (End_Decl_Expr);
Check_Overloaded_Name;
elsif A_Id = Aspect_Variable_Indexing or else
A_Id = Aspect_Constant_Indexing or else
@ -6402,16 +6418,19 @@ package body Sem_Ch13 is
Set_Is_Frozen (Ent, False);
Analyze (End_Decl_Expr);
Analyze (Aspect_Rep_Item (ASN));
Set_Is_Frozen (Ent, True);
-- If the end of declarations comes before any other freeze
-- point, the Freeze_Expr is not analyzed: no check needed.
Err :=
Analyzed (Freeze_Expr)
and then not In_Instance
and then Entity (End_Decl_Expr) /= Entity (Freeze_Expr);
if Analyzed (Freeze_Expr)
and then not In_Instance
then
Check_Overloaded_Name;
else
Err := False;
end if;
-- All other cases