diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c56a52527f745a767dde25386ffc9e75e4e2aba2..c45ca093dcf4480cb3a2fc369081b0a90629a935 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,63 @@
+2014-06-11 Yannick Moy <moy@adacore.com>
+
+ * einfo.ads: Minor typo in comment
+
+2014-06-11 Ed Schonberg <schonberg@adacore.com>
+
+ * sinfo.ads, sinfo.adb: New attribute Uninitialized_Variable, for
+ formal private types and private type extensions, to indicate
+ variable in a generic unit whose uninitialized use suggest that
+ actual type should be fully initialized.
+ Needs_Initialized_Actual: removed, functionaity replaced by
+ the above.
+ * lib-xref.adb (Generate_Reference): Generate a reference for
+ variables of a formal type when the unit is not the main unit,
+ to enable appropriate warnings in an instance.
+ * sem_ch12.adb (Check_Ininialized_Type): Improve warning on use
+ of variable in a generic unit that suggests that actual type
+ should be full initialized.
+ * sem_warn.adb; (May_Need_Initialized_Actual): Make into procedure
+ and do not emot warning, which now only appears in an instance.
+
+2014-06-11 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gnat_ugn.texi: Fix minor typo.
+
+2014-06-11 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch3.adb Add with and use clause for Sem_Ch10.
+ (Analyze_Declarations): Code reformatting. Analyze the contract
+ of a subprogram body stub at the end of the declarative region.
+ * sem_ch6.adb (Analyze_Subprogram_Body_Contract): Spec_Id is
+ now a variable. Do not process the body if its contract is not
+ available. Account for subprogram body stubs when extracting
+ the corresponding spec.
+ * sem_ch6.ads (Analyze_Subprogram_Contract): Update the comment
+ on usage.
+ * sem_ch10.ads, sem_ch10.adb (Analyze_Subprogram_Body_Stub_Contract):
+ New routine.
+ * sem_prag.adb (Analyze_Depends_In_Decl_Part):
+ Account for subprogram body stubs when extracting the
+ corresponding spec.
+ (Analyze_Global_In_Decl_List):
+ Account for subprogram body stubs when extracting the
+ corresponding spec.
+ (Analyze_Refined_Depends_In_Decl_Part):
+ Use Find_Related_Subprogram_Or_Body to retrieve the declaration
+ of the related body. Spec_Is now a variable. Account for
+ subprogram body stubs when extracting the corresponding spec.
+ (Analyze_Refined_Global_In_Decl_Part): Use
+ Find_Related_Subprogram_Or_Body to retrieve the declaration
+ of the related body. Spec_Is now a variable. Account for
+ subprogram body stubs when extracting the corresponding spec.
+ (Collect_Subprogram_Inputs_Output): Account for subprogram body
+ stubs when extracting the corresponding spec.
+
+2014-06-11 Vincent Celier <celier@adacore.com>
+
+ * gnatcmd.adb (Process_Link): Do not invoke gnatlink with
+ -lgnarl or -lgnat.
+
2014-06-11 Robert Dewar <dewar@adacore.com>
* debug.adb: Add debug flag -gnatd.q.
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 998be8b78422bf57ac59c19e187b5958acbdcca6..6a608a54da830ea9dab40f8f05bd54c76761f424 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -1870,7 +1870,7 @@ package Einfo is
-- include only the components corresponding to these discriminants.
-- Has_Static_Predicate_Aspect (Flag259)
--- Defined in all types and subtypes. Set if a Dynamic_Predicate aspect
+-- Defined in all types and subtypes. Set if a Static_Predicate aspect
-- applies to the type. Note that we can tell if a static predicate is
-- present by looking at Has_Predicates and Static_Predicate, but that
-- could have come from a Predicate aspect or pragma, and we need to
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 0edd66ce165846746f7d48e8052acfe997d511c3..c926eb8657360b1a685ca70811a587786655e956 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -11613,9 +11613,9 @@ the @option{-Wl,--gc-sections} option to gcc command or in the
@option{-largs} section of @command{gnatmake}. This will perform a
garbage collection of code and data never referenced.
-If the linker performs a partial link (@option{-r} ld linker option), then you
-will need to provide one or several entry point using the
-@option{-e} / @option{--entry} ld option.
+If the linker performs a partial link (@option{-r} linker option), then you
+will need to provide the entry point using the @option{-e} / @option{--entry}
+linker option.
Note that objects compiled without the @option{-ffunction-sections} and
@option{-fdata-sections} options can still be linked with the executable.
diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index 50bc3ad3568192389553c1a8b0774aa55bc4b621..7eb39cefdd41e832b9e07e64b20afe8284fd4477 100644
--- a/gcc/ada/gnatcmd.adb
+++ b/gcc/ada/gnatcmd.adb
@@ -1075,17 +1075,7 @@ procedure GNATCmd is
if Libraries_Present then
- -- Add -L<lib_dir> -lgnarl -lgnat -Wl,-rpath,<lib_dir>
-
- Last_Switches.Increment_Last;
- Last_Switches.Table (Last_Switches.Last) :=
- new String'("-L" & MLib.Utl.Lib_Directory);
- Last_Switches.Increment_Last;
- Last_Switches.Table (Last_Switches.Last) :=
- new String'("-lgnarl");
- Last_Switches.Increment_Last;
- Last_Switches.Table (Last_Switches.Last) :=
- new String'("-lgnat");
+ -- Add -Wl,-rpath,<lib_dir>
-- If Path_Option is not null, create the switch ("-Wl,-rpath," or
-- equivalent) with all the library dirs plus the standard GNAT
diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb
index d99c054c7eb3d304b59ee1a545203ed38ed5fb81..cc9ac4ce0f3262a390682f3a3310a6886abb8840 100644
--- a/gcc/ada/lib-xref.adb
+++ b/gcc/ada/lib-xref.adb
@@ -640,6 +640,11 @@ package body Lib.Xref is
-- For the same reason we accept an implicit reference generated for
-- a default in an instance.
+ -- We also set the referenced flag in a generic package that is not in
+ -- then main source unit, when the variable is of a formal private type,
+ -- to warn in the instance if the corresponding type is not a fully
+ -- initialized type.
+
if not In_Extended_Main_Source_Unit (N) then
if Typ = 'e'
or else Typ = 'I'
@@ -655,8 +660,23 @@ package body Lib.Xref is
(GNATprove_Mode
and then In_Extended_Main_Code_Unit (N)
and then (Typ = 'm' or else Typ = 'r' or else Typ = 's'))
+
then
null;
+
+ elsif In_Instance_Body
+ and then In_Extended_Main_Code_Unit (N)
+ and then Is_Generic_Type (Etype (E))
+ then
+ Set_Referenced (E);
+ return;
+
+ elsif Inside_A_Generic
+ and then Is_Generic_Type (Etype (E))
+ then
+ Set_Referenced (E);
+ return;
+
else
return;
end if;
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 49f7df1023b9cbfb29c908387fc49877313ba660..538746e7363f6e44a94607638c8eeea2d81b519a 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -1879,6 +1879,39 @@ package body Sem_Ch10 is
end if;
end Analyze_Protected_Body_Stub;
+ -------------------------------------------
+ -- Analyze_Subprogram_Body_Stub_Contract --
+ -------------------------------------------
+
+ procedure Analyze_Subprogram_Body_Stub_Contract (Stub_Id : Entity_Id) is
+ Stub_Decl : constant Node_Id := Parent (Parent (Stub_Id));
+ Spec_Id : constant Entity_Id := Corresponding_Spec_Of_Stub (Stub_Decl);
+
+ begin
+ -- A subprogram body stub may act as its own spec or as the completion
+ -- of a previous declaration. Depending on the context, the contract of
+ -- the stub may contain two sets of pragmas.
+
+ -- The stub is a completion, the applicable pragmas are:
+ -- Contract_Cases
+ -- Depends
+ -- Global
+ -- Postcondition
+ -- Precondition
+ -- Test_Case
+
+ if Present (Spec_Id) then
+ Analyze_Subprogram_Body_Contract (Stub_Id);
+
+ -- The stub acts as its own spec, the applicable pragmas are:
+ -- Refined_Depends
+ -- Refined_Global
+
+ else
+ Analyze_Subprogram_Contract (Stub_Id);
+ end if;
+ end Analyze_Subprogram_Body_Stub_Contract;
+
----------------------------------
-- Analyze_Subprogram_Body_Stub --
----------------------------------
diff --git a/gcc/ada/sem_ch10.ads b/gcc/ada/sem_ch10.ads
index 6eb7fab5cd38800a34441169d56c6c659e547678..c003526ecbe9ba8926d7d426d8e17441f9b2fae7 100644
--- a/gcc/ada/sem_ch10.ads
+++ b/gcc/ada/sem_ch10.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2010, 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- --
@@ -33,6 +33,19 @@ package Sem_Ch10 is
procedure Analyze_Protected_Body_Stub (N : Node_Id);
procedure Analyze_Subunit (N : Node_Id);
+ procedure Analyze_Subprogram_Body_Stub_Contract (Stub_Id : Entity_Id);
+ -- Analyze all delayed aspects chained on the contract of a subprogram body
+ -- stub Stub_Id as if they appeared at the end of a declarative region. The
+ -- aspects in question are:
+ -- Contract_Cases
+ -- Depends
+ -- Global
+ -- Postcondition
+ -- Precondition
+ -- Refined_Depends
+ -- Refined_Global
+ -- Test_Case
+
procedure Install_Context (N : Node_Id);
-- Installs the entities from the context clause of the given compilation
-- unit into the visibility chains. This is done before analyzing a unit.
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 2d7487667bc4f2a72dac72e99d95b42dfef46c05..acb267e79462792e7e443d0a23b7434401a757cc 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -9951,27 +9951,36 @@ package body Sem_Ch12 is
-----------------------------
procedure Check_Initialized_Types is
- Decl : Node_Id;
- Formal : Entity_Id;
- Actual : Entity_Id;
+ Decl : Node_Id;
+ Formal : Entity_Id;
+ Actual : Entity_Id;
+ Uninit_Var : 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)))
+ Uninit_Var := Empty;
+
+ if Nkind (Decl) = N_Private_Extension_Declaration then
+ Uninit_Var := Uninitialized_Variable (Decl);
+
+ elsif Nkind (Decl) = N_Formal_Type_Declaration
+ and then Nkind (Formal_Type_Definition (Decl))
+ = N_Formal_Private_Type_Definition
then
+ Uninit_Var := Uninitialized_Variable
+ (Formal_Type_Definition (Decl));
+ end if;
+
+ if Present (Uninit_Var) 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.
+ -- the actual and has the same name as the formal. Locate the
+ -- formal for warning message about uninitialized variables
+ -- in the generic, for which the actual type should be a
+ -- fully initialized type.
while Present (Actual) loop
exit when Ekind (Actual) = E_Package
@@ -9982,9 +9991,12 @@ package body Sem_Ch12 is
and then not Is_Fully_Initialized_Type (Actual)
and then Warn_On_No_Value_Assigned
then
+ Error_Msg_Node_2 := Formal;
Error_Msg_NE
- ("from its use in generic unit, actual for& should "
- & "be fully initialized type??", Actual, Formal);
+ ("generic unit has uninitialzed variable& of "
+ & " formal private type &?v?", Actual, Uninit_Var);
+ Error_Msg_NE ("actual type for& should be "
+ & "fully initialized type?v?", Actual, Formal);
exit;
end if;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 7131adb7018775359e6715d80ffd8e033f965d2c..763b85afc4e0e5fc2f7fb90d5e6a64c72bd733d2 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -57,6 +57,7 @@ with Sem_Cat; use Sem_Cat;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch7; use Sem_Ch7;
with Sem_Ch8; use Sem_Ch8;
+with Sem_Ch10; use Sem_Ch10;
with Sem_Ch13; use Sem_Ch13;
with Sem_Dim; use Sem_Dim;
with Sem_Disp; use Sem_Disp;
@@ -2371,13 +2372,16 @@ package body Sem_Ch3 is
if Nkind (Decl) = N_Object_Declaration then
Analyze_Object_Contract (Defining_Entity (Decl));
+ elsif Nkind_In (Decl, N_Abstract_Subprogram_Declaration,
+ N_Subprogram_Declaration)
+ then
+ Analyze_Subprogram_Contract (Defining_Entity (Decl));
+
elsif Nkind (Decl) = N_Subprogram_Body then
Analyze_Subprogram_Body_Contract (Defining_Entity (Decl));
- elsif Nkind_In (Decl, N_Subprogram_Declaration,
- N_Abstract_Subprogram_Declaration)
- then
- Analyze_Subprogram_Contract (Defining_Entity (Decl));
+ elsif Nkind (Decl) = N_Subprogram_Body_Stub then
+ Analyze_Subprogram_Body_Stub_Contract (Defining_Entity (Decl));
end if;
Next (Decl);
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 3695c0ad1c1e975a055011cb96757fd1a33db9b4..d8b70c8238ecbb3f6a6d9b0858b12de41464ba30 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2031,21 +2031,27 @@ package body Sem_Ch6 is
--------------------------------------
procedure Analyze_Subprogram_Body_Contract (Body_Id : Entity_Id) is
- Body_Decl : constant Node_Id := Parent (Parent (Body_Id));
- Spec_Id : constant Entity_Id := Corresponding_Spec (Body_Decl);
+ Body_Decl : constant Node_Id := Parent (Parent (Body_Id));
Prag : Node_Id;
Ref_Depends : Node_Id := Empty;
Ref_Global : Node_Id := Empty;
+ Spec_Id : Entity_Id;
begin
-- When a subprogram body declaration is illegal, its defining entity is
-- left unanalyzed. There is nothing left to do in this case because the
-- body lacks a contract.
- if not Analyzed (Body_Id) then
+ if No (Contract (Body_Id)) then
return;
end if;
+ if Nkind (Body_Decl) = N_Subprogram_Body_Stub then
+ Spec_Id := Corresponding_Spec_Of_Stub (Body_Decl);
+ else
+ Spec_Id := Corresponding_Spec (Body_Decl);
+ end if;
+
-- Locate and store pragmas Refined_Depends and Refined_Global since
-- their order of analysis matters.
diff --git a/gcc/ada/sem_ch6.ads b/gcc/ada/sem_ch6.ads
index e03341c199b816bb16f08f271459b4b30c648258..67bb65268a4eab61498998e41e2883117eb07559 100644
--- a/gcc/ada/sem_ch6.ads
+++ b/gcc/ada/sem_ch6.ads
@@ -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- --
@@ -57,6 +57,8 @@ package Sem_Ch6 is
-- as if they appeared at the end of a declarative region. The aspects in
-- question are:
-- Contract_Cases
+ -- Depends
+ -- Global
-- Postcondition
-- Precondition
-- Test_Case
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 1e377c22da3db27b4e656c8ea144fb7067a51ea4..70db276e8744560299d1b45976cee11c218fcc3d 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -1700,11 +1700,13 @@ package body Sem_Prag is
-- Refined_Depends.
if Nkind (Subp_Decl) = N_Subprogram_Body
- and then not Acts_As_Spec (Subp_Decl)
+ and then Present (Corresponding_Spec (Subp_Decl))
then
Spec_Id := Corresponding_Spec (Subp_Decl);
- elsif Nkind (Subp_Decl) = N_Subprogram_Body_Stub then
+ elsif Nkind (Subp_Decl) = N_Subprogram_Body_Stub
+ and then Present (Corresponding_Spec_Of_Stub (Subp_Decl))
+ then
Spec_Id := Corresponding_Spec_Of_Stub (Subp_Decl);
else
@@ -2327,11 +2329,13 @@ package body Sem_Prag is
-- Refined_Global.
if Nkind (Subp_Decl) = N_Subprogram_Body
- and then not Acts_As_Spec (Subp_Decl)
+ and then Present (Corresponding_Spec (Subp_Decl))
then
Spec_Id := Corresponding_Spec (Subp_Decl);
- elsif Nkind (Subp_Decl) = N_Subprogram_Body_Stub then
+ elsif Nkind (Subp_Decl) = N_Subprogram_Body_Stub
+ and then Present (Corresponding_Spec_Of_Stub (Subp_Decl))
+ then
Spec_Id := Corresponding_Spec_Of_Stub (Subp_Decl);
else
@@ -22623,7 +22627,7 @@ package body Sem_Prag is
-- Local variables
- Body_Decl : constant Node_Id := Parent (N);
+ Body_Decl : constant Node_Id := Find_Related_Subprogram_Or_Body (N);
Errors : constant Nat := Serious_Errors_Detected;
Refs : constant Node_Id :=
Get_Pragma_Arg (First (Pragma_Argument_Associations (N)));
@@ -22641,7 +22645,12 @@ package body Sem_Prag is
return;
end if;
- Spec_Id := Corresponding_Spec (Body_Decl);
+ if Nkind (Body_Decl) = N_Subprogram_Body_Stub then
+ Spec_Id := Corresponding_Spec_Of_Stub (Body_Decl);
+ else
+ Spec_Id := Corresponding_Spec (Body_Decl);
+ end if;
+
Depends := Get_Pragma (Spec_Id, Pragma_Depends);
-- Subprogram declarations lacks pragma Depends. Refined_Depends is
@@ -23390,11 +23399,11 @@ package body Sem_Prag is
-- Local variables
- Body_Decl : constant Node_Id := Parent (N);
+ Body_Decl : constant Node_Id := Find_Related_Subprogram_Or_Body (N);
Errors : constant Nat := Serious_Errors_Detected;
Items : constant Node_Id :=
Get_Pragma_Arg (First (Pragma_Argument_Associations (N)));
- Spec_Id : constant Entity_Id := Corresponding_Spec (Body_Decl);
+ Spec_Id : Entity_Id;
-- Start of processing for Analyze_Refined_Global_In_Decl_Part
@@ -23407,6 +23416,12 @@ package body Sem_Prag is
return;
end if;
+ if Nkind (Body_Decl) = N_Subprogram_Body_Stub then
+ Spec_Id := Corresponding_Spec_Of_Stub (Body_Decl);
+ else
+ Spec_Id := Corresponding_Spec (Body_Decl);
+ end if;
+
Global := Get_Pragma (Spec_Id, Pragma_Global);
-- The subprogram declaration lacks pragma Global. This renders
@@ -25323,10 +25338,11 @@ package body Sem_Prag is
-- Local variables
- Formal : Entity_Id;
- Global : Node_Id;
- List : Node_Id;
- Spec_Id : Entity_Id;
+ Subp_Decl : constant Node_Id := Parent (Parent (Subp_Id));
+ Formal : Entity_Id;
+ Global : Node_Id;
+ List : Node_Id;
+ Spec_Id : Entity_Id;
-- Start of processing for Collect_Subprogram_Inputs_Outputs
@@ -25335,8 +25351,16 @@ package body Sem_Prag is
-- Find the entity of the corresponding spec when processing a body
- if Ekind (Subp_Id) = E_Subprogram_Body then
- Spec_Id := Corresponding_Spec (Parent (Parent (Subp_Id)));
+ if Nkind (Subp_Decl) = N_Subprogram_Body
+ and then Present (Corresponding_Spec (Subp_Decl))
+ then
+ Spec_Id := Corresponding_Spec (Subp_Decl);
+
+ elsif Nkind (Subp_Decl) = N_Subprogram_Body_Stub
+ and then Present (Corresponding_Spec_Of_Stub (Subp_Decl))
+ then
+ Spec_Id := Corresponding_Spec_Of_Stub (Subp_Decl);
+
else
Spec_Id := Subp_Id;
end if;
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 9d6366879d56d64d86f4d35202afd3b66f056de0..cc4337fd9e82194ccbebde9ad08f4caa698fcaef 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -762,13 +762,14 @@ package body Sem_Warn is
-- 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;
+ procedure May_Need_Initialized_Actual (Ent : Entity_Id);
-- 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.
+ -- unreported. This routine marks the type of the uninitialized variable
+ -- appropriately to allow the compiler to emit an appropriate warning
+ -- in the instance. 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
@@ -823,38 +824,30 @@ package body Sem_Warn is
-- May_Need_Initialized_Actual --
-----------------------------------
- function May_Need_Initialized_Actual (Ent : Entity_Id) return Boolean is
+ procedure May_Need_Initialized_Actual (Ent : Entity_Id) 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;
+ null;
elsif (Nkind (Par)) = N_Private_Extension_Declaration then
- Set_Needs_Initialized_Actual (Par);
- Res := True;
+
+ -- We only indicate the first such variable in the generic.
+
+ if No (Uninitialized_Variable (Par)) then
+ Set_Uninitialized_Variable (Par, Ent);
+ end if;
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);
+ if No (Uninitialized_Variable (Formal_Type_Definition (Par))) then
+ Set_Uninitialized_Variable (Formal_Type_Definition (Par), Ent);
+ end if;
end if;
-
- return Res;
end May_Need_Initialized_Actual;
----------------------
@@ -1305,10 +1298,10 @@ package body Sem_Warn is
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!");
+ May_Need_Initialized_Actual (E1);
end if;
elsif not Has_Unreferenced (E1)
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index c1eaae557930f545f2af22b8899a39af8f182428..0c1a7776502e4c5a11aba12df62c68bd9f6cc813 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -2224,15 +2224,6 @@ package body Sinfo is
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
@@ -3184,6 +3175,15 @@ package body Sinfo is
return List2 (N);
end Visible_Declarations;
+ function Uninitialized_Variable
+ (N : Node_Id) return Node_Id 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 Node3 (N);
+ end Uninitialized_Variable;
+
function Used_Operations
(N : Node_Id) return Elist_Id is
begin
@@ -5373,15 +5373,6 @@ package body Sinfo is
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
@@ -6333,6 +6324,15 @@ package body Sinfo is
Set_List2_With_Parent (N, Val);
end Set_Visible_Declarations;
+ procedure Set_Uninitialized_Variable
+ (N : Node_Id; Val : Node_Id) 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_Node3 (N, Val);
+ end Set_Uninitialized_Variable;
+
procedure Set_Used_Operations
(N : Node_Id; Val : Elist_Id) is
begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 9a0afe7f5a740983ab25262e499042fc0e4860a6..73dea2a660153b7ab79f2686225e110fadf44685 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1701,12 +1701,6 @@ package Sinfo is
-- 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
@@ -2050,6 +2044,13 @@ package Sinfo is
-- the body, so this flag is used to generate the proper message (see
-- Sem_Util.Check_Unused_Withs for details)
+ -- Uninitialized_Variable (Node3-Sem)
+ -- Present in N_Formal_Private_Type_Definition and in N_Private_
+ -- Extension_Declarations. Indicates that a variable in a generic unit
+ -- whose type is a formal private or derived type is read without being
+ -- initialized. Used to warn if the corresponding actual type is not
+ -- a fully initialized type.
+
-- Used_Operations (Elist5-Sem)
-- Present in N_Use_Type_Clause nodes. Holds the list of operations that
-- are made potentially use-visible by the clause. Simplifies processing
@@ -5278,6 +5279,7 @@ package Sinfo is
-- N_Private_Extension_Declaration
-- Sloc points to TYPE
-- Defining_Identifier (Node1)
+ -- Uninitialized_Variable (Node3-Sem)
-- Discriminant_Specifications (List4) (set to No_List if no
-- discriminant part)
-- Unknown_Discriminants_Present (Flag13) set if (<>) discriminant
@@ -5286,7 +5288,6 @@ package Sinfo is
-- Synchronized_Present (Flag7)
-- Subtype_Indication (Node5)
-- Interface_List (List2) (set to No_List if none)
- -- Needs_Initialized_Actual (Flag18-Sem)
---------------------
-- 8.4 Use Clause --
@@ -6709,10 +6710,10 @@ package Sinfo is
-- N_Formal_Private_Type_Definition
-- Sloc points to PRIVATE
+ -- Uninitialized_Variable (Node3-Sem)
-- Abstract_Present (Flag4)
-- Tagged_Present (Flag15)
-- Limited_Present (Flag17)
- -- Needs_Initialized_Actual (Flag18-Sem)
--------------------------------------------
-- 12.5.1 Formal Derived Type Definition --
@@ -9202,9 +9203,6 @@ package Sinfo is
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
@@ -9502,6 +9500,9 @@ package Sinfo is
function Visible_Declarations
(N : Node_Id) return List_Id; -- List2
+ function Uninitialized_Variable
+ (N : Node_Id) return Node_Id; -- Node3
+
function Used_Operations
(N : Node_Id) return Elist_Id; -- Elist5
@@ -10204,9 +10205,6 @@ package Sinfo is
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
@@ -10504,6 +10502,9 @@ package Sinfo is
procedure Set_Visible_Declarations
(N : Node_Id; Val : List_Id); -- List2
+ procedure Set_Uninitialized_Variable
+ (N : Node_Id; Val : Node_Id); -- Node3
+
procedure Set_Used_Operations
(N : Node_Id; Val : Elist_Id); -- Elist5
@@ -12496,7 +12497,6 @@ package Sinfo is
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);
@@ -12591,6 +12591,7 @@ package Sinfo is
pragma Inline (TSS_Elist);
pragma Inline (Type_Definition);
pragma Inline (Unit);
+ pragma Inline (Uninitialized_Variable);
pragma Inline (Unknown_Discriminants_Present);
pragma Inline (Unreferenced_In_Spec);
pragma Inline (Variant_Part);
@@ -12826,7 +12827,6 @@ package Sinfo is
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);
@@ -12919,6 +12919,7 @@ package Sinfo is
pragma Inline (Set_Triggering_Statement);
pragma Inline (Set_Type_Definition);
pragma Inline (Set_Unit);
+ pragma Inline (Set_Uninitialized_Variable);
pragma Inline (Set_Unknown_Discriminants_Present);
pragma Inline (Set_Unreferenced_In_Spec);
pragma Inline (Set_Used_Operations);