2011-08-02 Yannick Moy <moy@adacore.com>

	* einfo.adb, einfo.ads (Body_Is_In_ALFA, Set_Body_Is_In_ALFA): get/set
	for new flag denoting which subprogram bodies are in ALFA
	* restrict.adb, sem_ch7.adb: Update comment
	* sem_ch11.adb, sem_ch2.adb, sem_ch3.adb, sem_ch4.adb, sem_ch5.adb,
	sem_ch9.adb, sem_res.adb: Add calls to
	Current_Subprogram_Body_Is_Not_In_ALFA on unsupported constructs.
	* sem_ch6.adb (Analyze_Function_Return): add calls to
	Current_Subprogram_Body_Is_Not_In_ALFA on return statement in the
	middle of the body, and extended return.
	(Check_Missing_Return): add calls to Set_Body_Is_In_ALFA with argument
	False when missing return.
	(Analyze_Subprogram_Body_Helper): initialize the flag Body_Is_In_ALFA
	to True for subprograms whose spec is in ALFA. Remove later on the flag
	on the entity used for a subprogram body when there exists a separate
	declaration.
	* sem_util.adb, sem_util.ads (Current_Subprogram_Body_Is_Not_In_ALFA):
	if Current_Subprogram is not Empty, set its flag Body_Is_In_ALFA to
	False, otherwise do nothing.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177177 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 25 insertions, 14 deletions

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 1f0cc13f5f6..6ff32af98cc 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -5964,13 +5964,19 @@ package body Sem_Res is
       --  types or array types except String.
 
       if Is_Boolean_Type (T) then
+         Current_Subprogram_Body_Is_Not_In_ALFA;
          Check_SPARK_Restriction
            ("comparison is not defined on Boolean type", N);
-      elsif Is_Array_Type (T)
-        and then Base_Type (T) /= Standard_String
-      then
-         Check_SPARK_Restriction
-           ("comparison is not defined on array types other than String", N);
+
+      elsif Is_Array_Type (T) then
+         Current_Subprogram_Body_Is_Not_In_ALFA;
+
+         if Base_Type (T) /= Standard_String then
+            Check_SPARK_Restriction
+              ("comparison is not defined on array types other than String",
+               N);
+         end if;
+
       else
          null;
       end if;
@@ -6821,15 +6827,18 @@ package body Sem_Res is
          --  String are only defined when, for each index position, the
          --  operands have equal static bounds.
 
-         if Is_Array_Type (T)
-           and then Base_Type (T) /= Standard_String
-           and then Base_Type (Etype (L)) = Base_Type (Etype (R))
-           and then Etype (L) /= Any_Composite  --  or else L in error
-           and then Etype (R) /= Any_Composite  --  or else R in error
-           and then not Matching_Static_Array_Bounds (Etype (L), Etype (R))
-         then
-            Check_SPARK_Restriction
-              ("array types should have matching static bounds", N);
+         if Is_Array_Type (T) then
+            Current_Subprogram_Body_Is_Not_In_ALFA;
+
+            if Base_Type (T) /= Standard_String
+              and then Base_Type (Etype (L)) = Base_Type (Etype (R))
+              and then Etype (L) /= Any_Composite  --  or else L in error
+              and then Etype (R) /= Any_Composite  --  or else R in error
+              and then not Matching_Static_Array_Bounds (Etype (L), Etype (R))
+            then
+               Check_SPARK_Restriction
+                 ("array types should have matching static bounds", N);
+            end if;
          end if;
 
          --  If the unique type is a class-wide type then it will be expanded
@@ -7365,6 +7374,8 @@ package body Sem_Res is
       if Is_Array_Type (B_Typ)
         and then Nkind (N) in N_Binary_Op
       then
+         Current_Subprogram_Body_Is_Not_In_ALFA;
+
          declare
             Left_Typ  : constant Node_Id := Etype (Left_Opnd (N));
             Right_Typ : constant Node_Id := Etype (Right_Opnd (N));