This patch adds information to illegal uss of incomplete types. If the prefix
of a selected component is an incomplete type, and the completion is found
later in the same unit, an additional error indicates the position of the
full declaration.
gcc -c -gnat05 obj.adb
must yield:
obj.adb:6:06: no selector "Component" for type "Map_Config_Window_Record'Class"
defined at obj.ads:4
obj.adb:6:06: premature usage of incomplete type "Map_Config_Window_Record"
obj.adb:6:06: full declaration at line 9
---
package Obj is
pragma Elaborate_Body;
private
type Map_Config_Window_Record;
type Config_T is access all Map_Config_Window_Record'Class;
end Obj;
---
with Ada.Finalization;
package body Obj is
procedure Trucmuch (C : Config_T) is
begin
C.Component := 1;
end Trucmuch;
type Map_Config_Window_Record is new Ada.Finalization.Controlled with
record
Component : Integer;
end record;
procedure Other_Trucmuch (C : Config_T) is
begin
C.Component := 1;
end Other_Trucmuch;
end Obj;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-09-02 Ed Schonberg <schonb...@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.
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 178460)
+++ sem_ch3.adb (working copy)
@@ -3313,18 +3313,22 @@
-- Case of initialization present
else
+ -- Check restrictions in Ada 83 and SPARK modes
- -- Not allowed in Ada 83
-
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))
then
@@ -15056,6 +15060,14 @@
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;
Index: sinfo.adb
===================================================================
--- sinfo.adb (revision 178401)
+++ sinfo.adb (working copy)
@@ -2459,6 +2459,14 @@
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 @@
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
Index: sinfo.ads
===================================================================
--- sinfo.ads (revision 178401)
+++ sinfo.ads (working copy)
@@ -1598,6 +1598,12 @@
-- 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 @@
-- 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 @@
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 @@
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 @@
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 @@
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 @@
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);
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb (revision 178436)
+++ sem_ch4.adb (working copy)
@@ -4322,6 +4322,28 @@
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;
