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> 2013-10-14 Tristan Gingold <gingold@adacore.com>
* s-vmexta.ads: Add comments. * s-vmexta.ads: Add comments.
......
...@@ -3941,7 +3941,8 @@ __gnat_get_executable_load_address (void) ...@@ -3941,7 +3941,8 @@ __gnat_get_executable_load_address (void)
#if defined (__APPLE__) #if defined (__APPLE__)
return _dyld_get_image_header (0); 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; struct link_map *map = _r_debug.r_map;
return (const void *)map->l_addr; return (const void *)map->l_addr;
......
...@@ -616,6 +616,8 @@ package body Exp_Prag is ...@@ -616,6 +616,8 @@ package body Exp_Prag is
Code : Node_Id; Code : Node_Id;
begin begin
-- Compute the symbol for the code of the condition
if Present (Interface_Name (Id)) then if Present (Interface_Name (Id)) then
Excep_Image := Strval (Interface_Name (Id)); Excep_Image := Strval (Interface_Name (Id));
else else
...@@ -639,10 +641,16 @@ package body Exp_Prag is ...@@ -639,10 +641,16 @@ package body Exp_Prag is
Analyze (Expression (Lang_Char)); Analyze (Expression (Lang_Char));
if Exception_Code (Id) /= No_Uint then if Exception_Code (Id) /= No_Uint then
-- The code for the exception is present.Create a
-- linker alias to define the symbol.
Code := Code :=
Make_Integer_Literal (Loc, Make_Integer_Literal (Loc,
Intval => Exception_Code (Id)); Intval => Exception_Code (Id));
-- Declare a dummy object
Excep_Object := Excep_Object :=
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Defining_Identifier => Excep_Internal, Defining_Identifier => Excep_Internal,
...@@ -652,10 +660,15 @@ package body Exp_Prag is ...@@ -652,10 +660,15 @@ package body Exp_Prag is
Insert_Action (N, Excep_Object); Insert_Action (N, Excep_Object);
Analyze (Excep_Object); Analyze (Excep_Object);
-- Clear severity bits
Start_String; Start_String;
Store_String_Int Store_String_Int
(UI_To_Int (Exception_Code (Id)) / 8 * 8); (UI_To_Int (Exception_Code (Id)) / 8 * 8);
-- Insert a pragma Linker_Alias to set the value of
-- the dummy object symbol.
Excep_Alias := Excep_Alias :=
Make_Pragma (Loc, Make_Pragma (Loc,
Chars => Name_Linker_Alias, Chars => Name_Linker_Alias,
...@@ -671,6 +684,9 @@ package body Exp_Prag is ...@@ -671,6 +684,9 @@ package body Exp_Prag is
Insert_Action (N, Excep_Alias); Insert_Action (N, Excep_Alias);
Analyze (Excep_Alias); Analyze (Excep_Alias);
-- Insert a pragma Export to give a Linker_Name to the
-- dummy object.
Export_Pragma := Export_Pragma :=
Make_Pragma (Loc, Make_Pragma (Loc,
Chars => Name_Export, Chars => Name_Export,
...@@ -704,6 +720,8 @@ package body Exp_Prag is ...@@ -704,6 +720,8 @@ package body Exp_Prag is
Strval => Excep_Image)))); Strval => Excep_Image))));
end if; end if;
-- Generate the call to Register_VMS_Exception
Rewrite (Call, Rewrite (Call,
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To Name => New_Reference_To
......
...@@ -451,7 +451,7 @@ package body Sem_Prag is ...@@ -451,7 +451,7 @@ package body Sem_Prag is
-- pertaining to subprogram declarations. Skip the installation -- pertaining to subprogram declarations. Skip the installation
-- for subprogram bodies because the formals are already visible. -- 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; Restore_Scope := True;
Push_Scope (Subp_Id); Push_Scope (Subp_Id);
Install_Formals (Subp_Id); Install_Formals (Subp_Id);
...@@ -1434,7 +1434,7 @@ package body Sem_Prag is ...@@ -1434,7 +1434,7 @@ package body Sem_Prag is
-- to subprogram declarations. Skip the installation for subprogram -- to subprogram declarations. Skip the installation for subprogram
-- bodies because the formals are already visible. -- bodies because the formals are already visible.
if Current_Scope /= Spec_Id then if not In_Open_Scopes (Spec_Id) then
Restore_Scope := True; Restore_Scope := True;
Push_Scope (Spec_Id); Push_Scope (Spec_Id);
Install_Formals (Spec_Id); Install_Formals (Spec_Id);
...@@ -1919,7 +1919,7 @@ package body Sem_Prag is ...@@ -1919,7 +1919,7 @@ package body Sem_Prag is
-- item. This falls out of the general rule of aspects pertaining to -- item. This falls out of the general rule of aspects pertaining to
-- subprogram declarations. -- subprogram declarations.
if Current_Scope /= Spec_Id then if not In_Open_Scopes (Spec_Id) then
Restore_Scope := True; Restore_Scope := True;
Push_Scope (Spec_Id); Push_Scope (Spec_Id);
Install_Formals (Spec_Id); Install_Formals (Spec_Id);
...@@ -19319,7 +19319,7 @@ package body Sem_Prag is ...@@ -19319,7 +19319,7 @@ package body Sem_Prag is
-- Ensure that the subprogram and its formals are visible when analyzing -- Ensure that the subprogram and its formals are visible when analyzing
-- the expression of the pragma. -- the expression of the pragma.
if Current_Scope /= Subp_Id then if not In_Open_Scopes (Subp_Id) then
Restore_Scope := True; Restore_Scope := True;
Push_Scope (Subp_Id); Push_Scope (Subp_Id);
Install_Formals (Subp_Id); Install_Formals (Subp_Id);
......
...@@ -3418,7 +3418,8 @@ package body Sem_Util is ...@@ -3418,7 +3418,8 @@ package body Sem_Util is
return return
Ekind (Item_Id) = E_Abstract_State 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 if;
end Is_Refined_State; 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