sem_ch3.adb (Access_Subprogram_Declaration): Adding missing support for…

sem_ch3.adb (Access_Subprogram_Declaration): Adding missing support for N_Formal_Object_Declaration nodes.

2008-08-04  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.adb (Access_Subprogram_Declaration): Adding missing support
	for N_Formal_Object_Declaration nodes. Adding kludge required by
	First_Formal to provide its functionality with access to functions.
	(Replace_Anonymous_Access_To_Protected_Subprogram): Add missing support
	for anonymous access types returned by functions.

	* sem_ch5.adb (Analyze_Assignment): Code cleanup to avoid duplicate
	conversion of null-excluding access types (required only once to force
	the generation of the required runtime check).

	* sem_type.adb (Covers): minor reformating

	* checks.adb (Null_Exclusion_Static_Checks): Avoid reporting errors
	with internally generated nodes. Avoid generating the error inside init
	procs.

	* sem_res.adb (Resolve_Membership_Test): Minor reformating.
	(Resolve_Null): Generate the null-excluding check in case of assignment
	to a null-excluding object.
	(Valid_Conversion): Add missing support for anonymous access to
	subprograms.

	* sem_ch6.adb (Check_Return_Subtype_Indication): Add missing support for
	anonymous access types whose designated type is an itype. This case
	occurs with anonymous access to protected subprograms types.
	(Analyze_Return_Type):  Add missing support for anonymous access to
	protected subprogram.

	* sem_eval.adb (Subtypes_Statically_Match): In case of access to
	subprograms addition of missing check on matching convention. Required
	to properly handle access to protected subprogram types.

	* exp_ch3 (Build_Assignment): Code cleanup removing duplicated check on
	null excluding access types.

From-SVN: r138610

gcc/ada/ChangeLog

+2008-08-04  Javier Miranda  <miranda@adacore.com>
+
+	* sem_ch3.adb (Access_Subprogram_Declaration): Adding missing support
+	for N_Formal_Object_Declaration nodes. Adding kludge required by
+	First_Formal to provide its functionality with access to functions.
+	(Replace_Anonymous_Access_To_Protected_Subprogram): Add missing support
+	for anonymous access types returned by functions.
+
+	* sem_ch5.adb (Analyze_Assignment): Code cleanup to avoid duplicate
+	conversion of null-excluding access types (required only once to force
+	the generation of the required runtime check).
+
+	* sem_type.adb (Covers): minor reformating
+
+	* checks.adb (Null_Exclusion_Static_Checks): Avoid reporting errors
+	with internally generated nodes. Avoid generating the error inside init
+	procs.
+
+	* sem_res.adb (Resolve_Membership_Test): Minor reformating.
+	(Resolve_Null): Generate the null-excluding check in case of assignment
+	to a null-excluding object.
+	(Valid_Conversion): Add missing support for anonymous access to
+	subprograms.
+
+	* sem_ch6.adb (Check_Return_Subtype_Indication): Add missing support for
+	anonymous access types whose designated type is an itype. This case
+	occurs with anonymous access to protected subprograms types.
+	(Analyze_Return_Type):  Add missing support for anonymous access to
+	protected subprogram.
+
+	* sem_eval.adb (Subtypes_Statically_Match): In case of access to
+	subprograms addition of missing check on matching convention. Required
+	to properly handle access to protected subprogram types.
+
+	* exp_ch3 (Build_Assignment): Code cleanup removing duplicated check on
+	null excluding access types.
+
 2008-08-04  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch12.adb: Add comments

gcc/ada/checks.adb

@@ -2871,11 +2871,7 @@ package body Checks is
          --  be applied to a [sub]type that does not exclude null already.
 
          elsif Can_Never_Be_Null (Typ)
-
-            --  No need to check itypes that have a null exclusion because
-            --  they are already examined at their point of creation.
-
-           and then not Is_Itype (Typ)
+           and then Comes_From_Source (Typ)
          then
             Error_Msg_NE
               ("`NOT NULL` not allowed (& already excludes null)",
@@ -5306,10 +5302,20 @@ package body Checks is
       --  If known to be null, here is where we generate a compile time check
 
       if Known_Null (N) then
-         Apply_Compile_Time_Constraint_Error
-           (N,
-            "null value not allowed here?",
-            CE_Access_Check_Failed);
+
+         --  Avoid generating warning message inside init procs
+
+         if not Inside_Init_Proc then
+            Apply_Compile_Time_Constraint_Error
+              (N,
+               "null value not allowed here?",
+               CE_Access_Check_Failed);
+         else
+            Insert_Action (N,
+              Make_Raise_Constraint_Error (Loc,
+                Reason => CE_Access_Check_Failed));
+         end if;
+
          Mark_Non_Null;
          return;
       end if;

gcc/ada/exp_ch3.adb

@@ -1826,23 +1826,6 @@ package body Exp_Ch3 is
                 Attribute_Name => Name_Unrestricted_Access);
          end if;
 
-         --  Ada 2005 (AI-231): Add the run-time check if required
-
-         if Ada_Version >= Ada_05
-           and then Can_Never_Be_Null (Etype (Id))            -- Lhs
-         then
-            if Known_Null (Exp) then
-               return New_List (
-                 Make_Raise_Constraint_Error (Sloc (Exp),
-                   Reason => CE_Null_Not_Allowed));
-
-            elsif Present (Etype (Exp))
-              and then not Can_Never_Be_Null (Etype (Exp))
-            then
-               Install_Null_Excluding_Check (Exp);
-            end if;
-         end if;
-
          --  Take a copy of Exp to ensure that later copies of this component
          --  declaration in derived types see the original tree, not a node
          --  rewritten during expansion of the init_proc.

gcc/ada/sem_ch3.adb

@@ -1056,6 +1056,7 @@ package body Sem_Ch3 is
                                    N_Object_Renaming_Declaration,
                                    N_Formal_Object_Declaration,
                                    N_Formal_Type_Declaration,
+                                   N_Formal_Object_Declaration,
                                    N_Task_Type_Declaration,
                                    N_Protected_Type_Declaration))
       loop
@@ -1117,13 +1118,32 @@ package body Sem_Ch3 is
 
       if Present (Formals) then
          Push_Scope (Desig_Type);
+
+         --  A bit of a kludge here. These kludges will be removed when Itypes
+         --  have proper parent pointers to their declarations???
+
+         --  Kludge 1) Link definining_identifier of formals. Required by
+         --  First_Formal to provide its functionality.
+
+         declare
+            F : Node_Id;
+
+         begin
+            F := First (Formals);
+            while Present (F) loop
+               if No (Parent (Defining_Identifier (F))) then
+                  Set_Parent (Defining_Identifier (F), F);
+               end if;
+
+               Next (F);
+            end loop;
+         end;
+
          Process_Formals (Formals, Parent (T_Def));
 
-         --  A bit of a kludge here, End_Scope requires that the parent
-         --  pointer be set to something reasonable, but Itypes don't have
-         --  parent pointers. So we set it and then unset it ??? If and when
-         --  Itypes have proper parent pointers to their declarations, this
-         --  kludge can be removed.
+         --  Kludge 2) End_Scope requires that the parent pointer be set to
+         --  something reasonable, but Itypes don't have parent pointers. So
+         --  we set it and then unset it ???
 
          Set_Parent (Desig_Type, T_Name);
          End_Scope;
@@ -4441,6 +4461,10 @@ package body Sem_Ch3 is
             Comp := Object_Definition (N);
             Acc  := Comp;
 
+         when N_Function_Specification =>
+            Comp := Result_Definition (N);
+            Acc  := Comp;
+
          when others =>
             raise Program_Error;
       end case;
@@ -4485,6 +4509,10 @@ package body Sem_Ch3 is
       elsif Nkind (N) = N_Access_Function_Definition then
          Rewrite (Comp, New_Occurrence_Of (Anon, Loc));
 
+      elsif Nkind (N) = N_Function_Specification then
+         Rewrite (Comp, New_Occurrence_Of (Anon, Loc));
+         Set_Etype (Defining_Unit_Name (N), Anon);
+
       else
          Rewrite (Comp,
            Make_Component_Definition (Loc,

gcc/ada/sem_ch5.adb

@@ -579,18 +579,15 @@ package body Sem_Ch5 is
          end if;
       end if;
 
-      --  Ada 2005 (AI-230 and AI-385): When the lhs type is an anonymous
-      --  access type, apply an implicit conversion of the rhs to that type
-      --  to force appropriate static and run-time accessibility checks.
-      --  This applies as well to anonymous access-to-subprogram types that
+      --  Ada 2005 (AI-385): When the lhs type is an anonymous access type,
+      --  apply an implicit conversion of the rhs to that type to force
+      --  appropriate static and run-time accessibility checks. This
+      --  applies as well to anonymous access-to-subprogram types that
       --  are component subtypes.
 
       if Ada_Version >= Ada_05
-        and then
-          Is_Access_Type (T1)
-            and then
-             (Is_Local_Anonymous_Access (T1)
-               or else Can_Never_Be_Null (T1))
+        and then Is_Access_Type (T1)
+        and then Is_Local_Anonymous_Access (T1)
       then
          Rewrite (Rhs, Convert_To (T1, Relocate_Node (Rhs)));
          Analyze_And_Resolve (Rhs, T1);

gcc/ada/sem_ch6.adb

@@ -1262,7 +1262,20 @@ package body Sem_Ch6 is
 
       if Result_Definition (N) /= Error then
          if Nkind (Result_Definition (N)) = N_Access_Definition then
-            Typ := Access_Definition (N, Result_Definition (N));
+
+            --  Ada 2005 (AI-254): Handle anonymous access to subprograms
+
+            declare
+               AD : constant Node_Id :=
+                      Access_To_Subprogram_Definition (Result_Definition (N));
+            begin
+               if Present (AD) and then Protected_Present (AD) then
+                  Typ := Replace_Anonymous_Access_To_Protected_Subprogram (N);
+               else
+                  Typ := Access_Definition (N, Result_Definition (N));
+               end if;
+            end;
+
             Set_Parent (Typ, Result_Definition (N));
             Set_Is_Local_Anonymous_Access (Typ);
             Set_Etype (Designator, Typ);

gcc/ada/sem_eval.adb

@@ -4388,7 +4388,12 @@ package body Sem_Eval is
             return
               Subtype_Conformant
                 (Designated_Type (T1),
-                 Designated_Type (T2));
+                 Designated_Type (T2))
+
+               --  Convention check required to cover protected subprograms
+
+               and then Convention (Designated_Type (T1)) =
+                        Convention (Designated_Type (T2));
          else
             return
               Subtypes_Statically_Match

gcc/ada/sem_res.adb

@@ -6572,8 +6572,8 @@ package body Sem_Res is
    procedure Resolve_Membership_Op (N : Node_Id; Typ : Entity_Id) is
       pragma Warnings (Off, Typ);
 
-      L : constant Node_Id   := Left_Opnd (N);
-      R : constant Node_Id   := Right_Opnd (N);
+      L : constant Node_Id := Left_Opnd (N);
+      R : constant Node_Id := Right_Opnd (N);
       T : Entity_Id;
 
    begin
@@ -6638,6 +6638,8 @@ package body Sem_Res is
    ------------------
 
    procedure Resolve_Null (N : Node_Id; Typ : Entity_Id) is
+      Loc : constant Source_Ptr := Sloc (N);
+
    begin
       --  Handle restriction against anonymous null access values This
       --  restriction can be turned off using -gnatdj.
@@ -6666,6 +6668,26 @@ package body Sem_Res is
          end if;
       end if;
 
+      --  Ada 2005 (AI-231): Generate the null-excluding check in case of
+      --  assignment to a null-excluding object
+
+      if Ada_Version >= Ada_05
+        and then Can_Never_Be_Null (Typ)
+        and then Nkind (Parent (N)) = N_Assignment_Statement
+      then
+         if not Inside_Init_Proc then
+            Insert_Action
+              (Compile_Time_Constraint_Error (N,
+                 "(Ada 2005) null not allowed in null-excluding objects?"),
+               Make_Raise_Constraint_Error (Loc,
+                 Reason => CE_Access_Check_Failed));
+         else
+            Insert_Action (N,
+              Make_Raise_Constraint_Error (Loc,
+                Reason => CE_Access_Check_Failed));
+         end if;
+      end if;
+
       --  In a distributed context, null for a remote access to subprogram
       --  may need to be replaced with a special record aggregate. In this
       --  case, return after having done the transformation.
@@ -9511,9 +9533,7 @@ package body Sem_Res is
       --  return statement, because in that case the accessibility check
       --  takes place after the return.
 
-      elsif (Ekind (Target_Type) = E_Access_Subprogram_Type
-               or else
-             Ekind (Target_Type) = E_Anonymous_Access_Subprogram_Type)
+      elsif Ekind (Target_Type) in Access_Subprogram_Kind
         and then No (Corresponding_Remote_Type (Opnd_Type))
       then
          if Ekind (Base_Type (Opnd_Type)) = E_Anonymous_Access_Subprogram_Type

gcc/ada/sem_type.adb

@@ -766,7 +766,7 @@ package body Sem_Type is
       if T1 = T2 then
          return True;
 
-      elsif  BT1 = BT2
+      elsif BT1 = BT2
         or else BT1 = T2
         or else BT2 = T1
       then