2009-04-20 Ed Schonberg <schonberg@adacore.com>

	* sem_ch6.adb (Analye_Subprogram_Declaration): Code reorganization,
	for better handling of null procedures.
	(Check_Overriding_Indicator): Do not emit a warning on a missing
	overriding indicator on an operator when the type of which the operator
	is a primitive is private.



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

2 files changed, 84 insertions, 28 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3aaa6d46897..05c5b293f87 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,19 @@
+2009-04-20  Robert Dewar  <dewar@adacore.com>
+
+	* sem_attr.adb (Eval_Attribute, case Length): Catch more cases where
+	this attribute can be evaluated at compile time.
+	(Eval_Attribute, case Range_Length): Same improvement
+
+	* sem_eval.ads, sem_eval.adb (Compile_Time_Compare): New procedure
+
+2009-04-20  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch6.adb (Analye_Subprogram_Declaration): Code reorganization,
+	for better handling of null procedures.
+	(Check_Overriding_Indicator): Do not emit a warning on a missing
+	overriding indicator on an operator when the type of which the operator
+	is a primitive is private.
+
 2009-04-20  Bob Duff  <duff@adacore.com>
 
 	* sem.adb, gnat1drv.adb, debug.adb: Use the -gnatd.W switch to control
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 9ef452207c1..569800c3b6d 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2609,13 +2609,56 @@ package body Sem_Ch6 is
    ------------------------------------
 
    procedure Analyze_Subprogram_Declaration (N : Node_Id) is
-      Designator : constant Entity_Id :=
-                     Analyze_Subprogram_Specification (Specification (N));
+      Loc        : constant Source_Ptr := Sloc (N);
+      Designator : Entity_Id;
+      Form       : Node_Id;
       Scop       : constant Entity_Id := Current_Scope;
+      Null_Body  : Node_Id := Empty;
 
    --  Start of processing for Analyze_Subprogram_Declaration
 
    begin
+      --  For a null procedure. capture the profile before analysis, for
+      --  expansion at the freeze point, and at each point of call.
+      --  The body will only be used if the procedure has preconditions.
+      --  In that case the body is analyzed at the freeze point.
+
+      if Nkind (Specification (N)) = N_Procedure_Specification
+        and then Null_Present (Specification (N))
+        and then Expander_Active
+      then
+         Null_Body :=
+           Make_Subprogram_Body (Loc,
+             Specification =>
+               New_Copy_Tree (Specification (N)),
+             Declarations => New_List,
+             Handled_Statement_Sequence =>
+               Make_Handled_Sequence_Of_Statements (Loc,
+                 Statements => New_List (Make_Null_Statement (Loc))));
+
+         --  Create new entities for body and formals.
+
+         Set_Defining_Unit_Name (Specification (Null_Body),
+           Make_Defining_Identifier (Loc, Chars (Defining_Entity (N))));
+         Set_Corresponding_Body (N, Defining_Entity (Null_Body));
+
+         Form := First (Parameter_Specifications (Specification (Null_Body)));
+         while Present (Form) loop
+            Set_Defining_Identifier (Form,
+              Make_Defining_Identifier (Loc,
+                Chars (Defining_Identifier (Form))));
+            Next (Form);
+         end loop;
+
+         if Is_Protected_Type (Current_Scope) then
+            Error_Msg_N
+              ("protected operation cannot be a null procedure", N);
+         end if;
+      end if;
+
+      Designator :=  Analyze_Subprogram_Specification (Specification (N));
+      Generate_Definition (Designator);
+
       if Debug_Flag_C then
          Write_Str ("==> subprogram spec ");
          Write_Name (Chars (Designator));
@@ -2625,19 +2668,19 @@ package body Sem_Ch6 is
          Indent;
       end if;
 
-      Generate_Definition (Designator);
+      if Nkind (Specification (N)) = N_Procedure_Specification
+        and then Null_Present (Specification (N))
+      then
+         Set_Has_Completion (Designator);
 
-      --  Check for RCI unit subprogram declarations for illegal inlined
-      --  subprograms and subprograms having access parameter or limited
-      --  parameter without Read and Write attributes (RM E.2.3(12-13)).
+         if Present (Null_Body) then
+            Set_Corresponding_Body (N, Defining_Entity (Null_Body));
+            Set_Body_To_Inline (N, Null_Body);
+            Set_Is_Inlined (Designator);
+         end if;
+      end if;
 
       Validate_RCI_Subprogram_Declaration (N);
-
-      Trace_Scope
-        (N,
-         Defining_Entity (N),
-         " Analyze subprogram spec: ");
-
       New_Overloaded_Entity (Designator);
       Check_Delayed_Subprogram (Designator);
 
@@ -2743,21 +2786,6 @@ package body Sem_Ch6 is
       Generate_Reference_To_Formals (Designator);
       Check_Eliminated (Designator);
 
-      --  Ada 2005: if procedure is declared with "is null" qualifier,
-      --  it requires no body.
-
-      if Nkind (Specification (N)) = N_Procedure_Specification
-        and then Null_Present (Specification (N))
-      then
-         Set_Has_Completion (Designator);
-         Set_Is_Inlined (Designator);
-
-         if Is_Protected_Type (Current_Scope) then
-            Error_Msg_N
-              ("protected operation cannot be a null procedure", N);
-         end if;
-      end if;
-
       if Debug_Flag_C then
          Outdent;
          Write_Str ("<== subprogram spec ");
@@ -4395,7 +4423,19 @@ package body Sem_Ch6 is
                  (Unit_File_Name (Get_Source_Unit (Subp)))
          then
             Set_Is_Overriding_Operation (Subp);
-            Style.Missing_Overriding (Decl, Subp);
+
+            --  If style checks are enabled, indicate that the indicator
+            --  is missing. However, at the point of declaration, the type
+            --  of which this is a primitive operation may be private, in
+            --  which case the indicator would be premature.
+
+            if Has_Private_Declaration (Etype (Subp))
+              or else Has_Private_Declaration (Etype (First_Formal (Subp)))
+            then
+               null;
+            else
+               Style.Missing_Overriding (Decl, Subp);
+            end if;
          end if;
 
       elsif Must_Override (Spec) then