2010-10-08 Robert Dewar <dewar@adacore.com>

[pf3gnuchains/gcc-fork.git] / gcc / ada / sem_ch6.adb

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index fab0ba8..90e81f9 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -620,7 +620,11 @@ package body Sem_Ch6 is
                   Subtype_Ind);
             end if;
 
-            if Is_Constrained (R_Type) then
+            --  AI05-103: for elementary types, subtypes must statically match
+
+            if Is_Constrained (R_Type)
+              or else Is_Access_Type (R_Type)
+            then
                if not Subtypes_Statically_Match (R_Stm_Type, R_Type) then
                   Error_Msg_N
                     ("subtype must statically match function result subtype",
@@ -1038,17 +1042,17 @@ package body Sem_Ch6 is
       Analyze (Explicit_Actual_Parameter (N));
    end Analyze_Parameter_Association;
 
-   -------------------------------------
-   -- Analyze_Parametrized_Expression --
-   -------------------------------------
+   --------------------------------------
+   -- Analyze_Parameterized_Expression --
+   --------------------------------------
 
-   procedure Analyze_Parametrized_Expression (N : Node_Id) is
+   procedure Analyze_Parameterized_Expression (N : Node_Id) is
       Loc  : constant Source_Ptr := Sloc (N);
       LocX : constant Source_Ptr := Sloc (Expression (N));
 
    begin
       --  This is one of the occasions on which we write things during semantic
-      --  analysis. We transform the parametrized expression into an equivalent
+      --  analysis. Transform the parameterized expression into an equivalent
       --  subprogram body, and then analyze that.
 
       Rewrite (N,
@@ -1061,7 +1065,7 @@ package body Sem_Ch6 is
                 Make_Simple_Return_Statement (LocX,
                   Expression => Expression (N))))));
       Analyze (N);
-   end Analyze_Parametrized_Expression;
+   end Analyze_Parameterized_Expression;
 
    ----------------------------
    -- Analyze_Procedure_Call --
@@ -3711,7 +3715,6 @@ package body Sem_Ch6 is
                Error_Msg_Name_1 := Chars (New_Id);
                Error_Msg_Name_2 :=
                  Name_Ada + Convention_Id'Pos (Convention (New_Id));
-
                Conformance_Error ("\prior declaration for% has convention %!");
 
             else
@@ -3771,6 +3774,29 @@ package body Sem_Ch6 is
                Set_Error_Posted (New_Formal);
                return;
             end if;
+
+            --  Null exclusion must match
+
+            if Null_Exclusion_Present (Parent (Old_Formal))
+                 /=
+               Null_Exclusion_Present (Parent (New_Formal))
+            then
+               --  Only give error if both come from source. This should be
+               --  investigated some time, since it should not be needed ???
+
+               if Comes_From_Source (Old_Formal)
+                    and then
+                  Comes_From_Source (New_Formal)
+               then
+                  Conformance_Error
+                    ("\null exclusion for & does not match", New_Formal);
+
+                  --  Mark error posted on the new formal to avoid duplicated
+                  --  complaint about types not matching.
+
+                  Set_Error_Posted (New_Formal);
+               end if;
+            end if;
          end if;
 
          --  Ada 2005 (AI-423): Possible access [sub]type and itype match. This
@@ -3912,6 +3938,11 @@ package body Sem_Ch6 is
                    or else
                  Is_Access_Constant (Etype (Old_Formal)) /=
                  Is_Access_Constant (Etype (New_Formal)))
+
+              --  Do not complain if error already posted on New_Formal. This
+              --  avoids some redundant error messages.
+
+              and then not Error_Posted (New_Formal)
             then
                --  It is allowed to omit the null-exclusion in case of stream
                --  attribute subprograms. We recognize stream subprograms
@@ -5864,7 +5895,7 @@ package body Sem_Ch6 is
                      Obj_Decl, Typ);
                   Error_Msg_N
                     ("\an equality operator cannot be declared after this "
-                      & "point ('R'M 4.5.2 (9.8)) (Ada2012))?", Obj_Decl);
+                      & "point ('R'M 4.5.2 (9.8)) (Ada 2012))?", Obj_Decl);
                   exit;
                end if;