git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

[multiple changes] 

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.

From-SVN: r211454
This commit is contained in:
Arnaud Charlet 2014-06-11 14:22:57 +02:00
parent 4622301b0d
commit 2c8d828a5f
15 changed files with 267 additions and 109 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
gcc/ada/ChangeLog
View File

@ -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.

2
gcc/ada/einfo.ads
View File

@ -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

6
gcc/ada/gnat_ugn.texi
View File

@ -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.

12
gcc/ada/gnatcmd.adb
View File

@ -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

20
gcc/ada/lib-xref.adb
View File

@ -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;

33
gcc/ada/sem_ch10.adb
View File

@ -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 --
----------------------------------

15
gcc/ada/sem_ch10.ads
View File

@ -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.

38
gcc/ada/sem_ch12.adb
View File

@ -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))
Uninit_Var := Empty;
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)))
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;

12
gcc/ada/sem_ch3.adb
View File

@ -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);

12
gcc/ada/sem_ch6.adb
View File

@ -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.

4
gcc/ada/sem_ch6.ads
View File

@ -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

52
gcc/ada/sem_prag.adb
View File

@ -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;

41
gcc/ada/sem_warn.adb
View File

@ -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;
if No (Uninitialized_Variable (Formal_Type_Definition (Par))) then
Set_Uninitialized_Variable (Formal_Type_Definition (Par), Ent);
end if;
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;
----------------------
@ -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)

36
gcc/ada/sinfo.adb
View File

@ -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

33
gcc/ada/sinfo.ads
View File

@ -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);