public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-3818] [Ada] Fix conformance errors and erroneous code
@ 2021-09-22 15:11 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-09-22 15:11 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:c0471c61e1f3bcd86e819f2e6b5e054f80572a41
commit r12-3818-gc0471c61e1f3bcd86e819f2e6b5e054f80572a41
Author: Bob Duff <duff@adacore.com>
Date: Mon Jul 26 15:26:28 2021 -0400
[Ada] Fix conformance errors and erroneous code
gcc/ada/
* contracts.adb, einfo-utils.adb, einfo-utils.ads, exp_ch7.adb,
exp_ch9.adb, exp_disp.adb, exp_prag.adb, exp_smem.adb,
exp_util.adb, freeze.adb, sem_aggr.adb, sem_attr.adb,
sem_ch8.adb, sem_prag.ads, sem_util.adb, sem_util.ads: Fix
conformance errors.
* errout.adb, erroutc.adb: Remove pragmas Suppress.
* err_vars.ads: Initialize variables that were previously being
read uninitialized.
Diff:
---
gcc/ada/contracts.adb | 6 +++---
gcc/ada/einfo-utils.adb | 4 ++--
gcc/ada/einfo-utils.ads | 2 +-
gcc/ada/err_vars.ads | 17 ++++++++++-------
gcc/ada/errout.adb | 20 ++++----------------
gcc/ada/erroutc.adb | 48 ++++++++++++------------------------------------
gcc/ada/exp_ch7.adb | 8 ++++----
gcc/ada/exp_ch9.adb | 10 +++++-----
gcc/ada/exp_disp.adb | 2 +-
gcc/ada/exp_prag.adb | 12 ++++++------
gcc/ada/exp_smem.adb | 2 +-
gcc/ada/exp_util.adb | 4 ++--
gcc/ada/freeze.adb | 12 ++++++------
gcc/ada/sem_aggr.adb | 2 +-
gcc/ada/sem_attr.adb | 2 +-
gcc/ada/sem_ch8.adb | 11 +++--------
gcc/ada/sem_prag.ads | 2 +-
gcc/ada/sem_util.adb | 2 +-
gcc/ada/sem_util.ads | 2 +-
19 files changed, 65 insertions(+), 103 deletions(-)
diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb
index e37e092898f..705f197148c 100644
--- a/gcc/ada/contracts.adb
+++ b/gcc/ada/contracts.adb
@@ -3440,7 +3440,7 @@ package body Contracts is
-- Get_Postcond_Enabled --
--------------------------
- function Get_Postcond_Enabled (Subp : Entity_Id) return Node_Id is
+ function Get_Postcond_Enabled (Subp : Entity_Id) return Entity_Id is
Decl : Node_Id;
begin
Decl :=
@@ -3465,7 +3465,7 @@ package body Contracts is
------------------------------------
function Get_Result_Object_For_Postcond
- (Subp : Entity_Id) return Node_Id
+ (Subp : Entity_Id) return Entity_Id
is
Decl : Node_Id;
begin
@@ -3490,7 +3490,7 @@ package body Contracts is
-- Get_Return_Success_For_Postcond --
-------------------------------------
- function Get_Return_Success_For_Postcond (Subp : Entity_Id) return Node_Id
+ function Get_Return_Success_For_Postcond (Subp : Entity_Id) return Entity_Id
is
Decl : Node_Id;
begin
diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb
index cbd957bd9b9..4e5f43436f4 100644
--- a/gcc/ada/einfo-utils.adb
+++ b/gcc/ada/einfo-utils.adb
@@ -701,7 +701,7 @@ package body Einfo.Utils is
-- Entry_Index_Type --
----------------------
- function Entry_Index_Type (Id : E) return N is
+ function Entry_Index_Type (Id : E) return E is
begin
pragma Assert (Ekind (Id) = E_Entry_Family);
return Etype (Discrete_Subtype_Definition (Parent (Id)));
@@ -1745,7 +1745,7 @@ package body Einfo.Utils is
-- Link_Entities --
-------------------
- procedure Link_Entities (First : Entity_Id; Second : Node_Id) is
+ procedure Link_Entities (First, Second : Entity_Id) is
begin
if Present (Second) then
Set_Prev_Entity (Second, First); -- First <-- Second
diff --git a/gcc/ada/einfo-utils.ads b/gcc/ada/einfo-utils.ads
index 4eca35e1e5f..8046722442b 100644
--- a/gcc/ada/einfo-utils.ads
+++ b/gcc/ada/einfo-utils.ads
@@ -625,7 +625,7 @@ package Einfo.Utils is
-- WARNING: There is a matching C declaration of this subprogram in fe.h
- procedure Link_Entities (First : Entity_Id; Second : Entity_Id);
+ procedure Link_Entities (First, Second : Entity_Id);
-- Link entities First and Second in one entity chain.
--
-- NOTE: No updates are done to the First_Entity and Last_Entity fields
diff --git a/gcc/ada/err_vars.ads b/gcc/ada/err_vars.ads
index 366df629d74..819d1ad9ad3 100644
--- a/gcc/ada/err_vars.ads
+++ b/gcc/ada/err_vars.ads
@@ -105,12 +105,15 @@ package Err_Vars is
-- of the following global variables to appropriate values before making a
-- call to one of the error message routines with a string containing the
-- insertion character to get the value inserted in an appropriate format.
+ --
+ -- Some of these are initialized below, because they are read before being
+ -- set by clients.
Error_Msg_Col : Column_Number;
-- Column for @ insertion character in message
Error_Msg_Uint_1 : Uint;
- Error_Msg_Uint_2 : Uint;
+ Error_Msg_Uint_2 : Uint := No_Uint;
-- Uint values for ^ insertion characters in message
-- WARNING: There is a matching C declaration of these variables in fe.h
@@ -119,21 +122,21 @@ package Err_Vars is
-- Source location for # insertion character in message
Error_Msg_Name_1 : Name_Id;
- Error_Msg_Name_2 : Name_Id;
- Error_Msg_Name_3 : Name_Id;
+ Error_Msg_Name_2 : Name_Id := No_Name;
+ Error_Msg_Name_3 : Name_Id := No_Name;
-- Name_Id values for % insertion characters in message
Error_Msg_File_1 : File_Name_Type;
- Error_Msg_File_2 : File_Name_Type;
- Error_Msg_File_3 : File_Name_Type;
+ Error_Msg_File_2 : File_Name_Type := No_File;
+ Error_Msg_File_3 : File_Name_Type := No_File;
-- File_Name_Type values for { insertion characters in message
Error_Msg_Unit_1 : Unit_Name_Type;
- Error_Msg_Unit_2 : Unit_Name_Type;
+ Error_Msg_Unit_2 : Unit_Name_Type := No_Unit_Name;
-- Unit_Name_Type values for $ insertion characters in message
Error_Msg_Node_1 : Node_Id;
- Error_Msg_Node_2 : Node_Id;
+ Error_Msg_Node_2 : Node_Id := Empty;
-- Node_Id values for & insertion characters in message
Error_Msg_Warn : Boolean;
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 99c7f9a10b1..05a826682e0 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -3602,15 +3602,9 @@ package body Errout is
end if;
-- The following assignment ensures that a second ampersand insertion
- -- character will correspond to the Error_Msg_Node_2 parameter. We
- -- suppress possible validity checks in case operating in -gnatVa mode,
- -- and Error_Msg_Node_2 is not needed and has not been set.
+ -- character will correspond to the Error_Msg_Node_2 parameter.
- declare
- pragma Suppress (Range_Check);
- begin
- Error_Msg_Node_1 := Error_Msg_Node_2;
- end;
+ Error_Msg_Node_1 := Error_Msg_Node_2;
end Set_Msg_Insertion_Node;
--------------------------------------
@@ -3790,15 +3784,9 @@ package body Errout is
end if;
-- The following assignment ensures that a second percent insertion
- -- character will correspond to the Error_Msg_Unit_2 parameter. We
- -- suppress possible validity checks in case operating in -gnatVa mode,
- -- and Error_Msg_Unit_2 is not needed and has not been set.
+ -- character will correspond to the Error_Msg_Unit_2 parameter.
- declare
- pragma Suppress (Range_Check);
- begin
- Error_Msg_Unit_1 := Error_Msg_Unit_2;
- end;
+ Error_Msg_Unit_1 := Error_Msg_Unit_2;
end Set_Msg_Insertion_Unit_Name;
------------------
diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index a2cd3c3c7e0..9e67b929cb7 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -1119,17 +1119,11 @@ package body Erroutc is
end if;
-- The following assignments ensure that the second and third {
- -- insertion characters will correspond to the Error_Msg_File_2 and
- -- Error_Msg_File_3 values and We suppress possible validity checks in
- -- case operating in -gnatVa mode, and Error_Msg_File_2 or
- -- Error_Msg_File_3 is not needed and has not been set.
+ -- insertion characters will correspond to the Error_Msg_File_2
+ -- and Error_Msg_File_3 values.
- declare
- pragma Suppress (Range_Check);
- begin
- Error_Msg_File_1 := Error_Msg_File_2;
- Error_Msg_File_2 := Error_Msg_File_3;
- end;
+ Error_Msg_File_1 := Error_Msg_File_2;
+ Error_Msg_File_2 := Error_Msg_File_3;
end Set_Msg_Insertion_File_Name;
-----------------------------------
@@ -1299,16 +1293,10 @@ package body Erroutc is
-- The following assignments ensure that the second and third percent
-- insertion characters will correspond to the Error_Msg_Name_2 and
- -- Error_Msg_Name_3 as required. We suppress possible validity checks in
- -- case operating in -gnatVa mode, and Error_Msg_Name_1/2 is not needed
- -- and has not been set.
+ -- Error_Msg_Name_3 as required.
- declare
- pragma Suppress (Range_Check);
- begin
- Error_Msg_Name_1 := Error_Msg_Name_2;
- Error_Msg_Name_2 := Error_Msg_Name_3;
- end;
+ Error_Msg_Name_1 := Error_Msg_Name_2;
+ Error_Msg_Name_2 := Error_Msg_Name_3;
end Set_Msg_Insertion_Name;
------------------------------------
@@ -1334,16 +1322,10 @@ package body Erroutc is
-- The following assignments ensure that the second and third % or %%
-- insertion characters will correspond to the Error_Msg_Name_2 and
- -- Error_Msg_Name_3 values and We suppress possible validity checks in
- -- case operating in -gnatVa mode, and Error_Msg_Name_2 or
- -- Error_Msg_Name_3 is not needed and has not been set.
+ -- Error_Msg_Name_3 values.
- declare
- pragma Suppress (Range_Check);
- begin
- Error_Msg_Name_1 := Error_Msg_Name_2;
- Error_Msg_Name_2 := Error_Msg_Name_3;
- end;
+ Error_Msg_Name_1 := Error_Msg_Name_2;
+ Error_Msg_Name_2 := Error_Msg_Name_3;
end Set_Msg_Insertion_Name_Literal;
-------------------------------------
@@ -1427,15 +1409,9 @@ package body Erroutc is
end loop;
-- The following assignment ensures that a second caret insertion
- -- character will correspond to the Error_Msg_Uint_2 parameter. We
- -- suppress possible validity checks in case operating in -gnatVa mode,
- -- and Error_Msg_Uint_2 is not needed and has not been set.
+ -- character will correspond to the Error_Msg_Uint_2 parameter.
- declare
- pragma Suppress (Range_Check);
- begin
- Error_Msg_Uint_1 := Error_Msg_Uint_2;
- end;
+ Error_Msg_Uint_1 := Error_Msg_Uint_2;
end Set_Msg_Insertion_Uint;
-----------------
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 8d08ff12ed5..71cad989dc1 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -486,11 +486,11 @@ package body Exp_Ch7 is
function Make_Deep_Proc
(Prim : Final_Primitives;
Typ : Entity_Id;
- Stmts : List_Id) return Node_Id;
+ Stmts : List_Id) return Entity_Id;
-- This function generates the tree for Deep_Initialize, Deep_Adjust or
- -- Deep_Finalize procedures according to the first parameter, these
- -- procedures operate on the type Typ. The Stmts parameter gives the body
- -- of the procedure.
+ -- Deep_Finalize procedures according to the first parameter. These
+ -- procedures operate on the type Typ. The Stmts parameter gives the
+ -- body of the procedure.
function Make_Deep_Array_Body
(Prim : Final_Primitives;
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 427b4301514..dec41eed2f8 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -145,7 +145,7 @@ package body Exp_Ch9 is
function Build_Corresponding_Record
(N : Node_Id;
- Ctyp : Node_Id;
+ Ctyp : Entity_Id;
Loc : Source_Ptr) return Node_Id;
-- Common to tasks and protected types. Copy discriminant specifications,
-- build record declaration. N is the type declaration, Ctyp is the
@@ -1583,9 +1583,9 @@ package body Exp_Ch9 is
--------------------------------
function Build_Corresponding_Record
- (N : Node_Id;
- Ctyp : Entity_Id;
- Loc : Source_Ptr) return Node_Id
+ (N : Node_Id;
+ Ctyp : Entity_Id;
+ Loc : Source_Ptr) return Node_Id
is
Rec_Ent : constant Entity_Id :=
Make_Defining_Identifier
@@ -14867,7 +14867,7 @@ package body Exp_Ch9 is
Actuals : List_Id;
Formals : List_Id;
Decls : List_Id;
- Stmts : List_Id) return Node_Id
+ Stmts : List_Id) return Entity_Id
is
Actual : Entity_Id;
Expr : Node_Id := Empty;
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index bac64928c57..cfe6279aaf2 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -348,7 +348,7 @@ package body Exp_Disp is
-- Build_Static_Dispatch_Tables --
----------------------------------
- procedure Build_Static_Dispatch_Tables (N : Entity_Id) is
+ procedure Build_Static_Dispatch_Tables (N : Node_Id) is
Target_List : List_Id;
procedure Build_Dispatch_Tables (List : List_Id);
diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index 43ecdcdd333..55842f70f57 100644
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -752,10 +752,10 @@ package body Exp_Prag is
-- value of which is Init_Val if present or null if not.
function Build_Simple_Declaration_With_Default
- (Decl_Id : Entity_Id;
- Init_Val : Entity_Id;
- Typ : Entity_Id;
- Default_Val : Entity_Id) return Node_Id;
+ (Decl_Id : Entity_Id;
+ Init_Val : Node_Id;
+ Typ : Node_Id;
+ Default_Val : Node_Id) return Node_Id;
-- Build a declaration the Defining_Identifier of which is Decl_Id, the
-- Object_Definition of which is Typ, the value of which is Init_Val if
-- present or Default otherwise.
@@ -983,7 +983,7 @@ package body Exp_Prag is
function Build_Simple_Declaration_With_Default
(Decl_Id : Entity_Id;
Init_Val : Node_Id;
- Typ : Entity_Id;
+ Typ : Node_Id;
Default_Val : Node_Id) return Node_Id
is
Value : Node_Id := Init_Val;
@@ -2862,7 +2862,7 @@ package body Exp_Prag is
procedure Expand_Pragma_Subprogram_Variant
(Prag : Node_Id;
- Subp_Id : Node_Id;
+ Subp_Id : Entity_Id;
Body_Decls : List_Id)
is
Curr_Decls : List_Id;
diff --git a/gcc/ada/exp_smem.adb b/gcc/ada/exp_smem.adb
index 45db4870eea..216065f5be9 100644
--- a/gcc/ada/exp_smem.adb
+++ b/gcc/ada/exp_smem.adb
@@ -86,7 +86,7 @@ package body Exp_Smem is
function Build_Shared_Var_Proc_Call
(Loc : Source_Ptr;
- E : Node_Id;
+ E : Entity_Id;
N : Name_Id) return Node_Id;
-- Build a call to support procedure N for shared object E (provided by the
-- instance of System.Shared_Storage.Shared_Var_Procs associated to E).
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 59c87637c67..807afb2c580 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -4914,7 +4914,7 @@ package body Exp_Util is
-- Convert_To_Actual_Subtype --
-------------------------------
- procedure Convert_To_Actual_Subtype (Exp : Entity_Id) is
+ procedure Convert_To_Actual_Subtype (Exp : Node_Id) is
Act_ST : Entity_Id;
begin
@@ -7048,7 +7048,7 @@ package body Exp_Util is
-- Get_Index_Subtype --
-----------------------
- function Get_Index_Subtype (N : Node_Id) return Node_Id is
+ function Get_Index_Subtype (N : Node_Id) return Entity_Id is
P_Type : Entity_Id := Etype (Prefix (N));
Indx : Node_Id;
J : Int;
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 51671419b44..5b7607d051d 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -284,11 +284,11 @@ package body Freeze is
-- Full_View or Corresponding_Record_Type.
procedure Warn_Overlay (Expr : Node_Id; Typ : Entity_Id; Nam : Node_Id);
- -- Expr is the expression for an address clause for entity Nam whose type
- -- is Typ. If Typ has a default initialization, and there is no explicit
- -- initialization in the source declaration, check whether the address
- -- clause might cause overlaying of an entity, and emit a warning on the
- -- side effect that the initialization will cause.
+ -- Expr is the expression for an address clause for the entity denoted by
+ -- Nam whose type is Typ. If Typ has a default initialization, and there is
+ -- no explicit initialization in the source declaration, check whether the
+ -- address clause might cause overlaying of an entity, and emit a warning
+ -- on the side effect that the initialization will cause.
-------------------------------
-- Adjust_Esize_For_Alignment --
@@ -10081,7 +10081,7 @@ package body Freeze is
-- Warn_Overlay --
------------------
- procedure Warn_Overlay (Expr : Node_Id; Typ : Entity_Id; Nam : Entity_Id) is
+ procedure Warn_Overlay (Expr : Node_Id; Typ : Entity_Id; Nam : Node_Id) is
Ent : constant Entity_Id := Entity (Nam);
-- The object to which the address clause applies
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 9ad96296dd4..23d5ba22615 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -365,7 +365,7 @@ package body Sem_Aggr is
-- to the expansion phase. As an optimization, if the discrete choice
-- specifies a single value we do not delay resolution.
- function Array_Aggr_Subtype (N : Node_Id; Typ : Node_Id) return Entity_Id;
+ function Array_Aggr_Subtype (N : Node_Id; Typ : Entity_Id) return Entity_Id;
-- This routine returns the type or subtype of an array aggregate.
--
-- N is the array aggregate node whose type we return.
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index f631e948a3e..d954d46aaad 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -12469,7 +12469,7 @@ package body Sem_Attr is
function Stream_Attribute_Available
(Typ : Entity_Id;
Nam : TSS_Name_Type;
- Partial_View : Node_Id := Empty) return Boolean
+ Partial_View : Entity_Id := Empty) return Boolean
is
Etyp : Entity_Id := Typ;
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index a9f0f13e1e2..70ad21ccc24 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -426,12 +426,10 @@ package body Sem_Ch8 is
-- body at the point of freezing will not work. Subp is the subprogram
-- for which N provides the Renaming_As_Body.
- procedure Check_In_Previous_With_Clause
- (N : Node_Id;
- Nam : Node_Id);
+ procedure Check_In_Previous_With_Clause (N, Nam : Node_Id);
-- N is a use_package clause and Nam the package name, or N is a use_type
-- clause and Nam is the prefix of the type name. In either case, verify
- -- that the package is visible at that point in the context: either it
+ -- that the package is visible at that point in the context: either it
-- appears in a previous with_clause, or because it is a fully qualified
-- name and the root ancestor appears in a previous with_clause.
@@ -4670,10 +4668,7 @@ package body Sem_Ch8 is
-- Check_In_Previous_With_Clause --
-----------------------------------
- procedure Check_In_Previous_With_Clause
- (N : Node_Id;
- Nam : Entity_Id)
- is
+ procedure Check_In_Previous_With_Clause (N, Nam : Node_Id) is
Pack : constant Entity_Id := Entity (Original_Node (Nam));
Item : Node_Id;
Par : Node_Id;
diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads
index e1664811f50..3d7b00ca557 100644
--- a/gcc/ada/sem_prag.ads
+++ b/gcc/ada/sem_prag.ads
@@ -429,7 +429,7 @@ package Sem_Prag is
function Get_Argument
(Prag : Node_Id;
- Context_Id : Node_Id := Empty) return Node_Id;
+ Context_Id : Entity_Id := Empty) return Node_Id;
-- Obtain the argument of pragma Prag depending on context and the nature
-- of the pragma. The argument is extracted in the following manner:
--
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index c16a4b80e21..4a98b8bf64e 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -24709,7 +24709,7 @@ package body Sem_Util is
-- Visit_Node --
----------------
- procedure Visit_Node (N : Node_Or_Entity_Id) is
+ procedure Visit_Node (N : Node_Id) is
begin
pragma Assert (Nkind (N) not in N_Entity);
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 7c89585137e..79db0b47c14 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -356,7 +356,7 @@ package Sem_Util is
-- carries the name of the reference discriminant.
function Build_Overriding_Spec
- (Op : Node_Id;
+ (Op : Entity_Id;
Typ : Entity_Id) return Node_Id;
-- Build a subprogram specification for the wrapper of an inherited
-- operation with a modified pre- or postcondition (See AI12-0113).
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-09-22 15:11 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-09-22 15:11 [gcc r12-3818] [Ada] Fix conformance errors and erroneous code Pierre-Marie de Rodat
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).