Commit 055416a8 by Arnaud Charlet

[multiple changes]

2013-10-14  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Depends_In_Decl_Part,
	Analyze_Global_In_Decl_Part,
	Analyze_Pre_Post_Condition_In_Decl_Part): Install the subprogram
	and its formals only when it is not already installed.
	* sem_util.adb (Is_Refined_State): A state is refined when it
	has a non-empty list of constituents.

2013-10-14  Tristan Gingold  <gingold@adacore.com>

	* adaint.c: Disable __gnat_get_executable_load_address for linux.
	* exp_prag.adb: Add comment in Expand_Pragma_Import_Export_Exception.

From-SVN: r203532
parent 39d3009f
2013-10-14 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_Depends_In_Decl_Part,
Analyze_Global_In_Decl_Part,
Analyze_Pre_Post_Condition_In_Decl_Part): Install the subprogram
and its formals only when it is not already installed.
* sem_util.adb (Is_Refined_State): A state is refined when it
has a non-empty list of constituents.
2013-10-14 Tristan Gingold <gingold@adacore.com>
* adaint.c: Disable __gnat_get_executable_load_address for linux.
* exp_prag.adb: Add comment in Expand_Pragma_Import_Export_Exception.
2013-10-14 Tristan Gingold <gingold@adacore.com>
* s-vmexta.ads: Add comments.
......
......@@ -3941,7 +3941,8 @@ __gnat_get_executable_load_address (void)
#if defined (__APPLE__)
return _dyld_get_image_header (0);
#elif defined (__linux__)
#elif 0 && defined (__linux__)
/* Currently disabled as it needs at least -ldl. */
struct link_map *map = _r_debug.r_map;
return (const void *)map->l_addr;
......
......@@ -616,6 +616,8 @@ package body Exp_Prag is
Code : Node_Id;
begin
-- Compute the symbol for the code of the condition
if Present (Interface_Name (Id)) then
Excep_Image := Strval (Interface_Name (Id));
else
......@@ -639,10 +641,16 @@ package body Exp_Prag is
Analyze (Expression (Lang_Char));
if Exception_Code (Id) /= No_Uint then
-- The code for the exception is present.Create a
-- linker alias to define the symbol.
Code :=
Make_Integer_Literal (Loc,
Intval => Exception_Code (Id));
-- Declare a dummy object
Excep_Object :=
Make_Object_Declaration (Loc,
Defining_Identifier => Excep_Internal,
......@@ -652,10 +660,15 @@ package body Exp_Prag is
Insert_Action (N, Excep_Object);
Analyze (Excep_Object);
-- Clear severity bits
Start_String;
Store_String_Int
(UI_To_Int (Exception_Code (Id)) / 8 * 8);
-- Insert a pragma Linker_Alias to set the value of
-- the dummy object symbol.
Excep_Alias :=
Make_Pragma (Loc,
Chars => Name_Linker_Alias,
......@@ -671,6 +684,9 @@ package body Exp_Prag is
Insert_Action (N, Excep_Alias);
Analyze (Excep_Alias);
-- Insert a pragma Export to give a Linker_Name to the
-- dummy object.
Export_Pragma :=
Make_Pragma (Loc,
Chars => Name_Export,
......@@ -704,6 +720,8 @@ package body Exp_Prag is
Strval => Excep_Image))));
end if;
-- Generate the call to Register_VMS_Exception
Rewrite (Call,
Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To
......
......@@ -451,7 +451,7 @@ package body Sem_Prag is
-- pertaining to subprogram declarations. Skip the installation
-- for subprogram bodies because the formals are already visible.
if Current_Scope /= Subp_Id then
if not In_Open_Scopes (Subp_Id) then
Restore_Scope := True;
Push_Scope (Subp_Id);
Install_Formals (Subp_Id);
......@@ -1434,7 +1434,7 @@ package body Sem_Prag is
-- to subprogram declarations. Skip the installation for subprogram
-- bodies because the formals are already visible.
if Current_Scope /= Spec_Id then
if not In_Open_Scopes (Spec_Id) then
Restore_Scope := True;
Push_Scope (Spec_Id);
Install_Formals (Spec_Id);
......@@ -1919,7 +1919,7 @@ package body Sem_Prag is
-- item. This falls out of the general rule of aspects pertaining to
-- subprogram declarations.
if Current_Scope /= Spec_Id then
if not In_Open_Scopes (Spec_Id) then
Restore_Scope := True;
Push_Scope (Spec_Id);
Install_Formals (Spec_Id);
......@@ -19319,7 +19319,7 @@ package body Sem_Prag is
-- Ensure that the subprogram and its formals are visible when analyzing
-- the expression of the pragma.
if Current_Scope /= Subp_Id then
if not In_Open_Scopes (Subp_Id) then
Restore_Scope := True;
Push_Scope (Subp_Id);
Install_Formals (Subp_Id);
......
......@@ -3418,7 +3418,8 @@ package body Sem_Util is
return
Ekind (Item_Id) = E_Abstract_State
and then Present (Refinement_Constituents (Item_Id));
and then not Is_Empty_Elmt_List
(Refinement_Constituents (Item_Id));
end if;
end Is_Refined_State;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment