[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

5 files changed, 40 insertions, 6 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9374119..f11be92 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,17 @@
+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.
diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index 5b261af..2651fd0 100644
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -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;
diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index 5544e47..35bedf3 100644
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -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
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index ec9d9ae..0fbb386 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -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);
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 2f0f41c..2df70ea 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -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;