sinfo.ads, sinfo.adb: New semantic attribute Premature_Use...

2011-09-02  Ed Schonberg  <schonberg@adacore.com>

	* sinfo.ads, sinfo.adb: New semantic attribute Premature_Use,
	present in incomplete type declarations to refine the error
	message the full declaration is in the same unit.
	* sem_ch4.adb (Analyze_Selected_Component): If the prefix is of
	an incomplete type, set the Premature_Use for additional message.
	* sem_ch3.adb (Find_Type_Name): If partial view is incomplete
	and Premature_Use is set, place additional information at the
	point of premature use.

From-SVN: r178461

5 files changed, 83 insertions, 7 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4ca7037..52c8f1c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+2011-09-02  Ed Schonberg  <schonberg@adacore.com>
+
+	* sinfo.ads, sinfo.adb: New semantic attribute Premature_Use,
+	present in incomplete type declarations to refine the error
+	message the full declaration is in the same unit.
+	* sem_ch4.adb (Analyze_Selected_Component): If the prefix is of
+	an incomplete type, set the Premature_Use for additional message.
+	* sem_ch3.adb (Find_Type_Name): If partial view is incomplete
+	and Premature_Use is set, place additional information at the
+	point of premature use.
+
 2011-09-02  Bob Duff  <duff@adacore.com>
 
 	* sem_ch6.adb: (Check_Post_State): Suppress warning
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index fb702f3..372f7d2 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -3313,17 +3313,21 @@ package body Sem_Ch3 is
          --  Case of initialization present
 
          else
-
-            --  Not allowed in Ada 83
+            --  Check restrictions in Ada 83 and SPARK modes
 
             if not Constant_Present (N) then
 
-               --  A declaration of unconstrained type in SPARK is limited,
-               --  the only exception to this is the admission of declaration
-               --  of constants of type string.
+               --  In SPARK, a declaration of unconstrained type is allowed
+               --  only for constants of type string.
+
+               --  Why no check for Comes_From_Source here, seems wrong ???
+               --  Where is check to differentiate string case ???
 
                Check_SPARK_Restriction
-                 ("declaration of unconstrained type is limited", E);
+                 ("declaration of object of unconstrained type not allowed",
+                  E);
+
+               --  Unconstrained variables not allowed in Ada 83 mode
 
                if Ada_Version = Ada_83
                  and then Comes_From_Source (Object_Definition (N))
@@ -15056,6 +15060,14 @@ package body Sem_Ch3 is
                Tag_Mismatch;
             end if;
          end if;
+         if Present (Prev)
+           and then Nkind (Parent (Prev)) = N_Incomplete_Type_Declaration
+           and then Present (Premature_Use (Parent (Prev)))
+         then
+            Error_Msg_Sloc := Sloc (N);
+            Error_Msg_N
+              ("\full declaration #", Premature_Use (Parent (Prev)));
+         end if;
 
          return New_Id;
       end if;
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 3f04964..e539a56 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -4322,6 +4322,28 @@ package body Sem_Ch4 is
             Error_Msg_Node_2 := First_Subtype (Prefix_Type);
             Error_Msg_NE ("no selector& for}", N, Sel);
 
+            --  If prefix is incomplete, dd information.
+
+            if Is_Incomplete_Type (Type_To_Use) then
+               declare
+                  Inc : constant Entity_Id := First_Subtype (Type_To_Use);
+
+               begin
+                  if From_With_Type (Scope (Type_To_Use)) then
+                     Error_Msg_NE
+                       ("\limited view of& has no components", N, Inc);
+                  else
+                     Error_Msg_NE
+                       ("\premature usage of incomplete type&", N, Inc);
+                     if
+                       Nkind (Parent (Inc)) = N_Incomplete_Type_Declaration
+                     then
+                        Set_Premature_Use (Parent (Inc), N);
+                     end if;
+                  end if;
+               end;
+            end if;
+
             Check_Misspelled_Selector (Type_To_Use, Sel);
          end if;
 
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index 67baab9..32d9938 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -2459,6 +2459,14 @@ package body Sinfo is
       return Node3 (N);
    end Prefix;
 
+   function Premature_Use
+      (N : Node_Id) return Node_Id is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Incomplete_Type_Declaration);
+      return Node5 (N);
+   end Premature_Use;
+
    function Present_Expr
       (N : Node_Id) return Uint is
    begin
@@ -5510,6 +5518,14 @@ package body Sinfo is
       Set_Node3_With_Parent (N, Val);
    end Set_Prefix;
 
+   procedure Set_Premature_Use
+      (N : Node_Id; Val : Node_Id) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Incomplete_Type_Declaration);
+      Set_Node5 (N, Val);
+   end Set_Premature_Use;
+
    procedure Set_Present_Expr
       (N : Node_Id; Val : Uint) is
    begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index af6fab2..203d186 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1598,6 +1598,12 @@ package Sinfo is
    --    package specification. This field is Empty for library bodies (the
    --    parent spec in this case can be found from the corresponding spec).
 
+   --  Premature_Use (Node5-Sem)
+   --    Present in N_Incomplete_Type_Declaration node. Used for improved
+   --    error diagnostics: if there is a premature usage of an incomplete
+   --    type, a subsequently generated error message indicates the position
+   --    of its full declaration.
+
    --  Present_Expr (Uint3-Sem)
    --    Present in an N_Variant node. This has a meaningful value only after
    --    Gigi has back annotated the tree with representation information. At
@@ -3091,6 +3097,7 @@ package Sinfo is
       --  Discriminant_Specifications (List4) (set to No_List if no
       --   discriminant part, or if the discriminant part is an
       --   unknown discriminant part)
+      --  Premature_Use (Node5-Sem) used for improved diagnostics.
       --  Unknown_Discriminants_Present (Flag13) set if (<>) discriminant
       --  Tagged_Present (Flag15)
 
@@ -8814,6 +8821,9 @@ package Sinfo is
    function Prefix
      (N : Node_Id) return Node_Id;    -- Node3
 
+   function Premature_Use
+     (N : Node_Id) return Node_Id;    -- Node5
+
    function Present_Expr
      (N : Node_Id) return Uint;       -- Uint3
 
@@ -9786,6 +9796,9 @@ package Sinfo is
    procedure Set_Prefix
      (N : Node_Id; Val : Node_Id);            -- Node3
 
+   procedure Set_Premature_Use
+     (N : Node_Id; Val : Node_Id);            -- Node5
+
    procedure Set_Present_Expr
      (N : Node_Id; Val : Uint);               -- Uint3
 
@@ -10420,7 +10433,7 @@ package Sinfo is
         2 => False,   --  unused
         3 => False,   --  unused
         4 => True,    --  Discriminant_Specifications (List4)
-        5 => False),  --  unused
+        5 => False),  --  Premature_Use
 
      N_Explicit_Dereference =>
        (1 => False,   --  unused
@@ -11993,6 +12006,7 @@ package Sinfo is
    pragma Inline (Pragmas_After);
    pragma Inline (Pragmas_Before);
    pragma Inline (Prefix);
+   pragma Inline (Premature_Use);
    pragma Inline (Present_Expr);
    pragma Inline (Prev_Ids);
    pragma Inline (Print_In_Hex);
@@ -12314,6 +12328,7 @@ package Sinfo is
    pragma Inline (Set_Pragmas_After);
    pragma Inline (Set_Pragmas_Before);
    pragma Inline (Set_Prefix);
+   pragma Inline (Set_Premature_Use);
    pragma Inline (Set_Present_Expr);
    pragma Inline (Set_Prev_Ids);
    pragma Inline (Set_Print_In_Hex);