* [Ada] Warnings on use of uninitialized entities in an instance
@ 2014-05-21 13:14 Arnaud Charlet
0 siblings, 0 replies; only message in thread
From: Arnaud Charlet @ 2014-05-21 13:14 UTC (permalink / raw)
To: gcc-patches; +Cc: Ed Schonberg
[-- Attachment #1: Type: text/plain, Size: 2184 bytes --]
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 <schonberg@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.
[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 12299 bytes --]
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;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2014-05-21 13:14 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2014-05-21 13:14 [Ada] Warnings on use of uninitialized entities in an instance Arnaud Charlet
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).