This patch adds warnings to uses of potentially uninitialzed entities in instances. If an entity of a generic type has default initialization, then the corresponding actual type should be fully initialized, or else there will be uninitialized components in the instantiation that might go unreported, because in general we do not emit warnings within instances. The new predicate May_Need_Initialized_Actual allows the compiler to emit an appropriate warning in the generic itself, and a corresponding one in the instance if the actual is not fully initialized. In a sense, the use of a type that requires full initialization is a weak part of the generic contract, and this patch makes this weak obligation explicit.
Compiling warn.adb must yield: warn.adb:12:06: warning: variable "Problem" of a generic type is potentially uninitialized warn.adb:12:06: warning: instantiations must provide fully initialized type for "GR" warn.adb:16:04: warning: in instantiation at line 7 warn.adb:16:04: warning: from its use in generic unit, actual for "GR" should be fully initialized type --- procedure Warn is type R is record V : Integer; end record; generic type GR is private; package G is Thing : GR; end G; package body G is Problem : GR; end; type R2 is new R; package I is new G (R2); begin null; end; Tested on x86_64-pc-linux-gnu, committed on trunk 2014-05-21 Ed Schonberg <schonb...@adacore.com> * sinfo.ads, sinfo.adb: New flag Needs_Initialized_Actual, present in formal_Private_Definitions and on private extension declarations of a formal derived type. Set when the use of the formal type in a generic suggests that the actual should be a fully initialized type. * sem_warn.adb (May_Need_Initialized_Actual): new subprogram to indicate that an entity of a generic type has default initialization, and that the corresponing actual type in any subsequent instantiation should be fully initialized. * sem_ch12.adb (Check_Initialized_Type): new subprogram, to emit a warning if the actual for a generic type on which Needs_Initialized_Actual is set is not a fully initialized type.
Index: sinfo.adb =================================================================== --- sinfo.adb (revision 210697) +++ sinfo.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -2224,6 +2224,15 @@ return List2 (N); end Names; + function Needs_Initialized_Actual + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Formal_Private_Type_Definition + or else NT (N).Nkind = N_Private_Extension_Declaration); + return Flag18 (N); + end Needs_Initialized_Actual; + function Next_Entity (N : Node_Id) return Node_Id is begin @@ -5364,6 +5373,15 @@ Set_List2_With_Parent (N, Val); end Set_Names; + procedure Set_Needs_Initialized_Actual + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Formal_Private_Type_Definition + or else NT (N).Nkind = N_Private_Extension_Declaration); + Set_Flag18 (N, Val); + end Set_Needs_Initialized_Actual; + procedure Set_Next_Entity (N : Node_Id; Val : Node_Id) is begin Index: sinfo.ads =================================================================== --- sinfo.ads (revision 210697) +++ sinfo.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -1701,6 +1701,12 @@ -- present in an N_Subtype_Indication node, since we also use these in -- calls to Freeze_Expression. + -- Needs_Initialized_Actual (Flag18-Sem) + -- Present in formal_private_type_definitions and on private extension + -- declarations. Set when the use of a formal type in a generic suggests + -- that the actual should be a fully initialized type, to avoid potential + -- use of uninitialized values. + -- Next_Entity (Node2-Sem) -- Present in defining identifiers, defining character literals and -- defining operator symbols (i.e. in all entities). The entities of a @@ -5280,6 +5286,7 @@ -- Synchronized_Present (Flag7) -- Subtype_Indication (Node5) -- Interface_List (List2) (set to No_List if none) + -- Needs_Initialized_Actual (Flag18-Sem) --------------------- -- 8.4 Use Clause -- @@ -6705,6 +6712,7 @@ -- Abstract_Present (Flag4) -- Tagged_Present (Flag15) -- Limited_Present (Flag17) + -- Needs_Initialized_Actual (Flag18-Sem) -------------------------------------------- -- 12.5.1 Formal Derived Type Definition -- @@ -8930,7 +8938,6 @@ function Generalized_Indexing (N : Node_Id) return Node_Id; -- Node4 - function Generic_Associations (N : Node_Id) return List_Id; -- List3 @@ -9195,6 +9202,9 @@ function Names (N : Node_Id) return List_Id; -- List2 + function Needs_Initialized_Actual + (N : Node_Id) return Boolean; -- Flag18 + function Next_Entity (N : Node_Id) return Node_Id; -- Node2 @@ -10194,6 +10204,9 @@ procedure Set_Names (N : Node_Id; Val : List_Id); -- List2 + procedure Set_Needs_Initialized_Actual + (N : Node_Id; Val : Boolean := True); -- Flag18 + procedure Set_Next_Entity (N : Node_Id; Val : Node_Id); -- Node2 @@ -10940,7 +10953,7 @@ (1 => True, -- Expressions (List1) 2 => False, -- unused 3 => True, -- Prefix (Node3) - 4 => False, -- Generalized_Indexing (Node4-Sem) + 4 => False, -- Generalized_Indexing (Node4-Sem) 5 => False), -- Etype (Node5-Sem) N_Slice => @@ -12483,6 +12496,7 @@ pragma Inline (Must_Override); pragma Inline (Name); pragma Inline (Names); + pragma Inline (Needs_Initialized_Actual); pragma Inline (Next_Entity); pragma Inline (Next_Exit_Statement); pragma Inline (Next_Implicit_With); @@ -12812,6 +12826,7 @@ pragma Inline (Set_Must_Override); pragma Inline (Set_Name); pragma Inline (Set_Names); + pragma Inline (Set_Needs_Initialized_Actual); pragma Inline (Set_Next_Entity); pragma Inline (Set_Next_Exit_Statement); pragma Inline (Set_Next_Implicit_With); Index: sem_ch12.adb =================================================================== --- sem_ch12.adb (revision 210703) +++ sem_ch12.adb (working copy) @@ -9941,6 +9941,58 @@ -- List of primitives made temporarily visible in the instantiation -- to match the visibility of the formal type + procedure Check_Initialized_Types; + -- In a generic package body, an entity of a generic private type may + -- appear uninitialized. This is suspicious, unless the actual is a + -- fully initialized type. + + procedure Check_Initialized_Types is + Decl : Node_Id; + Formal : Entity_Id; + Actual : Entity_Id; + + begin + Decl := First (Generic_Formal_Declarations (Gen_Decl)); + while Present (Decl) loop + if (Nkind (Decl) = N_Private_Extension_Declaration + and then Needs_Initialized_Actual (Decl)) + + or else (Nkind (Decl) = N_Formal_Type_Declaration + and then + Nkind (Formal_Type_Definition (Decl)) = + N_Formal_Private_Type_Definition + and then Needs_Initialized_Actual + (Formal_Type_Definition (Decl))) + then + Formal := Defining_Identifier (Decl); + Actual := First_Entity (Act_Decl_Id); + + -- For each formal there is a subtype declaration that renames + -- the actual and has the same name as the formal. + + while Present (Actual) loop + exit when Ekind (Actual) = E_Package + and then Present (Renamed_Object (Actual)); + + if Chars (Actual) = Chars (Formal) + and then not Is_Scalar_Type (Actual) + and then not Is_Fully_Initialized_Type (Actual) + and then Warn_On_No_Value_Assigned + then + Error_Msg_NE + ("from its use in generic unit, actual for&" + & " should be fully initialized type?", + Actual, Formal); + exit; + end if; + + Next_Entity (Actual); + end loop; + end if; + + Next (Decl); + end loop; + end Check_Initialized_Types; begin Gen_Body_Id := Corresponding_Body (Gen_Decl); @@ -10013,6 +10065,7 @@ Set_Corresponding_Spec (Act_Body, Act_Decl_Id); Check_Generic_Actuals (Act_Decl_Id, False); + Check_Initialized_Types; -- Install primitives hidden at the point of the instantiation but -- visible when processing the generic formals Index: sem_warn.adb =================================================================== --- sem_warn.adb (revision 210697) +++ sem_warn.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2014, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -766,6 +766,14 @@ -- For an entry formal entity from an entry declaration, find the -- corresponding body formal from the given accept statement. + function May_Need_Initialized_Actual (Ent : Entity_Id) return Boolean; + -- If an entity of a generic type has default initialization, then the + -- corresponding actual type should be fully initialized, or else there + -- will be uninitialized components in the instantiation, that might go + -- unreported. This predicate allows the compiler to emit an appropriate + -- warning in the generic itself. In a sense, the use of a type that + -- requires full initialization is a weak part of the generic contract. + function Missing_Subunits return Boolean; -- We suppress warnings when there are missing subunits, because this -- may generate too many false positives: entities in a parent may only @@ -815,6 +823,44 @@ raise Program_Error; end Body_Formal; + ----------------------------------- + -- May_Need_Initialized_Actual -- + ----------------------------------- + + function May_Need_Initialized_Actual (Ent : Entity_Id) return Boolean is + T : constant Entity_Id := Etype (Ent); + Par : constant Node_Id := Parent (T); + Res : Boolean; + + begin + if not Is_Generic_Type (T) then + Res := False; + + elsif (Nkind (Par)) = N_Private_Extension_Declaration then + Set_Needs_Initialized_Actual (Par); + Res := True; + + elsif (Nkind (Par)) = N_Formal_Type_Declaration + and then Nkind (Formal_Type_Definition (Par)) + = N_Formal_Private_Type_Definition + then + Set_Needs_Initialized_Actual (Formal_Type_Definition (Par)); + Res := True; + + else + Res := False; + end if; + + if Res then + Error_Msg_N ("?!variable& of a generic type is " + & "potentially uninitialized", Ent); + Error_Msg_NE ("\?instantiations must provide fully initialized " + & "type for&", Ent, T); + end if; + + return Res; + end May_Need_Initialized_Actual; + ---------------------- -- Missing_Subunits -- ---------------------- @@ -1266,6 +1312,7 @@ if not Has_Unmodified (E1) and then not Warnings_Off_E1 and then not Is_Junk_Name (Chars (E1)) + and then not May_Need_Initialized_Actual (E1) then Output_Reference_Error ("?v?variable& is read but never assigned!"); @@ -1274,6 +1321,7 @@ elsif not Has_Unreferenced (E1) and then not Warnings_Off_E1 and then not Is_Junk_Name (Chars (E1)) + and then not May_Need_Initialized_Actual (E1) then Output_Reference_Error -- CODEFIX ("?v?variable& is never read and never assigned!"); @@ -1403,6 +1451,7 @@ end if; goto Continue; + end if; end if;