[gcc r16-290] analyzer: fix for older version of GCC
https://gcc.gnu.org/g:405fee9e1faf20f05b62e810ec1d6528100de067
commit r16-290-g405fee9e1faf20f05b62e810ec1d6528100de067
Author: Marc Poulhiès
Date: Tue Apr 29 19:53:42 2025 +0200
analyzer: fix for older version of GCC
Having both an enum and a variable with the same name triggers an error with
gcc 5.
exploded-graph.h:351:29: error: ‘status’ is not a class, namespace, or
enumeration
gcc/analyzer/ChangeLog:
* exploded-graph.h (set_status): Rename parameter.
* constraint-manager.cc (bound::ensure_closed): Likewise.
(range::add_bound): Likewise.
Signed-off-by: Marc Poulhiès
Reviewed-by: David Malcolm
Signed-off-by: Marc Poulhiès
Diff:
---
gcc/analyzer/constraint-manager.cc | 10 +-
gcc/analyzer/exploded-graph.h | 4 ++--
2 files changed, 7 insertions(+), 7 deletions(-)
diff --git a/gcc/analyzer/constraint-manager.cc
b/gcc/analyzer/constraint-manager.cc
index a3e682c49389..869e437d7c51 100644
--- a/gcc/analyzer/constraint-manager.cc
+++ b/gcc/analyzer/constraint-manager.cc
@@ -104,7 +104,7 @@ minus_one (tree cst)
closed one. */
void
-bound::ensure_closed (enum bound_kind bound_kind)
+bound::ensure_closed (enum bound_kind bnd_kind)
{
if (!m_closed)
{
@@ -113,7 +113,7 @@ bound::ensure_closed (enum bound_kind bound_kind)
and convert x < 5 into x <= 4. */
gcc_assert (CONSTANT_CLASS_P (m_constant));
gcc_assert (INTEGRAL_TYPE_P (TREE_TYPE (m_constant)));
- m_constant = fold_build2 (bound_kind == bound_kind::upper ? MINUS_EXPR :
PLUS_EXPR,
+ m_constant = fold_build2 (bnd_kind == bound_kind::upper ? MINUS_EXPR :
PLUS_EXPR,
TREE_TYPE (m_constant),
m_constant, integer_one_node);
gcc_assert (CONSTANT_CLASS_P (m_constant));
@@ -290,15 +290,15 @@ range::above_upper_bound (tree rhs_const) const
Return true if feasible; false if infeasible. */
bool
-range::add_bound (bound b, enum bound_kind bound_kind)
+range::add_bound (bound b, enum bound_kind bnd_kind)
{
/* Bail out on floating point constants. */
if (!INTEGRAL_TYPE_P (TREE_TYPE (b.m_constant)))
return true;
- b.ensure_closed (bound_kind);
+ b.ensure_closed (bnd_kind);
- switch (bound_kind)
+ switch (bnd_kind)
{
default:
gcc_unreachable ();
diff --git a/gcc/analyzer/exploded-graph.h b/gcc/analyzer/exploded-graph.h
index 32c72dc2076a..23e344d87e4a 100644
--- a/gcc/analyzer/exploded-graph.h
+++ b/gcc/analyzer/exploded-graph.h
@@ -346,10 +346,10 @@ class exploded_node : public dnode
void dump_succs_and_preds (FILE *outf) const;
enum status get_status () const { return m_status; }
- void set_status (enum status status)
+ void set_status (enum status s)
{
gcc_assert (m_status == status::worklist);
-m_status = status;
+m_status = s;
}
void add_diagnostic (const saved_diagnostic *sd)
[gcc r16-1233] ada: Constant_Indexing used when context requires a variable
https://gcc.gnu.org/g:84fc53174e6b21de0aadc8f776a4f1e4a1e4f361 commit r16-1233-g84fc53174e6b21de0aadc8f776a4f1e4a1e4f361 Author: Javier Miranda Date: Fri Jan 31 20:21:09 2025 + ada: Constant_Indexing used when context requires a variable In the case of an assignment where the type of its left hand side is an indexable container that has indexable container components (for example a container vector of container vectors), and both indexable containers have Constant_Indexing and Variable_Indexing aspects, the left hand side of the assignment is erroneously interpreted as constant indexing. The error results in spurious compile-time error messages saying that the left hand side of the assignment must be a variable. gcc/ada/ChangeLog: * sem_ch4.adb (Constant_Indexing_OK): Add missing support for RM 4.1.6(13/3), and improve performance to avoid climbing more than needed. Add documentation. (Try_Indexing_Function): New subprogram. (Expr_Matches_In_Formal): Added new formals. (Handle_Selected_Component): New subprogram. (Has_IN_Mode): New subprogram. (Try_Container_Indexing): Add documentation, code reorganization and extend its functionality to improve its support for prefixed notation calls. Diff: --- gcc/ada/sem_ch4.adb | 886 +++- 1 file changed, 667 insertions(+), 219 deletions(-) diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index f04ee84adc1e..9a1784fc492c 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -308,8 +308,12 @@ package body Sem_Ch4 is (N : Node_Id; Prefix : Node_Id; Exprs : List_Id) return Boolean; - -- AI05-0139: Generalized indexing to support iterators over containers - -- ??? Need to provide a more detailed spec of what this function does + -- AI05-0139: Generalized indexing to support iterators over containers. + -- Given the N_Indexed_Component node N, with the given prefix and + -- expressions list, check if the generalized indexing is applicable; + -- if applicable then build its indexing function, link it to N through + -- attribute Generalized_Indexing, and return True; otherwise return + -- False. function Try_Indexed_Call (N : Node_Id; @@ -8513,21 +8517,29 @@ package body Sem_Ch4 is Prefix : Node_Id; Exprs : List_Id) return Boolean is - Pref_Typ : Entity_Id := Etype (Prefix); + Heuristic : Boolean := False; + Pref_Typ : Entity_Id := Etype (Prefix); function Constant_Indexing_OK return Boolean; - -- Constant_Indexing is legal if there is no Variable_Indexing defined - -- for the type, or else node not a target of assignment, or an actual - -- for an IN OUT or OUT formal (RM 4.1.6 (11)). - - function Expr_Matches_In_Formal -(Subp : Entity_Id; - Par : Node_Id) return Boolean; - -- Find formal corresponding to given indexed component that is an - -- actual in a call. Note that the enclosing subprogram call has not - -- been analyzed yet, and the parameter list is not normalized, so - -- that if the argument is a parameter association we must match it - -- by name and not by position. + -- Determines whether the Constant_Indexing aspect has been specified + -- for the type of the prefix and can be interpreted as constant + -- indexing; that is, there is no Variable_Indexing defined for the + -- type, or else the node is not a target of an assignment, or an + -- actual for an IN OUT or OUT formal, or the name in an object + -- renaming (RM 4.1.6 (12/3..15/3)). + -- + -- Given that prefix notation calls have not yet been resolved, if the + -- type of the prefix has both aspects present (Constant_Indexing and + -- Variable_Indexing), and context analysis performed by this routine + -- identifies a potential prefix notation call (i.e., an N_Selected_ + -- Component node), this function may rely on heuristics to decide + -- between constant or variable indexing. In such cases, if the + -- decision is later found to be incorrect, Try_Container_Indexing + -- will retry using the alternative indexing aspect. + + -- When heuristics are used to compute the result of this function + -- the behavior of Try_Container_Indexing might not be strictly + -- following the rules of the RM. function Indexing_Interpretations (T : Entity_Id; @@ -8535,59 +8547,429 @@ package body Sem_Ch4 is -- Return a set of interpretations reflecting all of the functions -- associated with an indexing aspect of type T of the given kind. + function Try_Indexing_Function +(Func_Name : Node_Id; + Assoc : List_Id) return
[gcc r16-1224] ada: Tweak condition for name resolution failure
https://gcc.gnu.org/g:8727813200bf75c0f1ad22edd49c271a92831882
commit r16-1224-g8727813200bf75c0f1ad22edd49c271a92831882
Author: Ronan Desplanques
Date: Fri Feb 21 17:32:35 2025 +0100
ada: Tweak condition for name resolution failure
It is sometimes used as a convention across GNAT's code to set the Etype
field of a node to Any_Type to signal a name resolution error. This has
the potential to be confusing, which is why this patch replaces one such
use of the convention by a less convoluted check.
This only affects error recovery paths, and possibly doesn't change the
behavior of the compiler at all.
gcc/ada/ChangeLog:
* sem_ch4.adb (Analyze_Selected_Component): Tweak condition.
Diff:
---
gcc/ada/sem_ch4.adb | 5 +++--
1 file changed, 3 insertions(+), 2 deletions(-)
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 50b3eee0dbe5..d910d770ad3a 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -6040,9 +6040,10 @@ package body Sem_Ch4 is
Error_Msg_NE ("invalid prefix in selected component&", N, Sel);
end if;
- -- If N still has no type, the component is not defined in the prefix
+ -- If the selector is not labelled with an entity at this point, the
+ -- component is not defined in the prefix.
- if Etype (N) = Any_Type then
+ if No (Entity (Sel)) then
if Is_Single_Concurrent_Object then
Error_Msg_Node_2 := Entity (Pref);
[gcc r16-1235] ada: Deconstruct C header for the SCOs unit
https://gcc.gnu.org/g:82ece409b8be75a7d57c43efbeb28c166d981747
commit r16-1235-g82ece409b8be75a7d57c43efbeb28c166d981747
Author: Piotr Trojanek
Date: Wed Feb 26 18:00:57 2025 +0100
ada: Deconstruct C header for the SCOs unit
The C version of SCOs unit provided a gigi interface to source code
obligations
that at some point were generated by the frontend. This functionality has
been
deconstructed long ago.
gcc/ada/ChangeLog:
* libgnat/g-dyntab.ads (Instance): Update and extend comment.
* scos.ads: Remove comment about the corresponding C header.
* scos.h: Remove.
Diff:
---
gcc/ada/libgnat/g-dyntab.ads | 5 ++-
gcc/ada/scos.ads | 3 --
gcc/ada/scos.h | 89
3 files changed, 3 insertions(+), 94 deletions(-)
diff --git a/gcc/ada/libgnat/g-dyntab.ads b/gcc/ada/libgnat/g-dyntab.ads
index 7e2e3b22be4a..78109867ec26 100644
--- a/gcc/ada/libgnat/g-dyntab.ads
+++ b/gcc/ada/libgnat/g-dyntab.ads
@@ -168,8 +168,9 @@ package GNAT.Dynamic_Tables is
--
-- Tab : Table_Type renames X.Table (First .. X.Last);
--
- -- Note: The Table component must come first. See declarations of
- -- SCO_Unit_Table and SCO_Table in scos.h.
+ -- Note: The Table component must come first to simplify interfacing
+ -- with C, similar to how we do it for the Table unit; see declarations
+ -- of Names_Ptr and Names_Char_Ptr in namet.h.
Locked : Boolean := False;
-- Table reallocation is permitted only if this is False. A client may
diff --git a/gcc/ada/scos.ads b/gcc/ada/scos.ads
index a2ade8a0907a..b5f39c9632e3 100644
--- a/gcc/ada/scos.ads
+++ b/gcc/ada/scos.ads
@@ -28,9 +28,6 @@
-- the ALI file, and by Get_SCO/Put_SCO to read and write the text form that
-- is used in the ALI file.
--- WARNING: There is a C version of this package. Any changes to this
--- source file must be properly reflected in the C header file scos.h
-
with Namet; use Namet;
with Table;
with Types; use Types;
diff --git a/gcc/ada/scos.h b/gcc/ada/scos.h
deleted file mode 100644
index 3d800bf12b15..
--- a/gcc/ada/scos.h
+++ /dev/null
@@ -1,89 +0,0 @@
-/
- * *
- * GNAT COMPILER COMPONENTS *
- * *
- * S C O S *
- * *
- * C Header File *
- * *
- * Copyright (C) 2014-2025, 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- *
- * ware Foundation; either version 3, or (at your option) any later ver- *
- * sion. GNAT is distributed in the hope that it will be useful, but WITH- *
- * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
- * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
- * for more details. You should have received a copy of the GNU General *
- * Public License distributed with GNAT; see file COPYING3. If not, go to *
- * http://www.gnu.org/licenses for a complete copy of the license. *
- * *
- * GNAT was originally developed by the GNAT team at New York University. *
- * Extensive contributions were provided by Ada Core Technologies Inc. *
- * *
- /
-
-/* This is the C header that corresponds to the Ada package specification for
- Scos. It was created manually from scos.ads and must be kept synchronized
- with changes in this file. */
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-
-/* Unit table: */
-
-typedef Int SCO_Unit_Index;
-
-struct SCO_Unit_Table_Entry
- {
-String_Pointer File_Name;
-Int File_Index;
-Nat Dep_Num;
-Nat From, To;
- };
-
-typedef struct SCO_Unit_Table_Entry *SCO_Unit_Table_Type;
-
-extern SCO_Unit_Table_Type scos__sco_unit_table__table;
-#define SCO_Unit_Table scos__sco_unit_table__table
-
-extern Int scos__sco_unit_table__min;
-#define SCO_Unit_Table_Min scos__sco_unit_table__min
-
-extern Int scos__sco_unit_table__last_val;
-#define SCO_Unit_Table_Last_Val scos__sco_unit_table__last_val
-
-
-/* SCOs table: */
-
-struct So
[gcc r16-1241] ada: Add null exclusion to registration of floating-point types
https://gcc.gnu.org/g:9e349587dec0eed4f0183c7ddc7b7392612e5547 commit r16-1241-g9e349587dec0eed4f0183c7ddc7b7392612e5547 Author: Piotr Trojanek Date: Tue Feb 18 14:38:24 2025 +0100 ada: Add null exclusion to registration of floating-point types Null exclusion both clarifies the intention of the code and allows GNAT to eliminate runtime checks where possible (or make them fail where violated), at least in developer builds. Code cleanup. gcc/ada/ChangeLog: * get_targ.ads (Register_Proc_Type): Add null exclusion. Diff: --- gcc/ada/get_targ.ads | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gcc/ada/get_targ.ads b/gcc/ada/get_targ.ads index 35cf00d73a1a..4b658f10884f 100644 --- a/gcc/ada/get_targ.ads +++ b/gcc/ada/get_targ.ads @@ -113,7 +113,7 @@ package Get_Targ is type C_String is array (0 .. 255) of aliased Character; pragma Convention (C, C_String); - type Register_Type_Proc is access procedure + type Register_Type_Proc is not null access procedure (C_Name: C_String; -- Nul-terminated string with name of type Digs : Natural;-- Digits for floating point, 0 otherwise Complex : Boolean;-- True iff type has real and imaginary parts
[gcc r16-1209] ada: Move standard subtype declarations generation
https://gcc.gnu.org/g:903c0128c6442446df37038341747eacf02a64dc commit r16-1209-g903c0128c6442446df37038341747eacf02a64dc Author: Ronan Desplanques Date: Wed Feb 12 10:37:30 2025 +0100 ada: Move standard subtype declarations generation Before this patch, the subtype declarations for Standard.Natural and Standard.Positive were created before the entity for Standard.Integer was complete. In preparation of a future change that will make it impossible to call Etype on an incomplete node, this patch delays the creation of these subtype declarations. It doesn't affect the behavior of the compiler. gcc/ada/ChangeLog: * cstand.adb (Create_Standard): Delay declaration generation for Natural and Positive. Diff: --- gcc/ada/cstand.adb | 35 --- 1 file changed, 20 insertions(+), 15 deletions(-) diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index 41b0fec157fc..14c7496fa619 100644 --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -612,25 +612,14 @@ package body CStand is Set_Is_Pure (Standard_Standard); Set_Is_Compilation_Unit (Standard_Standard); - -- Create type/subtype declaration nodes for standard types + -- Create type declaration nodes for standard types for S in S_Types loop - - -- Subtype declaration case - - if S = S_Natural or else S = S_Positive then -Decl := New_Node (N_Subtype_Declaration, Stloc); -Set_Subtype_Indication (Decl, - New_Occurrence_Of (Standard_Integer, Stloc)); - - -- Full type declaration case - - else + if S not in S_Natural | S_Positive then Decl := New_Node (N_Full_Type_Declaration, Stloc); +Set_Defining_Identifier (Decl, Standard_Entity (S)); +Append (Decl, Decl_S); end if; - - Set_Defining_Identifier (Decl, Standard_Entity (S)); - Append (Decl, Decl_S); end loop; Create_Back_End_Float_Types; @@ -1021,6 +1010,14 @@ package body CStand is Hb => Intval (High_Bound (Scalar_Range (Standard_Integer; Set_Is_Constrained (Standard_Natural); + Append_To +(Decl_S, + Make_Subtype_Declaration + (Stloc, +Standard_Natural, +Subtype_Indication => + New_Occurrence_Of (Standard_Integer, Stloc))); + -- Setup entity for Positive Mutate_Ekind (Standard_Positive, E_Signed_Integer_Subtype); @@ -1038,6 +1035,14 @@ package body CStand is Hb => Intval (High_Bound (Scalar_Range (Standard_Integer; Set_Is_Constrained (Standard_Positive); + Append_To +(Decl_S, + Make_Subtype_Declaration + (Stloc, +Standard_Positive, +Subtype_Indication => + New_Occurrence_Of (Standard_Integer, Stloc))); + -- Create declaration for package ASCII Decl := New_Node (N_Package_Declaration, Stloc);
[gcc r16-1213] ada: Remove Size_Check_Code field from entities
https://gcc.gnu.org/g:3d8a56ced13c48f8ee156b1a6af6ba078401429d commit r16-1213-g3d8a56ced13c48f8ee156b1a6af6ba078401429d Author: Eric Botcazou Date: Thu Feb 13 12:07:37 2025 +0100 ada: Remove Size_Check_Code field from entities It has been unused for a very long time. gcc/ada/ChangeLog: * einfo.ads (Size_Check_Code): Delete. * gen_il-fields.ads (Opt_Field_Enum): Remove Size_Check_Code. * gen_il-gen-gen_entities.adb (Constant_Or_Variable_Kind): Likewise. * sem_ch13.adb (Analyze_Attribute_Definition_Clause): Remove call to Kill_Size_Check_Code. * sem_prag.adb (Analyze_Pragma): Likewise. * sem_util.ads (Kill_Size_Check_Code): Delete. * sem_util.adb (Kill_Size_Check_Code): Likewise. Diff: --- gcc/ada/einfo.ads | 7 --- gcc/ada/gen_il-fields.ads | 1 - gcc/ada/gen_il-gen-gen_entities.adb | 1 - gcc/ada/sem_ch13.adb| 5 - gcc/ada/sem_prag.adb| 3 --- gcc/ada/sem_util.adb| 14 -- gcc/ada/sem_util.ads| 6 -- 7 files changed, 37 deletions(-) diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 1fce2f98b8f9..7a7765d1272d 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -4388,11 +4388,6 @@ package Einfo is -- set, in which case this is the entity for the associated instance of -- System.Shared_Storage.Shared_Var_Procs. See Exp_Smem for full details. ---Size_Check_Code --- Defined in constants and variables. Normally Empty. Set if code is --- generated to check the size of the object. This field is used to --- suppress this code if a subsequent address clause is encountered. - --Size_Clause (synthesized) -- Applies to all entities. If a size or value size clause is present in -- the rep item chain for an entity then that attribute definition clause @@ -5316,7 +5311,6 @@ package Einfo is --Actual_Subtype --Renamed_Object --Renamed_Entity $$$ - --Size_Check_Code (constants only) --Prival_Link (privals only) --Interface_Name(constants only) --Related_Type (constants only) @@ -6202,7 +6196,6 @@ package Einfo is --Renamed_Object --Renamed_Entity $$$ --Discriminal_Link $$$ - --Size_Check_Code --Prival_Link --Interface_Name --Shared_Var_Procs_Instance diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads index fe6d3387cfa9..f957f7f64327 100644 --- a/gcc/ada/gen_il-fields.ads +++ b/gcc/ada/gen_il-fields.ads @@ -893,7 +893,6 @@ package Gen_IL.Fields is Scope_Depth_Value, Sec_Stack_Needed_For_Return, Shared_Var_Procs_Instance, - Size_Check_Code, Size_Depends_On_Discriminant, Size_Known_At_Compile_Time, Small_Value, diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb index 530af9085303..85ab62a0af73 100644 --- a/gcc/ada/gen_il-gen-gen_entities.adb +++ b/gcc/ada/gen_il-gen-gen_entities.adb @@ -357,7 +357,6 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Prival_Link, Node_Id), Sm (Related_Type, Node_Id), Sm (Return_Statement, Node_Id), -Sm (Size_Check_Code, Node_Id), Sm (SPARK_Pragma, Node_Id), Sm (SPARK_Pragma_Inherited, Flag))); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 69e18b049b99..de5716e6fd08 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -6278,11 +6278,6 @@ package body Sem_Ch13 is then Set_Check_Address_Alignment (N); end if; - - -- Kill the size check code, since we are not allocating - -- the variable, it is somewhere else. - - Kill_Size_Check_Code (U_Ent); end; -- Not a valid entity for an address clause diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index fafd27454d9e..b37a9ad06a54 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -10029,7 +10029,6 @@ package body Sem_Prag is end if; Def_Id := Entity (Def_Id); -Kill_Size_Check_Code (Def_Id); if Ekind (Def_Id) /= E_Constant then Note_Possible_Modification (Get_Pragma_Arg (Arg1), Sure => False); @@ -10042,7 +10041,6 @@ package body Sem_Prag is -- purposes of legality checks and removal of ignored Ghost code. Mark_Ghost_Pragma (N, Def_Id); -Kill_Size_Check_Code (Def_Id); if Ekind (Def_Id) /= E_Constant then Note_Possible_Modification (Get_Pragma_Arg (Arg2), Sure => False); @@ -19946,7 +19944,6 @@ package body Sem_Prag is -- o
[gcc r16-1207] ada: Fix internal error on allocator involving interface type
https://gcc.gnu.org/g:d575c1bc78f0a3b094cdf41542b8db5c7e364e08 commit r16-1207-gd575c1bc78f0a3b094cdf41542b8db5c7e364e08 Author: Eric Botcazou Date: Tue Feb 11 12:47:36 2025 +0100 ada: Fix internal error on allocator involving interface type The problem is that an itype duplicated through Duplicate_Subexpr_No_Checks ends up in a different scope than its source. It is fixed by adding a new formal parameter New_Scope to the function and forwarding it in the call to the New_Copy_Tree function. gcc/ada/ChangeLog: * exp_aggr.adb (Expand_Record_Aggregate): Use the named form for the second actual parameter in the call to Duplicate_Subexpr. * exp_attr.adb (Expand_Size_Attribute): Likewise. * exp_ch5.adb (Expand_Assign_Array): Likewise. (Expand_Assign_Array_Bitfield): Likewise. (Expand_Assign_Array_Bitfield_Fast): Likewise. * exp_util.ads (Duplicate_Subexpr): Add New_Scope formal parameter. (Duplicate_Subexpr_No_Checks): Likewise. (Duplicate_Subexpr_Move_Checks): Likewise. * exp_util.adb (Build_Allocate_Deallocate_Proc): Pass Proc_Id as the actual for New_Scope in the calls to Duplicate_Subexpr_No_Checks. (Duplicate_Subexpr): Add New_Scope formal parameter and forward it in the call to New_Copy_Tree. (Duplicate_Subexpr_No_Checks): Likewise. (Duplicate_Subexpr_Move_Checks): Likewise. Diff: --- gcc/ada/exp_aggr.adb | 3 ++- gcc/ada/exp_attr.adb | 4 ++-- gcc/ada/exp_ch5.adb | 24 +--- gcc/ada/exp_util.adb | 35 ++- gcc/ada/exp_util.ads | 18 -- 5 files changed, 51 insertions(+), 33 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index f2e7ad76e98f..8f1869cc7091 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -8077,7 +8077,8 @@ package body Exp_Aggr is Make_Selected_Component (Loc, Prefix=> Unchecked_Convert_To (Typ, - Duplicate_Subexpr (Parent_Expr, True)), + Duplicate_Subexpr + (Parent_Expr, Name_Req => True)), Selector_Name => New_Occurrence_Of (Comp, Loc)); Append_To (Comps, diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 4e0052e9ee41..455cc226bbfb 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -8602,10 +8602,10 @@ package body Exp_Attr is Rewrite (N, Make_Op_Multiply (Loc, Make_Attribute_Reference (Loc, - Prefix => Duplicate_Subexpr (Pref, True), + Prefix => Duplicate_Subexpr (Pref, Name_Req => True), Attribute_Name => Name_Length), Make_Attribute_Reference (Loc, - Prefix => Duplicate_Subexpr (Pref, True), + Prefix => Duplicate_Subexpr (Pref, Name_Req => True), Attribute_Name => Name_Component_Size))); Analyze_And_Resolve (N, Typ); end if; diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 06616eaf87d3..3d8a542c24e0 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -1039,7 +1039,8 @@ package body Exp_Ch5 is Prefix => Make_Indexed_Component (Loc, Prefix => - Duplicate_Subexpr_Move_Checks (Larray, True), + Duplicate_Subexpr_Move_Checks + (Larray, Name_Req => True), Expressions => New_List ( Make_Attribute_Reference (Loc, Prefix => @@ -1054,7 +1055,8 @@ package body Exp_Ch5 is Prefix => Make_Indexed_Component (Loc, Prefix => - Duplicate_Subexpr_Move_Checks (Rarray, True), + Duplicate_Subexpr_Move_Checks + (Rarray, Name_Req => True), Expressions => New_List ( Make_Attribute_Reference (Loc, Prefix => @@ -1396,7 +1398,7 @@ package body Exp_Ch5 is Prefix => Make_Indexed_Component (Loc, Prefix => -Duplicate_Subexpr (Larray, True), +Duplicate_Subexpr (Larray, Name_Req => True), Expressions => New_List (New_Copy_Tree (Left_Lo))), Attribute_Name => Name_Address); @@ -1405,7 +1407,7 @@ package body Exp_Ch5 is Prefix => Make_Indexed_Component (Loc,
[gcc r16-1208] ada: Remove useless calls
https://gcc.gnu.org/g:d5b0410adf21e24177150ac3a209770f46299494 commit r16-1208-gd5b0410adf21e24177150ac3a209770f46299494 Author: Ronan Desplanques Date: Wed Feb 12 10:34:06 2025 +0100 ada: Remove useless calls The subprogram calls this patch removes were useless because they were already made in New_Standard_Entity. gcc/ada/ChangeLog: * cstand.adb (Create_Standard): Remove useless calls. Diff: --- gcc/ada/cstand.adb | 2 -- 1 file changed, 2 deletions(-) diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index 5ba88b9ae1c9..41b0fec157fc 100644 --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -629,8 +629,6 @@ package body CStand is Decl := New_Node (N_Full_Type_Declaration, Stloc); end if; - Set_Is_Frozen (Standard_Entity (S)); - Set_Is_Public (Standard_Entity (S)); Set_Defining_Identifier (Decl, Standard_Entity (S)); Append (Decl, Decl_S); end loop;
[gcc r16-1214] ada: Remove dead code
https://gcc.gnu.org/g:fd87cba805163b6bf9936fbc22deb7995e2dc2c0 commit r16-1214-gfd87cba805163b6bf9936fbc22deb7995e2dc2c0 Author: Ronan Desplanques Date: Thu Feb 13 14:19:58 2025 +0100 ada: Remove dead code The code this patch removes is never executed on any of the available test suites. The patch that introduced it mentions that it fixes a test in particular, but that test passes anyway today. gcc/ada/ChangeLog: * sem_ch8.adb (Premature_Usage): Remove dead code. Diff: --- gcc/ada/sem_ch8.adb | 20 1 file changed, 20 deletions(-) diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 65d30967ae02..fe9328833df4 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -9922,28 +9922,8 @@ package body Sem_Ch8 is procedure Premature_Usage (N : Node_Id) is Kind : constant Node_Kind := Nkind (Parent (Entity (N))); - E: Entity_Id := Entity (N); begin - -- Within an instance, the analysis of the actual for a formal object - -- does not see the name of the object itself. This is significant only - -- if the object is an aggregate, where its analysis does not do any - -- name resolution on component associations. (see 4717-008). In such a - -- case, look for the visible homonym on the chain. - - if In_Instance and then Present (Homonym (E)) then - E := Homonym (E); - while Present (E) and then not In_Open_Scopes (Scope (E)) loop -E := Homonym (E); - end loop; - - if Present (E) then -Set_Entity (N, E); -Set_Etype (N, Etype (E)); -return; - end if; - end if; - case Kind is when N_Component_Declaration => Error_Msg_N
[gcc r16-1211] ada: Improve large unconstrained-but-definite warning
https://gcc.gnu.org/g:537453af7c83432f5bde527f035f9dbb43921fd3
commit r16-1211-g537453af7c83432f5bde527f035f9dbb43921fd3
Author: Ronan Desplanques
Date: Wed Feb 12 19:09:18 2025 +0100
ada: Improve large unconstrained-but-definite warning
Before this patch, Check_Discriminant_Use called Is_Limited type on
entities before they were fully analyzed. That caused Is_Limited_Type
to incorrectly return False for records that are limited because they
have a limited component.
This patch pushes back the emissions of the Check_Discriminant_Use
warning after analysis of record declarations. A new field to
E_Record_Type entity is added to take relevant discriminant uses into
account.
gcc/ada/ChangeLog:
* gen_il-fields.ads: New field.
* gen_il-gen-gen_entities.adb: New field.
* einfo.ads: Document new field.
* sem_res.adb (Check_Discriminant_Use): Record relevant uses in new
field. Move warning emission to...
* sem_ch3.adb (Analyze_Full_Type_Declaration): ... Here.
Diff:
---
gcc/ada/einfo.ads | 5 +
gcc/ada/gen_il-fields.ads | 1 +
gcc/ada/gen_il-gen-gen_entities.adb | 3 ++-
gcc/ada/sem_ch3.adb | 7 +++
gcc/ada/sem_res.adb | 16 +++-
5 files changed, 18 insertions(+), 14 deletions(-)
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index f154e7f0d763..1fce2f98b8f9 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2967,6 +2967,11 @@ package Einfo is
-- fully constructed, since it simply indicates the last state.
-- Thus this flag has no meaning to the backend.
+--Is_Large_Unconstrained_Definite
+-- Defined in record types. Used to detect types with default
+-- discriminant values that have exaggerated sizes and emit warnings
+-- about them.
+
--Is_Limited_Composite
-- Defined in all entities. Set for composite types that have a limited
-- component. Used to enforce the rule that operations on the composite
diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads
index c293e0fa63fb..fe6d3387cfa9 100644
--- a/gcc/ada/gen_il-fields.ads
+++ b/gcc/ada/gen_il-fields.ads
@@ -744,6 +744,7 @@ package Gen_IL.Fields is
Is_Known_Non_Null,
Is_Known_Null,
Is_Known_Valid,
+ Is_Large_Unconstrained_Definite,
Is_Limited_Composite,
Is_Limited_Interface,
Is_Limited_Record,
diff --git a/gcc/ada/gen_il-gen-gen_entities.adb
b/gcc/ada/gen_il-gen-gen_entities.adb
index 37ddd851d7c3..530af9085303 100644
--- a/gcc/ada/gen_il-gen-gen_entities.adb
+++ b/gcc/ada/gen_il-gen-gen_entities.adb
@@ -781,7 +781,8 @@ begin -- Gen_IL.Gen.Gen_Entities
Sm (No_Reordering, Flag, Impl_Base_Type_Only),
Sm (Parent_Subtype, Node_Id, Base_Type_Only),
Sm (Reverse_Bit_Order, Flag, Base_Type_Only),
-Sm (Underlying_Record_View, Node_Id)));
+Sm (Underlying_Record_View, Node_Id),
+Sm (Is_Large_Unconstrained_Definite, Flag, Impl_Base_Type_Only)));
Cc (E_Record_Subtype, Aggregate_Kind,
-- A record subtype, created by a record subtype declaration
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 47e7ede83e19..80359e5b68ee 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -3553,6 +3553,13 @@ package body Sem_Ch3 is
end;
end if;
end if;
+
+ if Ekind (T) = E_Record_Type
+and then Is_Large_Unconstrained_Definite (T)
+and then not Is_Limited_Type (T)
+ then
+ Error_Msg_N ("??creation of & object may raise Storage_Error!", T);
+ end if;
end Analyze_Full_Type_Declaration;
--
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 865f967a5b93..1ae72fab6629 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -757,14 +757,6 @@ package body Sem_Res is
goto No_Danger;
end if;
- -- If the enclosing type is limited, we allocate only the
- -- default value, not the maximum, and there is no need for
- -- a warning.
-
- if Is_Limited_Type (Scope (Disc)) then
- goto No_Danger;
- end if;
-
-- Check that it is the high bound
if N /= High_Bound (PN)
@@ -811,11 +803,9 @@ package body Sem_Res is
goto No_Danger;
end if;
- -- Warn about the danger
-
- Error_Msg_N
- ("??creation of & object may raise Storage_Error!",
- Scope (Disc));
+ if Ekind (Scope (Disc)) = E_Record_Type then
+ Set_Is_Large_Unconstrained_Definite (Scope (Disc));
+ end if;
<>
null;
[gcc r16-1219] ada: Implement use implies with experimental extension
https://gcc.gnu.org/g:994705cbe8658dc939160504e086409bd7a00a10
commit r16-1219-g994705cbe8658dc939160504e086409bd7a00a10
Author: squirek
Date: Tue Feb 18 10:54:01 2025 +
ada: Implement use implies with experimental extension
The patch implements the experimental feature to allow use package
clauses within the context area to imply with.
gcc/ada/ChangeLog:
* doc/gnat_rm/gnat_language_extensions.rst: Add documentation.
* gnat_rm.texi: Regenerate.
Diff:
---
gcc/ada/doc/gnat_rm/gnat_language_extensions.rst | 16 +++
gcc/ada/gnat_rm.texi | 133 +--
2 files changed, 92 insertions(+), 57 deletions(-)
diff --git a/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst
b/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst
index ee2df668eb1d..1713f56be3b8 100644
--- a/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst
+++ b/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst
@@ -657,6 +657,22 @@ An exception message can also be added:
when Imported_C_Func /= 0;
end;
+Implicit With
+-
+
+This feature allows a standalone ``use`` clause in the context clause of a
+compilation unit to imply an implicit ``with`` of the same library unit where
+an equivalent ``with`` clause would be allowed.
+
+.. code-block:: ada
+
+ use Ada.Text_IO;
+ procedure Main is
+ begin
+ Put_Line ("Hello");
+ end;
+
+
Storage Model
-
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 5719d0d3e62d..5ec090f2669a 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -916,6 +916,7 @@ Deep delta Aggregates
Experimental Language Extensions
* Conditional when constructs::
+* Implicit With::
* Storage Model::
* Attribute Super::
* Simpler Accessibility Model::
@@ -29896,6 +29897,7 @@ Features activated via @code{-gnatX0} or
@menu
* Conditional when constructs::
+* Implicit With::
* Storage Model::
* Attribute Super::
* Simpler Accessibility Model::
@@ -29909,7 +29911,7 @@ Features activated via @code{-gnatX0} or
@end menu
-@node Conditional when constructs,Storage Model,,Experimental Language
Extensions
+@node Conditional when constructs,Implicit With,,Experimental Language
Extensions
@anchor{gnat_rm/gnat_language_extensions
conditional-when-constructs}@anchor{455}
@subsection Conditional when constructs
@@ -29978,8 +29980,25 @@ begin
end;
@end example
-@node Storage Model,Attribute Super,Conditional when constructs,Experimental
Language Extensions
-@anchor{gnat_rm/gnat_language_extensions storage-model}@anchor{456}
+@node Implicit With,Storage Model,Conditional when constructs,Experimental
Language Extensions
+@anchor{gnat_rm/gnat_language_extensions implicit-with}@anchor{456}
+@subsection Implicit With
+
+
+This feature allows a standalone @code{use} clause in the context clause of a
+compilation unit to imply an implicit @code{with} of the same library unit
where
+an equivalent @code{with} clause would be allowed.
+
+@example
+use Ada.Text_IO;
+procedure Main is
+begin
+ Put_Line ("Hello");
+end;
+@end example
+
+@node Storage Model,Attribute Super,Implicit With,Experimental Language
Extensions
+@anchor{gnat_rm/gnat_language_extensions storage-model}@anchor{457}
@subsection Storage Model
@@ -29996,7 +30015,7 @@ memory models, in particular to support interactions
with GPU.
@end menu
@node Aspect Storage_Model_Type,Aspect Designated_Storage_Model,,Storage Model
-@anchor{gnat_rm/gnat_language_extensions aspect-storage-model-type}@anchor{457}
+@anchor{gnat_rm/gnat_language_extensions aspect-storage-model-type}@anchor{458}
@subsubsection Aspect Storage_Model_Type
@@ -30130,7 +30149,7 @@ end CUDA_Memory;
@end example
@node Aspect Designated_Storage_Model,Legacy Storage Pools,Aspect
Storage_Model_Type,Storage Model
-@anchor{gnat_rm/gnat_language_extensions
aspect-designated-storage-model}@anchor{458}
+@anchor{gnat_rm/gnat_language_extensions
aspect-designated-storage-model}@anchor{459}
@subsubsection Aspect Designated_Storage_Model
@@ -30208,7 +30227,7 @@ begin
@end example
@node Legacy Storage Pools,,Aspect Designated_Storage_Model,Storage Model
-@anchor{gnat_rm/gnat_language_extensions legacy-storage-pools}@anchor{459}
+@anchor{gnat_rm/gnat_language_extensions legacy-storage-pools}@anchor{45a}
@subsubsection Legacy Storage Pools
@@ -30259,7 +30278,7 @@ type Acc is access Integer_Array with Storage_Pool =>
My_Pool;
can still be accepted as a shortcut for the new syntax.
@node Attribute Super,Simpler Accessibility Model,Storage Model,Experimental
Language Extensions
-@anchor{gnat_rm/gnat_language_extensions attribute-super}@anchor{45a}
+@anchor{gnat_rm/gnat_language_extensions attribute-super}@anchor{45b}
@subsection Attribute Super
@@ -30294,7 +30313,7 @@ end;
@end example
@node Simpler Accessibility Model,Case pattern matching,Attribute
Super,Experimental Language Extensions
-@anc
[gcc r16-1220] ada: Initial prototype of constructors
https://gcc.gnu.org/g:ac2d8941f51d1280e1bf88274b1b4cf0c56e653b commit r16-1220-gac2d8941f51d1280e1bf88274b1b4cf0c56e653b Author: squirek Date: Thu Feb 20 13:12:58 2025 + ada: Initial prototype of constructors The patch implements the experimental constructors RFC. Currently a WIP. gcc/ada/ChangeLog: * aspects.ads: Add support for constructors. * exp_aggr.adb: Likewise. * exp_attr.adb: Likewise. * exp_ch3.adb: Likewise. * exp_ch4.adb: Likewise. * exp_util.adb: Likewise. * gen_il-fields.ads: Likewise. * gen_il-gen-gen_entities.adb: Likewise. * gen_il-gen-gen_nodes.adb: Likewise. * par-ch4.adb: Likewise. * sem_aggr.adb: Likewise. * sem_attr.adb, sem_attr.ads: Likewise. * sem_ch13.adb: Likewise. * sem_ch3.adb: Likewise. * sem_ch5.adb: Likewise. * sem_ch6.adb: Likewise. * sem_res.adb: Likewise. * sem_util.adb, sem_util.ads: Likewise. * snames.ads-tmpl: Likewise. Diff: --- gcc/ada/aspects.ads | 10 ++ gcc/ada/exp_aggr.adb| 9 +- gcc/ada/exp_attr.adb| 311 gcc/ada/exp_ch3.adb | 39 - gcc/ada/exp_ch4.adb | 9 ++ gcc/ada/exp_util.adb| 11 +- gcc/ada/gen_il-fields.ads | 4 + gcc/ada/gen_il-gen-gen_entities.adb | 3 + gcc/ada/gen_il-gen-gen_nodes.adb| 1 + gcc/ada/par-ch4.adb | 42 - gcc/ada/sem_aggr.adb| 24 +++ gcc/ada/sem_attr.adb| 134 +++- gcc/ada/sem_attr.ads| 6 + gcc/ada/sem_ch13.adb| 98 +++- gcc/ada/sem_ch3.adb | 8 + gcc/ada/sem_ch5.adb | 6 +- gcc/ada/sem_ch6.adb | 83 ++ gcc/ada/sem_res.adb | 2 + gcc/ada/sem_util.adb| 44 + gcc/ada/sem_util.ads| 7 + gcc/ada/snames.ads-tmpl | 3 + 21 files changed, 805 insertions(+), 49 deletions(-) diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index 70ea12023abb..9d44ed4dec34 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -81,6 +81,7 @@ package Aspects is Aspect_Bit_Order, Aspect_Component_Size, Aspect_Constant_Indexing, + Aspect_Constructor, -- GNAT Aspect_Contract_Cases,-- GNAT Aspect_Convention, Aspect_CPU, @@ -106,6 +107,7 @@ package Aspects is Aspect_GNAT_Annotate, -- GNAT Aspect_Implicit_Dereference, Aspect_Initial_Condition, -- GNAT + Aspect_Initialize,-- GNAT Aspect_Initializes, -- GNAT Aspect_Input, Aspect_Integer_Literal, @@ -428,6 +430,7 @@ package Aspects is Aspect_Bit_Order => Expression, Aspect_Component_Size => Expression, Aspect_Constant_Indexing => Name, + Aspect_Constructor=> Name, Aspect_Contract_Cases => Expression, Aspect_Convention => Name, Aspect_CPU=> Expression, @@ -453,6 +456,7 @@ package Aspects is Aspect_GNAT_Annotate => Expression, Aspect_Implicit_Dereference => Name, Aspect_Initial_Condition => Expression, + Aspect_Initialize => Expression, Aspect_Initializes=> Expression, Aspect_Input => Name, Aspect_Integer_Literal=> Name, @@ -529,6 +533,7 @@ package Aspects is Aspect_Component_Size => True, Aspect_Constant_Indexing=> False, Aspect_Contract_Cases => False, + Aspect_Constructor => False, Aspect_Convention => True, Aspect_CPU => False, Aspect_Default_Component_Value => True, @@ -556,6 +561,7 @@ package Aspects is Aspect_GNAT_Annotate=> False, Aspect_Implicit_Dereference => False, Aspect_Initial_Condition=> False, + Aspect_Initialize => False, Aspect_Initializes => False, Aspect_Input=> False, Aspect_Integer_Literal => False, @@ -698,6 +704,7 @@ package Aspects is Aspect_Constant_After_Elaboration => Name_Constant_After_Elaboration, Aspect_Constant_Indexing=> Name_Constant_Indexing, Aspect_Contract_Cases => Name_Contract_Cases, + Aspect_Constructor => Name_Constructor, Aspect_Convention
[gcc r16-1218] ada: Tweak definition of Modulus field of entities
https://gcc.gnu.org/g:df310aab0e1f56da10382a68ddd46d3fa0aa89a4 commit r16-1218-gdf310aab0e1f56da10382a68ddd46d3fa0aa89a4 Author: Eric Botcazou Date: Tue Feb 18 11:24:15 2025 +0100 ada: Tweak definition of Modulus field of entities The compiler may build modular integer subtypes whose base type is private in the context of instantiations, but we want to be able to get the Modulus. gcc/ada/ChangeLog: * einfo.ads (Modulus): Change to implementation base type only. * gen_il-gen-gen_entities.adb (Modular_Integer_Kind): Change type of Modulus field to Impl_Base_Type_Only. Diff: --- gcc/ada/einfo.ads | 2 +- gcc/ada/gen_il-gen-gen_entities.adb | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index c07de681045a..05ce8beca764 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -3626,7 +3626,7 @@ package Einfo is -- subprogram or the formal's Extra_Accessibility - whichever one is -- lesser. The Minimum_Accessibility field then points to this object. ---Modulus [base type only] +--Modulus [implementation base type only] -- Defined in modular types. Contains the modulus. For the binary case, -- this will be a power of 2, but if Non_Binary_Modulus is set, then it -- will not be a power of 2. diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb index 4548789383e2..2dc255c78c8a 100644 --- a/gcc/ada/gen_il-gen-gen_entities.adb +++ b/gcc/ada/gen_il-gen-gen_entities.adb @@ -572,7 +572,7 @@ begin -- Gen_IL.Gen.Gen_Entities -- created for the base type, and this is the first named subtype). Ab (Modular_Integer_Kind, Integer_Kind, - (Sm (Modulus, Uint, Base_Type_Only), + (Sm (Modulus, Uint, Impl_Base_Type_Only), Sm (Original_Array_Type, Node_Id))); Cc (E_Modular_Integer_Type, Modular_Integer_Kind);
[gcc r16-1217] ada: Restore Original_Access_Type field in E_Access_Subprogram_Type entities
https://gcc.gnu.org/g:573b0389e6fe46a328964c4cc705dfff63dcb611 commit r16-1217-g573b0389e6fe46a328964c4cc705dfff63dcb611 Author: Eric Botcazou Date: Mon Feb 17 10:29:48 2025 +0100 ada: Restore Original_Access_Type field in E_Access_Subprogram_Type entities It is used by CodePeer to recognize the special access pattern. gcc/ada/ChangeLog: * einfo.ads (Original_Access_Type): Restore. * gen_il-fields.ads (Opt_Field_Enum): Restore Original_Access_Type. * gen_il-gen-gen_entities.adb: Adjust accordingly. * exp_ch9.adb (Expand_Access_Protected_Subprogram_Type): Restore the call to Set_Original_Access_Type. Diff: --- gcc/ada/einfo.ads | 7 +++ gcc/ada/exp_ch9.adb | 6 ++ gcc/ada/gen_il-fields.ads | 1 + gcc/ada/gen_il-gen-gen_entities.adb | 3 ++- 4 files changed, 16 insertions(+), 1 deletion(-) diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 152a8b296a0f..c07de681045a 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -3883,6 +3883,12 @@ package Einfo is -- Optimize_Alignment (Off) mode applies to the type/object, then neither -- of the flags Optimize_Alignment_Space/Optimize_Alignment_Time is set. +--Original_Access_Type +-- Defined in E_Access_Subprogram_Type entities. Set only if the access +-- type was generated by the expander as part of processing an access- +-- to-protected-subprogram type. Points to the access-to-protected- +-- subprogram type. Read by CodePeer. + --Original_Array_Type -- Defined in modular types and array types and subtypes. Set only if -- the Is_Packed_Array_Impl_Type flag is set, indicating that the type @@ -5122,6 +5128,7 @@ package Einfo is -- E_Access_Subprogram_Type --Equivalent_Type (remote types only) --Directly_Designated_Type + --Original_Access_Type --Needs_No_Actuals --Can_Use_Internal_Rep --Associated_Storage_Pool $$$ diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 39ad2b10846b..ff5668e08c4c 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -5746,6 +5746,12 @@ package body Exp_Ch9 is Insert_Before_And_Analyze (N, Decl1); + -- Associate the access to subprogram with its original access to + -- protected subprogram type. Needed by CodePeer to know that this + -- type corresponds with an access to protected subprogram type. + + Set_Original_Access_Type (D_T2, T); + -- Create Equivalent_Type, a record with two components for an access to -- object and an access to subprogram. diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads index 0092a5728c66..f664449ed966 100644 --- a/gcc/ada/gen_il-fields.ads +++ b/gcc/ada/gen_il-fields.ads @@ -839,6 +839,7 @@ package Gen_IL.Fields is OK_To_Rename, Optimize_Alignment_Space, Optimize_Alignment_Time, + Original_Access_Type, Original_Array_Type, Original_Protected_Subprogram, Original_Record_Component, diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb index 86e3f39f6d38..4548789383e2 100644 --- a/gcc/ada/gen_il-gen-gen_entities.adb +++ b/gcc/ada/gen_il-gen-gen_entities.adb @@ -677,7 +677,8 @@ begin -- Gen_IL.Gen.Gen_Entities Cc (E_Access_Subprogram_Type, Access_Subprogram_Kind, -- An access-to-subprogram type, created by an access-to-subprogram -- declaration. - (Sm (Equivalent_Type, Node_Id))); + (Sm (Equivalent_Type, Node_Id), +Sm (Original_Access_Type, Node_Id))); Ab (Access_Protected_Kind, Access_Subprogram_Kind, (Sm (Equivalent_Type, Node_Id)));
[gcc r16-1216] ada: Remove more unused fields from entities
https://gcc.gnu.org/g:64bb8c8b59f98ff0faa1b61f54ffbd18dd8304c5 commit r16-1216-g64bb8c8b59f98ff0faa1b61f54ffbd18dd8304c5 Author: Eric Botcazou Date: Fri Feb 14 12:31:33 2025 +0100 ada: Remove more unused fields from entities This removes 5 more unused fields from entities, as well as 1 flag. gcc/ada/ChangeLog: * einfo.ads (Default_Expr_Function): Delete. (Dependent_Instances): Likewise. (Handler_Records): Likewise. (Needs_Activation_Record): Likewise. (Original_Access_Type): Likewise. (Register_Exception_Call): Likewise. * sinfo.ads (Accept_Handler_Records): Likewise. * gen_il-fields.ads (Opt_Field_Enum): Remove Accept_Handler_Records, Default_Expr_Function, Dependent_Instances, Handler_Records, Needs_Activation_Record, Original_Access_Type and Register_Exception_Call. * gen_il-gen-gen_entities.adb: Adjust accordingly. * gen_il-gen-gen_nodes.adb: Likewise. * exp_ch9.adb (Expand_Access_Protected_Subprogram_Type): Remove call to Set_Original_Access_Type. (Expand_N_Selective_Accept): Remove call to Set_Handler_Records. * exp_ch11.adb (Expand_N_Exception_Declaration): Remove call to Set_Register_Exception_Call. * sem_ch3.adb (Access_Subprogram_Declaration): Remove call to Set_Needs_Activation_Record. * sem_ch12.adb (Instantiate_Package_Body): Remove call to Set_Handler_Records. Diff: --- gcc/ada/einfo.ads | 47 - gcc/ada/exp_ch11.adb| 2 -- gcc/ada/exp_ch9.adb | 14 --- gcc/ada/gen_il-fields.ads | 7 -- gcc/ada/gen_il-gen-gen_entities.adb | 13 +- gcc/ada/gen_il-gen-gen_nodes.adb| 3 +-- gcc/ada/sem_ch12.adb| 4 gcc/ada/sem_ch3.adb | 8 --- gcc/ada/sinfo.ads | 9 --- 9 files changed, 2 insertions(+), 105 deletions(-) diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 7a7765d1272d..152a8b296a0f 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -832,12 +832,6 @@ package Einfo is -- Default_Value aspect specification for the type, or inherited -- on derivation. ---Default_Expr_Function --- Defined in parameters. It holds the entity of the parameterless --- function that is built to evaluate the default expression if it is --- more complex than a simple identifier or literal. For the latter --- simple cases or if there is no default value, this field is Empty. - --Default_Expressions_Processed -- A flag in subprograms (functions, operators, procedures) and in -- entries and entry families used to indicate that default expressions @@ -864,12 +858,6 @@ package Einfo is -- that holds value of delta for the type, as given in the declaration -- or as inherited by a subtype or derived type. ---Dependent_Instances --- Defined in packages that are instances. Holds list of instances --- of inner generics. Used to place freeze nodes for those instances --- after that of the current one, i.e. after the corresponding generic --- bodies. - --Depends_On_Private -- Defined in all type entities. Set if the type is private or if it -- depends on a private type. @@ -1462,11 +1450,6 @@ package Einfo is -- associates generic parameters with the corresponding instances, in -- those cases where the instance is an entity. ---Handler_Records --- Defined in subprogram and package entities. Points to a list of --- identifiers referencing the handler record entities for the --- corresponding unit. - --Has_Aliased_Components [implementation base type only] -- Defined in array type entities. Indicates that the component type -- of the array is aliased. Should this also be set for records to @@ -3663,11 +3646,6 @@ package Einfo is -- preelaborable initialization at freeze time (this has to be deferred -- to the freeze point because of the rule about overriding Initialize). ---Needs_Activation_Record --- Defined on generated subprogram types. Indicates that a call through --- a named or anonymous access to subprogram requires an activation --- record when compiling with unnesting for C or LLVM. - --Needs_Debug_Info -- Defined in all entities. Set if the entity requires normal debugging -- information to be generated. This is true of all entities that have @@ -3905,12 +3883,6 @@ package Einfo is -- Optimize_Alignment (Off) mode applies to the type/object, then neither -- of the flags Optimize_Alignment_Space/Optimize_Alignment_Time is set. ---Original_Access_Type --- Defined in E_Access_Subpr
[gcc r16-1212] ada: Allow IN OUT parameters for first parameter of traversal functions
https://gcc.gnu.org/g:8abecb35be8fd6790e9b7ec7c28cfee075d9c9e5
commit r16-1212-g8abecb35be8fd6790e9b7ec7c28cfee075d9c9e5
Author: Claire Dross
Date: Wed Feb 12 12:10:20 2025 +0100
ada: Allow IN OUT parameters for first parameter of traversal functions
In general, functions in SPARK cannot have parameters of mode IN OUT
unless they are annotated with the Side_Effects aspect. Borrowing
traversal functions are special functions which can return a part
of their first parameter as an access-to-variable type. This might not
be allowed in Ada if the parameter is a constant. Allow the first
parameter of borrowing traversal functions to have mode IN OUT.
gcc/ada/ChangeLog:
* sem_ch6.adb (Analyze_SPARK_Subprogram_Specification):
Allow the first parameter of functions whose return type is
an anonymous access-to-variable type to have mode IN OUT.
Diff:
---
gcc/ada/sem_ch6.adb | 17 +
1 file changed, 17 insertions(+)
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index d4e6d1693263..dcbcc608f839 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2275,6 +2275,23 @@ package body Sem_Ch6 is
end if;
Formal := First_Formal (Spec_Id);
+
+ -- The first parameter of a borrowing traversal function might be an IN
+ -- or an IN OUT parameter.
+
+ if Present (Formal)
+and then Ekind (Etype (Spec_Id)) = E_Anonymous_Access_Type
+and then not Is_Access_Constant (Etype (Spec_Id))
+ then
+ if Ekind (Formal) = E_Out_Parameter then
+Error_Msg_Code := GEC_Out_Parameter_In_Function;
+Error_Msg_N
+ ("first parameter of traversal function cannot have mode `OUT` "
+ & "in SPARK '[[]']", Formal);
+ end if;
+ Next_Formal (Formal);
+ end if;
+
while Present (Formal) loop
if Ekind (Spec_Id) in E_Function | E_Generic_Function
and then not Is_Function_With_Side_Effects (Spec_Id)
[gcc r16-1221] ada: Move Incomplete_View from node to entity field
https://gcc.gnu.org/g:a90094505584cae5d3c813bf955b194d60785e87 commit r16-1221-ga90094505584cae5d3c813bf955b194d60785e87 Author: Piotr Trojanek Date: Wed Feb 19 16:32:43 2025 +0100 ada: Move Incomplete_View from node to entity field The Incomplete_View property of a type was attached to its full type declaration as a semantic field, but retrieving it from there required low-level tree navigation and caused code duplication. In one case we relied on internal class-wide type being attached to the corresponding full type declaration, which is an undocumented assumption. It seems better to attach this field to entities, just like we do with Full_View and many other type properties. Ideally, this field should be present just in type entities, but currently we set it before setting the proper entity kind. Behavior is unaffected. This is rather a code cleanup, originating from the need to use Incomplete_View in GNATprove. gcc/ada/ChangeLog: * einfo.ads (Incomplete_View): Move from Sinfo; adapt wording. * exp_ch3.adb (Build_Record_Init_Proc): Adapt retrieval of Incomplete_View. * gen_il-fields.ads (Opt_Field_Enum): Move Incomplete_View from node to entity field. * gen_il-gen-gen_entities.adb (Gen_Entities): Add field. * gen_il-gen-gen_nodes.adb (Gen_Nodes): Remove field. * sem_ch3.adb (Analyze_Full_Type_Declaration, Check_Anonymous_Access_Component): Adapt setting of Incomplete_View. * sem_ch6.adb (Analyze_Subprogram_Body_Helper): Adapt retrieval of Incomplete_View for class-wide types; no longer rely on class-wide type being attached to non-classwide type declaration. * sem_util.adb (Collect_Primitive_Operations): Adapt retrieval of Incomplete_View. * sinfo.ads (Incomplete_View): Move to Einfo. Diff: --- gcc/ada/einfo.ads | 5 + gcc/ada/exp_ch3.adb | 6 ++ gcc/ada/gen_il-fields.ads | 2 +- gcc/ada/gen_il-gen-gen_entities.adb | 1 + gcc/ada/gen_il-gen-gen_nodes.adb| 3 +-- gcc/ada/sem_ch3.adb | 4 ++-- gcc/ada/sem_ch6.adb | 6 ++ gcc/ada/sem_util.adb| 6 ++ gcc/ada/sinfo.ads | 5 - 9 files changed, 16 insertions(+), 22 deletions(-) diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 05ce8beca764..545c15de24a2 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2245,6 +2245,11 @@ package Einfo is -- is relocated to the corresponding package body, which must have a -- corresponding nonlimited with_clause. +--Incomplete_View +-- Defined in all entities. Present in those that are completions of +-- incomplete types. Denotes the corresponding incomplete view declared +-- by the incomplete declaration. + --Indirect_Call_Wrapper -- Defined on subprogram entities. Set if the subprogram has class-wide -- preconditions. Denotes the internal wrapper that checks preconditions diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index c11e74b9fd87..d884e755d66b 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -2652,11 +2652,9 @@ package body Exp_Ch3 is -- may have an incomplete type. In that case, it must also be -- replaced by the formal of the Init_Proc. - if Nkind (Parent (Rec_Type)) = N_Full_Type_Declaration - and then Present (Incomplete_View (Parent (Rec_Type))) - then + if Present (Incomplete_View (Rec_Type)) then Append_Elmt ( -N => Incomplete_View (Parent (Rec_Type)), +N => Incomplete_View (Rec_Type), To => Map); Append_Elmt ( N => Defining_Identifier diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads index 2780dc7acc14..9871035416d1 100644 --- a/gcc/ada/gen_il-fields.ads +++ b/gcc/ada/gen_il-fields.ads @@ -229,7 +229,6 @@ package Gen_IL.Fields is Import_Interface_Present, In_Present, Includes_Infinities, - Incomplete_View, Inherited_Discriminant, Instance_Spec, Intval, @@ -658,6 +657,7 @@ package Gen_IL.Fields is Ignore_SPARK_Mode_Pragmas, Import_Pragma, Incomplete_Actuals, + Incomplete_View, Indirect_Call_Wrapper, In_Package_Body, In_Private_Part, diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb index d653107a6996..bfa634f8a692 100644 --- a/gcc/ada/gen_il-gen-gen_entities.adb +++ b/gcc/ada/gen_il-gen-gen_entities.adb @@ -114,6 +114,7 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Has_Xref_Entry, Flag), Sm (Has_Yield_Aspect, Flag), Sm (Homonym, Node_Id), +S
[gcc r16-1215] ada: Incorrect unresolved operator name in an instantiation
https://gcc.gnu.org/g:5f3113d79d55820f041fc7d1d6ce38598c6c3a35 commit r16-1215-g5f3113d79d55820f041fc7d1d6ce38598c6c3a35 Author: Steve Baird Date: Fri Feb 7 12:29:46 2025 -0800 ada: Incorrect unresolved operator name in an instantiation In some cases, a generic containing a use of a unary operator successfully compiles but the compiler incorrectly rejects the corresponding use in an instantiation. gcc/ada/ChangeLog: * sem_ch4.adb (Find_Unary_Types): Because we reanalyze names in an instance, we sometimes have to take steps to filter out extraneous name resolution candidates that happen to be visible at the point of the instance declaration. Remove some code that appears to have been written with this in mind. This is done for two reasons. First, the code sometimes doesn't work (possibly because the In_Instance test is not specific enough - it probably should be testing to see whether we are in an instance of the particular generic in which the result of calling Corresponding_Generic_Type was declared) and causes correct code to be rejected. Second, the code seems to no longer be necessary (possibly because of subsequent fixes in this area which are not specific to unary operators). Diff: --- gcc/ada/sem_ch4.adb | 25 ++--- 1 file changed, 2 insertions(+), 23 deletions(-) diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 406983995f3d..50b3eee0dbe5 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -7642,35 +7642,14 @@ package body Sem_Ch4 is begin if not Is_Overloaded (R) then if Is_Numeric_Type (Etype (R)) then - --- In an instance a generic actual may be a numeric type even if --- the formal in the generic unit was not. In that case, the --- predefined operator was not a possible interpretation in the --- generic, and cannot be one in the instance, unless the operator --- is an actual of an instance. - -if In_Instance - and then -not Is_Numeric_Type (Corresponding_Generic_Type (Etype (R))) -then - null; -else - Add_One_Interp (N, Op_Id, Base_Type (Etype (R))); -end if; +Add_One_Interp (N, Op_Id, Base_Type (Etype (R))); end if; else Get_First_Interp (R, Index, It); while Present (It.Typ) loop if Is_Numeric_Type (It.Typ) then - if In_Instance - and then - not Is_Numeric_Type - (Corresponding_Generic_Type (Etype (It.Typ))) - then - null; - - elsif Is_Effectively_Visible_Operator (N, Base_Type (It.Typ)) + if Is_Effectively_Visible_Operator (N, Base_Type (It.Typ)) then Add_One_Interp (N, Op_Id, Base_Type (It.Typ)); end if;
[gcc r16-1222] ada: Convert floating-point zero to machine representation
https://gcc.gnu.org/g:032e2209fff5573ee018fb78ed4c238c5fac4226 commit r16-1222-g032e2209fff5573ee018fb78ed4c238c5fac4226 Author: Piotr Trojanek Date: Thu Feb 20 19:25:02 2025 +0100 ada: Convert floating-point zero to machine representation When statically evaluating floating-point expressions we convert the final result to machine number. However, we skipped this conversion if the result was zero. This inconsistency was introduced when adding a warning for compile-time evaluation that gives different result from a run-time evaluation, but left when this warning was deconstructed. It causes a crash in GNATprove, which expects all floating-point numbers in the GNAT AST to be in a machine representation form. gcc/ada/ChangeLog: * sem_eval.adb (Check_Non_Static_Context): Remove special handling of floating-point zero. Diff: --- gcc/ada/sem_eval.adb | 8 +++- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 5d1506364956..f5cd0449d617 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -574,13 +574,11 @@ package body Sem_Eval is Rewrite (N, New_Copy (N)); - if not Is_Floating_Point_Type (T) then -Set_Realval - (N, Corresponding_Integer_Value (N) * Small_Value (T)); - - elsif not UR_Is_Zero (Realval (N)) then + if Is_Floating_Point_Type (T) then Set_Realval (N, Machine_Number (Base_Type (T), Realval (N), N)); Set_Is_Machine_Number (N); + else +Set_Realval (N, Corresponding_Integer_Value (N) * Small_Value (T)); end if; end if;
[gcc r16-1228] ada: Document representation clauses previously required by ASIS
https://gcc.gnu.org/g:da377160f648ff09f8df1a5200d14106bf62b2d1 commit r16-1228-gda377160f648ff09f8df1a5200d14106bf62b2d1 Author: Piotr Trojanek Date: Tue Feb 25 12:48:32 2025 +0100 ada: Document representation clauses previously required by ASIS A record type used for name identifiers had representation clause to make sure that table with identifiers is written to an ASIS file without holes. Now ASIS mode has been deconstructed, but we still want this representation clause to ensure efficient implementation. Comment update; behavior is unaffected. gcc/ada/ChangeLog: * namet.ads (Name_Entry): Update comments to explain the current needs. Diff: --- gcc/ada/namet.ads | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads index daa87d91caa6..7182fb87e7ec 100644 --- a/gcc/ada/namet.ads +++ b/gcc/ada/namet.ads @@ -609,6 +609,7 @@ private -- Int Value associated with this name end record; + -- The aliased non-boolean components are required to match the C structure for Name_Entry use record Name_Chars_Index at 0 range 0 .. 31; @@ -622,9 +623,10 @@ private Hash_Link at 8 range 0 .. 31; Int_Info at 12 range 0 .. 31; end record; + -- This ensures a matching layout between Ada and C for Name_Entry'Size use 16 * 8; - -- This ensures that we did not leave out any fields + -- This ensures that record is reasonably small -- This is the table that is referenced by Valid_Name_Id entries. -- It contains one entry for each unique name in the table.
[gcc r16-1223] ada: Fix wrong initialization of library-level object by conditional expression
https://gcc.gnu.org/g:f6d20900a2f358b007cfd47636bfb696aeab0d4c commit r16-1223-gf6d20900a2f358b007cfd47636bfb696aeab0d4c Author: Eric Botcazou Date: Fri Feb 21 10:03:22 2025 +0100 ada: Fix wrong initialization of library-level object by conditional expression At library level the object must be allocated statically and with its bounds when its nominal subtype is an unconstrained array type. gcc/ada/ChangeLog: * exp_ch4.adb (Insert_Conditional_Object_Declaration): Make sure the object is allocated properly by the code generator at library level. Diff: --- gcc/ada/exp_ch4.adb | 9 - 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 88e5f360bbfa..01be3dff89bc 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -13301,10 +13301,12 @@ package body Exp_Ch4 is Obj_Decl : constant Node_Id := Make_Object_Declaration (Loc, Defining_Identifier => Obj_Id, - Aliased_Present => Aliased_Present (Decl), + Aliased_Present => True, Constant_Present=> Constant_Present (Decl), Object_Definition => New_Copy_Tree (Object_Definition (Decl)), Expression => Relocate_Node (Expr)); + -- We make the object unconditionally aliased to avoid dangling bound + -- issues when its nominal subtype is an unconstrained array type. Master_Node_Decl : Node_Id; Master_Node_Id : Entity_Id; @@ -13319,6 +13321,11 @@ package body Exp_Ch4 is Insert_Action (Expr, Obj_Decl); + -- The object can never be local to an elaboration routine at library + -- level since we will take 'Unrestricted_Access of it. + + Set_Is_Statically_Allocated (Obj_Id, Is_Library_Level_Entity (Obj_Id)); + -- If the object needs finalization, we need to insert its Master_Node -- manually because 1) the machinery in Exp_Ch7 will not pick it since -- it will be declared in the arm of a conditional statement and 2) we
[gcc r16-1225] ada: Fix libgpr2 build failure with compiler built with assertions
https://gcc.gnu.org/g:c29774a1f35eb46c969b84af31a362bbd5d8855d commit r16-1225-gc29774a1f35eb46c969b84af31a362bbd5d8855d Author: Eric Botcazou Date: Mon Feb 24 22:27:21 2025 +0100 ada: Fix libgpr2 build failure with compiler built with assertions The problem is that the Entity field is accessed for a node without one. gcc/ada/ChangeLog: * sem_ch10.adb (Install_Siblings.In_Context): Add missing guard. Diff: --- gcc/ada/sem_ch10.adb | 2 ++ 1 file changed, 2 insertions(+) diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 9af96fc41b6b..25bba9b60759 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -4924,6 +4924,8 @@ package body Sem_Ch10 is if Entity (Name (Clause)) = Id or else (Nkind (Name (Clause)) = N_Expanded_Name + and then + Is_Entity_Name (Prefix (Name (Clause))) and then Entity (Prefix (Name (Clause))) = Id) then return True;
[gcc r16-1210] ada: Do not generate warning about missing overriding indicator
https://gcc.gnu.org/g:939d23d1c8966c453a03e216135cb968e9db1761
commit r16-1210-g939d23d1c8966c453a03e216135cb968e9db1761
Author: Steve Baird
Date: Wed Feb 5 17:35:16 2025 -0800
ada: Do not generate warning about missing overriding indicator
We were previously generating a warning about a missing overriding
indicator in some cases when a dispatching subprogram is declared.
In at least some (and perhaps all) cases where this warning was generated,
it was incorrect. It was also generated very infrequently. The simple
solution is to stop generating the warning.
gcc/ada/ChangeLog:
* sem_disp.adb
(Check_Dispatching_Operation): Delete code to generate
"missing overriding indicator" warning. Update comments.
Diff:
---
gcc/ada/sem_disp.adb | 20 +---
1 file changed, 5 insertions(+), 15 deletions(-)
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 4881d6f2f8b3..d13367659ac2 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -80,7 +80,7 @@ package body Sem_Disp is
-- parameter); otherwise returns empty.
function Find_Hidden_Overridden_Primitive (S : Entity_Id) return Entity_Id;
- -- [Ada 2012:AI-0125] Find an inherited hidden primitive of the dispatching
+ -- [AI05-0125] Find an inherited hidden primitive of the dispatching
-- type of S that has the same name of S, a type-conformant profile, an
-- original corresponding operation O that is a primitive of a visible
-- ancestor of the dispatching type of S and O is visible at the point of
@@ -91,7 +91,8 @@ package body Sem_Disp is
-- This routine does not search for non-hidden primitives since they are
-- covered by the normal Ada 2005 rules. Its name was motivated by an
-- intermediate version of AI05-0125 where this term was proposed to
- -- name these entities in the RM.
+ -- name these entities in the RM. FWIW, note that AI05-0125 was
+ -- not approved; it was voted "No Action".
function Is_Inherited_Public_Operation (Op : Entity_Id) return Boolean;
-- Check whether a primitive operation is inherited from an operation
@@ -1710,9 +1711,8 @@ package body Sem_Disp is
Ovr_Subp := Old_Subp;
- -- [Ada 2012:AI-0125]: Search for inherited hidden primitive that may be
- -- overridden by Subp. This only applies to source subprograms, and
- -- their declaration must carry an explicit overriding indicator.
+ -- Search for inherited hidden primitive that may be
+ -- overridden by Subp. This only applies to source subprograms.
if No (Ovr_Subp)
and then Ada_Version >= Ada_2012
@@ -1721,16 +1721,6 @@ package body Sem_Disp is
Nkind (Unit_Declaration_Node (Subp)) = N_Subprogram_Declaration
then
Ovr_Subp := Find_Hidden_Overridden_Primitive (Subp);
-
- -- Warn if the proper overriding indicator has not been supplied.
-
- if Present (Ovr_Subp)
- and then
- not Must_Override (Specification (Unit_Declaration_Node (Subp)))
- and then not In_Instance
- then
-Error_Msg_NE ("missing overriding indicator for&??", Subp, Subp);
- end if;
end if;
-- Now it should be a correct primitive operation, put it in the list
[gcc r16-1226] ada: Fix typo in documentation about convention and representation
https://gcc.gnu.org/g:daa245bc566835d162c0bcf323ead2effa9e2ecb
commit r16-1226-gdaa245bc566835d162c0bcf323ead2effa9e2ecb
Author: Piotr Trojanek
Date: Tue Feb 25 13:02:38 2025 +0100
ada: Fix typo in documentation about convention and representation
Currently there are only three exceptions to the general rule; the fourth
exception applied to OpenVMS, whose support has been deconstructed.
gcc/ada/ChangeLog:
* doc/gnat_rm/representation_clauses_and_pragmas.rst
(Effect of Convention on Representation): Fix number of list items.
* gnat_rm.texi: Regenerate.
* gnat_ugn.texi: Regenerate.
Diff:
---
gcc/ada/doc/gnat_rm/representation_clauses_and_pragmas.rst | 2 +-
gcc/ada/gnat_rm.texi | 2 +-
gcc/ada/gnat_ugn.texi | 2 +-
3 files changed, 3 insertions(+), 3 deletions(-)
diff --git a/gcc/ada/doc/gnat_rm/representation_clauses_and_pragmas.rst
b/gcc/ada/doc/gnat_rm/representation_clauses_and_pragmas.rst
index b0e131fe4abb..7250f6586ee1 100644
--- a/gcc/ada/doc/gnat_rm/representation_clauses_and_pragmas.rst
+++ b/gcc/ada/doc/gnat_rm/representation_clauses_and_pragmas.rst
@@ -1872,7 +1872,7 @@ conventions, and for example records are laid out in a
manner that is
consistent with C. This means that specifying convention C (for example)
has no effect.
-There are four exceptions to this general rule:
+There are three exceptions to this general rule:
* *Convention Fortran and array subtypes*.
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 5ec090f2669a..5b2a9157c059 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -20717,7 +20717,7 @@ conventions, and for example records are laid out in a
manner that is
consistent with C. This means that specifying convention C (for example)
has no effect.
-There are four exceptions to this general rule:
+There are three exceptions to this general rule:
@itemize *
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 5331a318c0d8..ca1d7bcc1abf 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -29833,8 +29833,8 @@ to permit their use in free software.
@printindex ge
-@anchor{d2}@w{ }
@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{
}
+@anchor{d2}@w{ }
@c %**end of body
@bye
[gcc r16-1227] ada: Deconstruct representation clauses required by ASIS
https://gcc.gnu.org/g:957a41f6daae59c3d0cbe1a76349416fae980ffa commit r16-1227-g957a41f6daae59c3d0cbe1a76349416fae980ffa Author: Piotr Trojanek Date: Mon Feb 24 14:19:46 2025 +0100 ada: Deconstruct representation clauses required by ASIS When GNAT was operating in ASIS mode, it was writing internal tables to files, so we annotated record types for elements stored in these tables with representation clauses to avoid holes with potentially uninitialized data. Since ASIS mode has been now deconstructed and we no longer write internal tables to files, we can remove explicit representation clauses and rely on the data layout chosen by the compiler. Code cleanup; behavior is unaffected. gcc/ada/ChangeLog: * lib.ads (Unit_Record): Remove representation clauses and filler components * lib-load.adb, lib-writ.adb: Remove initialization of data fillers. * nlists.adb (Allocate_List_Tables): Remove explicit initialization. * repinfo.adb (Exp_Node): Remove representation clauses. * sinput.ads (Source_File_Record): Likewise. * urealp.adb (Ureal_Entry): Likewise. Diff: --- gcc/ada/lib-load.adb | 6 -- gcc/ada/lib-writ.adb | 4 gcc/ada/lib.ads | 41 - gcc/ada/nlists.adb | 11 +-- gcc/ada/repinfo.adb | 14 -- gcc/ada/sinput.ads | 50 ++ gcc/ada/urealp.adb | 14 -- 7 files changed, 3 insertions(+), 137 deletions(-) diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb index 46de947c..bdeea1c8a75d 100644 --- a/gcc/ada/lib-load.adb +++ b/gcc/ada/lib-load.adb @@ -226,13 +226,11 @@ package body Lib.Load is Fatal_Error=> Error_Detected, Generate_Code => False, Has_RACW => False, - Filler => False, Ident_String => Empty, Is_Predefined_Renaming => Ren_Name, Is_Predefined_Unit => Pre_Name or Ren_Name, Is_Internal_Unit => Pre_Name or Ren_Name or GNAT_Name, - Filler2=> False, Loading=> False, Main_Priority => Default_Main_Priority, @@ -374,13 +372,11 @@ package body Lib.Load is Fatal_Error=> None, Generate_Code => True, Has_RACW => False, -Filler => False, Ident_String => Empty, Is_Predefined_Renaming => Ren_Name, Is_Predefined_Unit => Pre_Name or Ren_Name, Is_Internal_Unit => Pre_Name or Ren_Name or GNAT_Name, -Filler2=> False, Loading=> True, Main_Priority => Default_Main_Priority, @@ -760,13 +756,11 @@ package body Lib.Load is Fatal_Error=> None, Generate_Code => False, Has_RACW => False, - Filler => False, Ident_String => Empty, Is_Predefined_Renaming => Ren_Name, Is_Predefined_Unit => Pre_Name or Ren_Name, Is_Internal_Unit => Pre_Name or Ren_Name or GNAT_Name, - Filler2=> False, Loading=> True, Main_Priority => Default_Main_Priority, diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index ccb0bd2a175a..b7a7f129de95 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -116,12 +116,10 @@ package body Lib.Writ is Fatal_Error=> None, Generate_Code => False, Has_RACW => False, - Filler => False, Ident_String => Empty, Is_Predefined_Renaming => False, Is_Internal_Unit => False, Is_Predefined_Unit => False, - Filler2=> False, Loading=> False, Main_Priority => -1, Main_CPU => -1, @@ -175,12 +173,10 @@ package body Lib.Writ is Fatal_Error=> None, Generate_Code => False, Has_RACW => False, - Filler => False, Ident_String => Empty, Is_Predefined_Renaming => False, Is_Internal_Unit => True, Is_Predefined_Unit => True, - Filler2=> False, Loading=> False, Main_Priority => -1, Main_CPU => -1, diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads index c902ca217a66..c22db30219e5 100644 --- a/gcc/ada/lib.ads +
[gcc r16-1231] ada: Set Ekind early for entities created in expansion
https://gcc.gnu.org/g:5a8191d7fd64479756cce7063602b1dd34436d52
commit r16-1231-g5a8191d7fd64479756cce7063602b1dd34436d52
Author: Ronan Desplanques
Date: Wed Feb 26 11:22:45 2025 +0100
ada: Set Ekind early for entities created in expansion
This patch adds early Ekind assignments to entities created for the
expansion of a few constructs. The only effect is to enable more dynamic
checks for the uses of those entities that used to happen before the
Ekind had been set.
gcc/ada/ChangeLog:
* contracts.adb (Add_Invariant_And_Predicate_Checks): Assign Ekind.
* inline.adb (Expand_Inlined_Call): Likewise.
* exp_ch9.adb (Build_Simple_Entry_Call): Likewise.
* exp_dist.adb (Append_Array_Traversal): Likewise.
* exp_fixd.adb (Build_Double_Divide_Code, Build_Scaled_Divide_Code):
Likewise.
Diff:
---
gcc/ada/contracts.adb | 1 +
gcc/ada/exp_ch9.adb | 1 +
gcc/ada/exp_dist.adb | 2 ++
gcc/ada/exp_fixd.adb | 14 ++
gcc/ada/inline.adb| 1 +
5 files changed, 19 insertions(+)
diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb
index c0a57e6d0bae..fc48d7f97da6 100644
--- a/gcc/ada/contracts.adb
+++ b/gcc/ada/contracts.adb
@@ -2422,6 +2422,7 @@ package body Contracts is
-- verify the return value.
Result := Make_Defining_Identifier (Loc, Name_uResult);
+Mutate_Ekind (Result, E_Constant);
Set_Etype (Result, Typ);
-- Add an invariant check when the return type has invariants and
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index ff5668e08c4c..9cfc6b536e92 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -4273,6 +4273,7 @@ package body Exp_Ch9 is
Defining_Identifier => Obj,
Object_Definition => New_Occurrence_Of (Conctyp, Loc),
Expression => ExpR);
+ Mutate_Ekind (Obj, E_Variable);
Set_Etype (Obj, Conctyp);
Decls := New_List (Decl);
Rewrite (Concval, New_Occurrence_Of (Obj, Loc));
diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb
index 694fbe47daba..a351b9b8a8fb 100644
--- a/gcc/ada/exp_dist.adb
+++ b/gcc/ada/exp_dist.adb
@@ -10980,6 +10980,7 @@ package body Exp_Dist is
if not Constrained or else Depth > 1 then
Inner_Any := Make_Defining_Identifier (Loc,
New_External_Name ('A', Depth));
+ Mutate_Ekind (Inner_Any, E_Variable);
Set_Etype (Inner_Any, RTE (RE_Any));
else
Inner_Any := Empty;
@@ -10988,6 +10989,7 @@ package body Exp_Dist is
if Present (Counter) then
Inner_Counter := Make_Defining_Identifier (Loc,
New_External_Name ('J', Depth));
+ Mutate_Ekind (Inner_Counter, E_Variable);
else
Inner_Counter := Empty;
end if;
diff --git a/gcc/ada/exp_fixd.adb b/gcc/ada/exp_fixd.adb
index 03c7ca849158..8759099c193e 100644
--- a/gcc/ada/exp_fixd.adb
+++ b/gcc/ada/exp_fixd.adb
@@ -570,12 +570,16 @@ package body Exp_Fixd is
-- Case where we can compute the denominator in Max_Integer_Size bits
if QR_Id = RE_Null then
+ Mutate_Ekind (Qnn, E_Constant);
+ Mutate_Ekind (Rnn, E_Constant);
-- Create temporaries for numerator and denominator and set Etypes,
-- so that New_Occurrence_Of picks them up for Build_xxx calls.
Nnn := Make_Temporary (Loc, 'N');
+ Mutate_Ekind (Nnn, E_Constant);
Dnn := Make_Temporary (Loc, 'D');
+ Mutate_Ekind (Dnn, E_Constant);
Set_Etype (Nnn, QR_Typ);
Set_Etype (Dnn, QR_Typ);
@@ -621,6 +625,8 @@ package body Exp_Fixd is
-- to call the runtime routine to compute the quotient and remainder.
else
+ Mutate_Ekind (Qnn, E_Variable);
+ Mutate_Ekind (Rnn, E_Variable);
Rnd := Boolean_Literals (Rounded_Result_Set (N));
Code := New_List (
@@ -935,8 +941,13 @@ package body Exp_Fixd is
-- Case where we can compute the numerator in Max_Integer_Size bits
if QR_Id = RE_Null then
+ Mutate_Ekind (Qnn, E_Constant);
+ Mutate_Ekind (Rnn, E_Constant);
+
Nnn := Make_Temporary (Loc, 'N');
+ Mutate_Ekind (Nnn, E_Constant);
Dnn := Make_Temporary (Loc, 'D');
+ Mutate_Ekind (Dnn, E_Constant);
-- Set Etypes, so that they can be picked up by New_Occurrence_Of
@@ -982,6 +993,9 @@ package body Exp_Fixd is
-- to call the runtime routine to compute the quotient and remainder.
else
+ Mutate_Ekind (Qnn, E_Variable);
+ Mutate_Ekind (Rnn, E_Variable);
+
Rnd := Boolean_Literals (Rounded_Result_Set (N));
Code := New_List (
diff --git a/gcc/ada/inline.
[gcc r16-1230] ada: Rework Android struct sigaction bindings
https://gcc.gnu.org/g:bdec2b7ce2109cc3aad94cad3ab478db7ae2 commit r16-1230-gbdec2b7ce2109cc3aad94cad3ab478db7ae2 Author: Olivier Hainque Date: Fri Feb 21 08:18:38 2025 + ada: Rework Android struct sigaction bindings A previous change arranged for the common definition of struct_sigaction in s-osinte__android.ads to work both for ARM and aarch64 by way of representation clauses with field offsets taken from specialized versions of s-linux (one for ARM, one for aarch64). The aarch64 variant had the offsets wrong, placing the sa_handler pointer at offset 4, following the sa_flags int at offset 0. The pointer is 8 bytes wide so should be placed at an offset multiple of 8. This caused a discrepancy between the Ada runtime actions and the expectations of the underlying libc functions called. This change refactors the struct_sigaction definition to instanciate an entire type provided by s-linux instead, parametrized by sigset_t which needs to remain provided by the common System.OS_Interface spec. gcc/ada/ChangeLog: * libgnarl/s-linux__android-aarch64.ads: Provide an Android_Sigaction generic package to expose an aarch64 version of struct_sigation, using a provided sigset_t for sa_flags. * libgnarl/s-linux__android-arm.ads: Likewise, for ARM rather than aarch64. * libgnarl/s-osinte__android.ads: Move sigset_t definition to the visible part and use it to instantiate the Android_Sigation generic provided by System.Linux, which is specialized for ARM vs aarch64. Define struct_sigaction out of the Android_Sigaction instance, remove the local representation clauses. Diff: --- gcc/ada/libgnarl/s-linux__android-aarch64.ads | 20 +- gcc/ada/libgnarl/s-linux__android-arm.ads | 18 gcc/ada/libgnarl/s-osinte__android.ads| 40 ++- 3 files changed, 40 insertions(+), 38 deletions(-) diff --git a/gcc/ada/libgnarl/s-linux__android-aarch64.ads b/gcc/ada/libgnarl/s-linux__android-aarch64.ads index 4f9e81ddf656..537c46b5d3cc 100644 --- a/gcc/ada/libgnarl/s-linux__android-aarch64.ads +++ b/gcc/ada/libgnarl/s-linux__android-aarch64.ads @@ -118,13 +118,19 @@ package System.Linux is SIG33 : constant := 33; -- glibc internal signal SIG34 : constant := 34; -- glibc internal signal - -- struct_sigaction offsets - - -- sa_flags come first on aarch64-android (sa_flags, sa_handler, sa_mask) - - sa_flags_pos : constant := 0; - sa_handler_pos : constant := sa_flags_pos + Interfaces.C.int'Size / 8; - sa_mask_pos: constant := sa_handler_pos + Standard'Address_Size / 8; + -- struct_sigaction + + generic + type sigset_t is private; + package Android_Sigaction is + type struct_sigaction is record + sa_flags: Interfaces.C.int; + sa_handler : System.Address; + sa_mask : sigset_t; + sa_restorer : System.Address; + end record; + pragma Convention (C, struct_sigaction); + end Android_Sigaction; SA_SIGINFO : constant := 16#0004#; SA_ONSTACK : constant := 16#0800#; diff --git a/gcc/ada/libgnarl/s-linux__android-arm.ads b/gcc/ada/libgnarl/s-linux__android-arm.ads index 3e0325e1902d..07bca55f6c47 100644 --- a/gcc/ada/libgnarl/s-linux__android-arm.ads +++ b/gcc/ada/libgnarl/s-linux__android-arm.ads @@ -118,11 +118,19 @@ package System.Linux is SIG33 : constant := 33; -- glibc internal signal SIG34 : constant := 34; -- glibc internal signal - -- struct_sigaction offsets - - sa_handler_pos : constant := 0; - sa_mask_pos: constant := Standard'Address_Size / 8; - sa_flags_pos : constant := 4 + sa_mask_pos; + -- struct_sigaction + + generic + type sigset_t is private; + package Android_Sigaction is + type struct_sigaction is record + sa_handler : System.Address; + sa_mask : sigset_t; + sa_flags: Interfaces.C.int; + sa_restorer : System.Address; + end record; + pragma Convention (C, struct_sigaction); + end Android_Sigaction; SA_SIGINFO : constant := 16#0004#; SA_ONSTACK : constant := 16#0800#; diff --git a/gcc/ada/libgnarl/s-osinte__android.ads b/gcc/ada/libgnarl/s-osinte__android.ads index d74589047e75..4383860ed2b1 100644 --- a/gcc/ada/libgnarl/s-osinte__android.ads +++ b/gcc/ada/libgnarl/s-osinte__android.ads @@ -147,7 +147,20 @@ package System.OS_Interface is -- Not clear why these two signals are reserved. Perhaps they are not -- supported by this version of GNU/Linux ??? - type sigset_t is private; + -- struct sigaction fields are of different sizes and come in different + -- order on ARM vs aarch64. As this source is shared by the two + -- configurations, fetch the type definit
[gcc r16-1243] ada: Simplify tests for positive rational numbers
https://gcc.gnu.org/g:45a305c3c7b431c5be761dd7e05cc99384b32b32
commit r16-1243-g45a305c3c7b431c5be761dd7e05cc99384b32b32
Author: Piotr Trojanek
Date: Mon Feb 24 10:40:16 2025 +0100
ada: Simplify tests for positive rational numbers
Checking a rational number for being positive takes a shorter code path than
a general comparison with zero. Code cleanup; semantics is unaffected.
gcc/ada/ChangeLog:
* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Tune code for
attribute Small.
* sem_prag.adb (Analyze_Attribute): Tune code for pragma Time_Slice.
Diff:
---
gcc/ada/sem_ch13.adb | 2 +-
gcc/ada/sem_prag.adb | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 5e7cba8bef91..76a8c0ba7331 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -7250,7 +7250,7 @@ package body Sem_Ch13 is
else
Small := Expr_Value_R (Expr);
- if Small <= Ureal_0 then
+ if not UR_Is_Positive (Small) then
Error_Msg_N ("small value must be greater than zero", Expr);
return;
end if;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index b94606eabc71..4090d0c71175 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -26953,7 +26953,7 @@ package body Sem_Prag is
Opt.Time_Slice_Set := True;
Val := Expr_Value_R (Get_Pragma_Arg (Arg1));
- if Val <= Ureal_0 then
+ if not UR_Is_Positive (Val) then
Opt.Time_Slice_Value := 0;
elsif Val > UR_From_Uint (UI_From_Int (1000)) then
[gcc r16-1245] ada: Avoid repeated range checks when negating a rational number
https://gcc.gnu.org/g:73763e312fb3fc483ab0d159d35998b5d927a333 commit r16-1245-g73763e312fb3fc483ab0d159d35998b5d927a333 Author: Piotr Trojanek Date: Thu Feb 27 11:44:54 2025 +0100 ada: Avoid repeated range checks when negating a rational number Use local constant to avoid repeated range checks (at least in the debug builds), but also to make the code easier to read and consistent in style with similar routines in the same package. gcc/ada/ChangeLog: * urealp.adb (UR_Negate): Capture array element in a local constant. Diff: --- gcc/ada/urealp.adb | 9 + 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/gcc/ada/urealp.adb b/gcc/ada/urealp.adb index 3a9fddea60b5..d5fb4f55be7d 100644 --- a/gcc/ada/urealp.adb +++ b/gcc/ada/urealp.adb @@ -1237,12 +1237,13 @@ package body Urealp is --- function UR_Negate (Real : Ureal) return Ureal is + Val : constant Ureal_Entry := Ureals.Table (Real); begin return Store_Ureal - ((Num => Ureals.Table (Real).Num, - Den => Ureals.Table (Real).Den, - Rbase=> Ureals.Table (Real).Rbase, - Negative => not Ureals.Table (Real).Negative)); + ((Num => Val.Num, + Den => Val.Den, + Rbase=> Val.Rbase, + Negative => not Val.Negative)); end UR_Negate;
[gcc r16-1152] ada: Implement built-in-place expansion of two-pass array aggregates
https://gcc.gnu.org/g:9d7bdc266174b3e477dd51818e095cdf149eb2d1 commit r16-1152-g9d7bdc266174b3e477dd51818e095cdf149eb2d1 Author: Eric Botcazou Date: Fri Jan 24 10:26:13 2025 +0100 ada: Implement built-in-place expansion of two-pass array aggregates These are array aggregates containing only component associations that are iterated with iterator specifications, as per RM 4.3.3(20.2/5-20.4/5). It is implemented for the array aggregates that are used to initialize an object, as specified by RM 7.6(17.2/3-17.3/3) for immutably limited types and types that need finalization, but for all types like other aggregates. gcc/ada/ChangeLog: * exp_aggr.adb (Build_Two_Pass_Aggr_Code): New function containing most of the code initially present in Two_Pass_Aggregate_Expansion. (Two_Pass_Aggregate_Expansion): Remove redundant N parameter. Implement built-in-place expansion for (static) object declarations and allocators, using Build_Two_Pass_Aggr_Code for the main work. (Expand_Array_Aggregate): Adjust Two_Pass_Aggregate_Expansion call. Replace Etype (N) by Typ in a couple of places. * exp_ch3.adb (Expand_Freeze_Array_Type): Remove special case for two-pass array aggregates. (Expand_N_Object_Declaration): Do not adjust the object when it is initialized by a two-pass array aggregate. * exp_ch4.adb (Expand_Allocator_Expression): Apply the processing used for container aggregates to two-pass array aggregates. * exp_ch6.adb (Validate_Subprogram_Calls): Skip calls present in initialization expressions of N_Object_Declaration nodes that have No_Initialization set. * sem_ch3.adb (Analyze_Object_Declaration): Detect the cases of an array originally initialized by an aggregate consistently. Diff: --- gcc/ada/exp_aggr.adb | 498 +++ gcc/ada/exp_ch3.adb | 11 +- gcc/ada/exp_ch4.adb | 13 +- gcc/ada/exp_ch6.adb | 7 + gcc/ada/sem_ch3.adb | 11 +- 5 files changed, 324 insertions(+), 216 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 3c4576df3b83..f2e7ad76e98f 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -4956,6 +4956,14 @@ package body Exp_Aggr is -- type using the computable sizes of the aggregate and its sub- -- aggregates. + function Build_Two_Pass_Aggr_Code +(Lhs : Node_Id; + Aggr_Typ : out Entity_Id) return List_Id; + -- The aggregate consists only of iterated associations and Lhs is an + -- expression containing the location of the anonymous object, which + -- may be built in place. Returns the dynamic subtype of the aggregate + -- in Aggr_Typ and the list of statements needed to build it. + procedure Check_Bounds (Aggr_Bounds_Node, Index_Bounds_Node : Node_Id); -- Checks that the bounds of Aggr_Bounds are within the bounds defined -- by Index_Bounds. For null array aggregate (Ada 2022) check that the @@ -4983,7 +4991,7 @@ package body Exp_Aggr is -- built directly into the target of an assignment, the target must -- be free of side effects. N is the target of the assignment. - procedure Two_Pass_Aggregate_Expansion (N : Node_Id); + procedure Two_Pass_Aggregate_Expansion; -- If the aggregate consists only of iterated associations then the -- aggregate is constructed in two steps: -- a) Build an expression to compute the number of elements @@ -5053,6 +5061,221 @@ package body Exp_Aggr is Freeze_Itype (Agg_Type, N); end Build_Constrained_Type; + -- + -- Build_Two_Pass_Aggr_Code -- + -- + + function Build_Two_Pass_Aggr_Code +(Lhs : Node_Id; + Aggr_Typ : out Entity_Id) return List_Id + is + Index_Id : constant Entity_Id := Make_Temporary (Loc, 'I', N); + Index_Type : constant Entity_Id := Etype (First_Index (Typ)); + Index_Base : constant Entity_Id := Base_Type (Index_Type); + Size_Id: constant Entity_Id := Make_Temporary (Loc, 'I', N); + Size_Type : constant Entity_Id := +Integer_Type_For + (Esize (Index_Base), Is_Unsigned_Type (Index_Base)); + + Assoc: Node_Id; + Incr : Node_Id; + Iter : Node_Id; + New_Comp : Node_Id; + One_Loop : Node_Id; + Iter_Id : Entity_Id; + + Aggr_Code : List_Id; + Size_Expr_Code : List_Id; + + begin + Size_Expr_Code := New_List ( + Make_Object_Declaration (Loc, + Defining_Identifier => Size_Id, + Object_Definition => New_Occurrence_Of (Size_Type, Loc), +
[gcc r16-1163] ada: Activate SPARK_Mode in Ada.Numerics.*_Random specs
https://gcc.gnu.org/g:c657fe1488649a919f7cc48ea2b74c8aa062c5b8 commit r16-1163-gc657fe1488649a919f7cc48ea2b74c8aa062c5b8 Author: Andres Toom Date: Tue Jan 28 15:41:27 2025 +0200 ada: Activate SPARK_Mode in Ada.Numerics.*_Random specs gcc/ada/ChangeLog: * libgnat/a-nudira.ads: Activate SPARK mode and add missing basic contracts. Mark the unit as always terminating. * libgnat/a-nuflra.ads: Idem. Diff: --- gcc/ada/libgnat/a-nudira.ads | 42 -- gcc/ada/libgnat/a-nuflra.ads | 34 +- 2 files changed, 57 insertions(+), 19 deletions(-) diff --git a/gcc/ada/libgnat/a-nudira.ads b/gcc/ada/libgnat/a-nudira.ads index 647470b7890e..3b2ca1868e8d 100644 --- a/gcc/ada/libgnat/a-nudira.ads +++ b/gcc/ada/libgnat/a-nudira.ads @@ -44,38 +44,60 @@ generic type Result_Subtype is (<>); package Ada.Numerics.Discrete_Random with - SPARK_Mode => Off + SPARK_Mode => On, + Always_Terminates is -- Basic facilities - type Generator is limited private; + type Generator is limited private with Default_Initial_Condition; - function Random (Gen : Generator) return Result_Subtype; + function Random (Gen : Generator) return Result_Subtype with + Global => null, + Side_Effects; + pragma Annotate (GNATprove, Mutable_In_Parameters, Generator); function Random (Gen : Generator; First : Result_Subtype; Last : Result_Subtype) return Result_Subtype - with Post => Random'Result in First .. Last; + with + Post => Random'Result in First .. Last, + Global => null, + Side_Effects; + pragma Annotate (GNATprove, Mutable_In_Parameters, Generator); - procedure Reset (Gen : Generator; Initiator : Integer); - procedure Reset (Gen : Generator); + procedure Reset (Gen : Generator; Initiator : Integer) with + Global => null; + pragma Annotate (GNATprove, Mutable_In_Parameters, Generator); + + procedure Reset (Gen : Generator) with + Global => null; + pragma Annotate (GNATprove, Mutable_In_Parameters, Generator); -- Advanced facilities type State is private; - procedure Save (Gen : Generator; To_State : out State); - procedure Reset (Gen : Generator; From_State : State); + procedure Save (Gen : Generator; To_State : out State) with + Global => null; + pragma Annotate (GNATprove, Mutable_In_Parameters, Generator); + + procedure Reset (Gen : Generator; From_State : State) with + Global => null; + pragma Annotate (GNATprove, Mutable_In_Parameters, Generator); Max_Image_Width : constant := System.Random_Numbers.Max_Image_Width; - function Image (Of_State: State) return String; - function Value (Coded_State : String) return State; + function Image (Of_State: State) return String with + Global => null; + function Value (Coded_State : String) return State with + Global => null; private + pragma SPARK_Mode (Off); + type Generator is new System.Random_Numbers.Generator; type State is new System.Random_Numbers.State; diff --git a/gcc/ada/libgnat/a-nuflra.ads b/gcc/ada/libgnat/a-nuflra.ads index 7eb0494bded0..9ea73d432a6f 100644 --- a/gcc/ada/libgnat/a-nuflra.ads +++ b/gcc/ada/libgnat/a-nuflra.ads @@ -39,34 +39,50 @@ with System.Random_Numbers; package Ada.Numerics.Float_Random with - SPARK_Mode => Off + SPARK_Mode => On, + Always_Terminates is -- Basic facilities - type Generator is limited private; + type Generator is limited private with Default_Initial_Condition; subtype Uniformly_Distributed is Float range 0.0 .. 1.0; - function Random (Gen : Generator) return Uniformly_Distributed; + function Random (Gen : Generator) return Uniformly_Distributed with + Global => null, + Side_Effects; + pragma Annotate (GNATprove, Mutable_In_Parameters, Generator); + procedure Reset (Gen : Generator) with + Global => null; + pragma Annotate (GNATprove, Mutable_In_Parameters, Generator); - procedure Reset (Gen : Generator); - procedure Reset (Gen : Generator; Initiator : Integer); + procedure Reset (Gen : Generator; Initiator : Integer) with + Global => null; + pragma Annotate (GNATprove, Mutable_In_Parameters, Generator); -- Advanced facilities type State is private; - procedure Save (Gen : Generator; To_State : out State); - procedure Reset (Gen : Generator; From_State : State); + procedure Save (Gen : Generator; To_State : out State) with + Global => null; + pragma Annotate (GNATprove, Mutable_In_Parameters, Generator); + procedure Reset (Gen : Generator; From_State : State) with + Global => null; + pragma Annotate (GNATprove, Mutable_In_Parameters, Generator); Max_Image_Width : constant := System.Random_Numbers.Max_Image_Width; - function Image (Of_State: State) return String; - function Value (Coded_State : String) return
[gcc r16-1157] ada: Fix crash on access to protected return
https://gcc.gnu.org/g:201fd7899da99767f88fbd75d61b20fdc0cc190d commit r16-1157-g201fd7899da99767f88fbd75d61b20fdc0cc190d Author: Ronan Desplanques Date: Mon Jan 27 12:04:41 2025 +0100 ada: Fix crash on access to protected return The generation of the check mandated by Ada issue AI05-0073 was not done handled properly for protected types when used through subtypes. This patch fixes the issue. gcc/ada/ChangeLog: * exp_ch4.adb (Tagged_Membership): Fix for protected types. Diff: --- gcc/ada/exp_ch4.adb | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 8c724844eb32..eb9fb6bba569 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -15036,10 +15036,11 @@ package body Exp_Ch4 is -- Handle entities from the limited view - Orig_Right_Type : constant Entity_Id := Available_View (Etype (Right)); + Orig_Right_Type : constant Entity_Id := +Base_Type (Available_View (Etype (Right))); Full_R_Typ : Entity_Id; - Left_Type: Entity_Id := Available_View (Etype (Left)); + Left_Type: Entity_Id := Base_Type (Available_View (Etype (Left))); Right_Type : Entity_Id := Orig_Right_Type; Obj_Tag : Node_Id;
[gcc r16-1149] ada: Reject Valid_Value arguments originating from Standard
https://gcc.gnu.org/g:ed34ee07843e07932411ecf2d0582faa96b57380
commit r16-1149-ged34ee07843e07932411ecf2d0582faa96b57380
Author: Viljar Indus
Date: Mon Jan 20 15:10:22 2025 +0200
ada: Reject Valid_Value arguments originating from Standard
The constraint for Valid_Value not applying to types from Standard
should also apply to all types derived from those types.
gcc/ada/ChangeLog:
* doc/gnat_rm/implementation_defined_attributes.rst: Update the
documentation for Valid_Value.
* sem_attr.adb (Analyze_Attribute): Reject types where
the root type originates from Standard.
* gnat_rm.texi: Regenerate.
* gnat_ugn.texi: Regenerate.
Diff:
---
gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst | 6 +++---
gcc/ada/gnat_rm.texi | 6 +++---
gcc/ada/gnat_ugn.texi | 2 +-
gcc/ada/sem_attr.adb | 5 +++--
4 files changed, 10 insertions(+), 9 deletions(-)
diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst
b/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst
index f0518106853f..86d2a815e1e0 100644
--- a/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst
+++ b/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst
@@ -1629,9 +1629,9 @@ Attribute Valid_Value
.. index:: Valid_Value
The ``'Valid_Value`` attribute is defined for enumeration types other than
-those in package Standard. This attribute is a function that takes
-a String, and returns Boolean. ``T'Valid_Value (S)`` returns True
-if and only if ``T'Value (S)`` would not raise Constraint_Error.
+those in package Standard or types derived from those types. This attribute is
+a function that takes a String, and returns Boolean. ``T'Valid_Value (S)``
+returns True if and only if ``T'Value (S)`` would not raise Constraint_Error.
Attribute Valid_Scalars
===
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 00236ee6c5ca..5719d0d3e62d 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -12360,9 +12360,9 @@ which changes element (1,2) to 20 and (3,4) to 30.
@geindex Valid_Value
The @code{'Valid_Value} attribute is defined for enumeration types other than
-those in package Standard. This attribute is a function that takes
-a String, and returns Boolean. @code{T'Valid_Value (S)} returns True
-if and only if @code{T'Value (S)} would not raise Constraint_Error.
+those in package Standard or types derived from those types. This attribute is
+a function that takes a String, and returns Boolean. @code{T'Valid_Value (S)}
+returns True if and only if @code{T'Value (S)} would not raise
Constraint_Error.
@node Attribute Valid_Scalars,Attribute VADS_Size,Attribute
Valid_Value,Implementation Defined Attributes
@anchor{gnat_rm/implementation_defined_attributes
attribute-valid-scalars}@anchor{1c5}
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index ca1d7bcc1abf..5331a318c0d8 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -29833,8 +29833,8 @@ to permit their use in free software.
@printindex ge
-@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{
}
@anchor{d2}@w{ }
+@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{
}
@c %**end of body
@bye
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index af08fdb2e33f..08da29a21984 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -7511,13 +7511,14 @@ package body Sem_Attr is
Set_Etype (N, Standard_Boolean);
Validate_Non_Static_Attribute_Function_Call;
- if P_Type in Standard_Boolean
+ if Root_Type (P_Type) in Standard_Boolean
| Standard_Character
| Standard_Wide_Character
| Standard_Wide_Wide_Character
then
Error_Attr_P
- ("prefix of % attribute must not be a type in Standard");
+ ("prefix of % attribute must not be a type originating from " &
+ "Standard");
end if;
if Discard_Names (First_Subtype (P_Type)) then
[gcc r16-1153] ada: Mitigate issue with tracebacks
https://gcc.gnu.org/g:d46138a434b1b372b84dfeef25e8b79679196179 commit r16-1153-gd46138a434b1b372b84dfeef25e8b79679196179 Author: Ronan Desplanques Date: Thu Jan 30 16:02:31 2025 +0100 ada: Mitigate issue with tracebacks The way we fetch the path to shared objects for traceback generation is not perfectly precise. This patch adds a sanity check to mitigate the consequences of incorrect shared object paths. It's motivated by a real world failure in a GNATSAS test. gcc/ada/ChangeLog: * libgnat/s-trasym__dwarf.adb (Init_Module): Add mitigation. Diff: --- gcc/ada/libgnat/s-trasym__dwarf.adb | 18 ++ 1 file changed, 18 insertions(+) diff --git a/gcc/ada/libgnat/s-trasym__dwarf.adb b/gcc/ada/libgnat/s-trasym__dwarf.adb index 45af884b61fe..1b4b807f5669 100644 --- a/gcc/ada/libgnat/s-trasym__dwarf.adb +++ b/gcc/ada/libgnat/s-trasym__dwarf.adb @@ -41,6 +41,7 @@ with System.Soft_Links; with System.CRTL; with System.Dwarf_Lines; with System.Exception_Traces; +with System.OS_Lib; with System.Standard_Library; with System.Traceback_Entries; with System.Strings; @@ -413,6 +414,23 @@ package body System.Traceback.Symbolic is return; end if; + -- On some platforms, we use dladdr and the dli_fname field to get the + -- pathname, but that pathname might be relative and not point to the + -- right thing in our context. That happens when the executable is + -- dynamically linked and was started through execvp; dli_fname only + -- contains the executable name passed to execvp in that case. + -- + -- Because of this, we might be about to open a file that's in fact not + -- a shared object but something completely unrelated. It's hard to + -- detect this in general, but we perform a sanity check that + -- Module_Name does not designate a directory; if it does, it's + -- definitely not a shared object. + + if System.OS_Lib.Is_Directory (Module_Name) then + Success := False; + return; + end if; + Open (Module_Name, Module.C, Success); -- If a module can't be opened just return now, we just cannot give more
[gcc r16-1151] ada: Add missing Ghost aspect to Lemma_Not_In_Range_Big2xx32 in s-arit32.adb
https://gcc.gnu.org/g:d4325877f35c8984680319c76af8274dd35c40fb commit r16-1151-gd4325877f35c8984680319c76af8274dd35c40fb Author: Johannes Kliemann Date: Tue Jan 28 12:13:31 2025 + ada: Add missing Ghost aspect to Lemma_Not_In_Range_Big2xx32 in s-arit32.adb gcc/ada/ChangeLog: * libgnat/s-arit32.adb (Lemma_Not_In_Range_Big2xx32): Add missing Ghost aspect. Diff: --- gcc/ada/libgnat/s-arit32.adb | 1 + 1 file changed, 1 insertion(+) diff --git a/gcc/ada/libgnat/s-arit32.adb b/gcc/ada/libgnat/s-arit32.adb index 91082e7692ab..5172d1dba0e6 100644 --- a/gcc/ada/libgnat/s-arit32.adb +++ b/gcc/ada/libgnat/s-arit32.adb @@ -203,6 +203,7 @@ is procedure Lemma_Not_In_Range_Big2xx32 with + Ghost, Post => not In_Int32_Range (Big_2xx32) and then not In_Int32_Range (-Big_2xx32);
[gcc r16-1130] ada: Avoid calling Resolve with Stand.Any_Fixed as the expected type
https://gcc.gnu.org/g:ef505b3a829acdba9e0a8df75aed8dcda4afce81
commit r16-1130-gef505b3a829acdba9e0a8df75aed8dcda4afce81
Author: Steve Baird
Date: Fri Jan 10 13:15:18 2025 -0800
ada: Avoid calling Resolve with Stand.Any_Fixed as the expected type
When we call Resolve for an expression, we pass in the expected type
for that expression. In the absence of semantic errors, that expected type
should never be any of the "Any_xxx" types declared in stand.ads (e.g.,
Any_Array, Any_Numeric, Any_Real). In particular, it should never be
Any_Fixed.
Fix a case in which this rule was being violated.
gcc/ada/ChangeLog:
* sem_res.adb
(Set_Mixed_Mode_Operand): If we are about to call Resolve
passing in Any_Fixed as the expected type, then instead pass in
the fixed point type of the other operand (i.e., B_Typ).
Diff:
---
gcc/ada/sem_res.adb | 2 ++
1 file changed, 2 insertions(+)
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index b73b947c9a25..0df6c27c30d7 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -6101,6 +6101,8 @@ package body Sem_Res is
elsif Is_Fixed_Point_Type (It.Typ) then
if Analyzed (N) then
Error_Msg_N ("ambiguous operand in fixed operation", N);
+ elsif It.Typ = Any_Fixed then
+ Resolve (N, B_Typ);
else
Resolve (N, It.Typ);
end if;
[gcc r16-1155] ada: Tweak caching of streaming subprograms
https://gcc.gnu.org/g:700f14ab3240d4ea1b594976f6a0c278581df7d9 commit r16-1155-g700f14ab3240d4ea1b594976f6a0c278581df7d9 Author: Ronan Desplanques Date: Fri Jan 31 10:40:42 2025 +0100 ada: Tweak caching of streaming subprograms gcc/ada/ChangeLog: * exp_attr.adb (Interunit_Ref_OK): Tweak categorization of compilation units. Diff: --- gcc/ada/exp_attr.adb | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index aea9e8ad3afd..4e0052e9ee41 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -284,8 +284,8 @@ package body Exp_Attr is (In_Same_Extended_Unit (Subp_Unit, Attr_Ref_Unit) -- If subp declared in unit body, then we don't want to refer -- to it from within unit spec so return False in that case. - and then not (Body_Required (Attr_Ref_Unit) - and not Body_Required (Subp_Unit))); + and then not (not Is_Body (Unit (Attr_Ref_Unit)) + and Is_Body (Unit (Subp_Unit; -- Returns True if it is ok to refer to a cached subprogram declared in -- Subp_Unit from the point of an attribute reference occurring in -- Attr_Ref_Unit. Both arguments are usually N_Compilation_Nodes,
[gcc r16-1164] ada: Tweak wording of documentation comments in Atree
https://gcc.gnu.org/g:b35d2322d7b970e1e6eab2094bfebbccf661ae17 commit r16-1164-gb35d2322d7b970e1e6eab2094bfebbccf661ae17 Author: Ronan Desplanques Date: Fri Feb 7 14:43:37 2025 +0100 ada: Tweak wording of documentation comments in Atree This patch removes an outdated reference to the concept of node extensions in comments. It also slightly clarifies the documentation of Atree.Relocate_Node. gcc/ada/ChangeLog: * atree.ads (New_Copy, Relocate_Node): Tweak documentation comments. Diff: --- gcc/ada/atree.ads | 15 +++ 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index dc5fe0d8ad61..c8cc2bcf0c4f 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -299,20 +299,19 @@ package Atree is -- This function allocates a new node, and then initializes it by copying -- the contents of the source node into it. The contents of the source node -- is not affected. The target node is always marked as not being in a list - -- (even if the source is a list member), and not overloaded. The new node - -- will have an extension if the source has an extension. New_Copy (Empty) - -- returns Empty, and New_Copy (Error) returns Error. Note that, unlike - -- Copy_Separate_Tree, New_Copy does not recursively copy any descendants, - -- so in general parent pointers are not set correctly for the descendants - -- of the copied node. + -- (even if the source is a list member), and not overloaded. + -- New_Copy (Empty) returns Empty, and New_Copy (Error) returns Error. Note + -- that, unlike Copy_Separate_Tree, New_Copy does not recursively copy any + -- descendants, so in general parent pointers are not set correctly for the + -- descendants of the copied node. function Relocate_Node (Source : Node_Id) return Node_Id; -- Source is a non-entity node that is to be relocated. A new node is -- allocated, and the contents of Source are copied to this node, using -- New_Copy. The parent pointers of descendants of the node are then -- adjusted to point to the relocated copy. The original node is not - -- modified, but the parent pointers of its descendants are no longer - -- valid. The new copy is always marked as not overloaded. This routine is + -- modified, but the parent pointers of its children no longer point back + -- at it. The new copy is always marked as not overloaded. This routine is -- used in conjunction with the tree rewrite routines (see descriptions of -- Replace/Rewrite). --
[gcc r16-1158] ada: Add Ghost aspect to Lo in s-arit32.adb
https://gcc.gnu.org/g:4405925143b620b9c18889cc79433d90100416d7 commit r16-1158-g4405925143b620b9c18889cc79433d90100416d7 Author: Aleksandra Pasek Date: Mon Feb 3 18:09:36 2025 + ada: Add Ghost aspect to Lo in s-arit32.adb gcc/ada/ChangeLog: * libgnat/s-arit32.adb: Add Ghost aspect to Lo. Diff: --- gcc/ada/libgnat/s-arit32.adb | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gcc/ada/libgnat/s-arit32.adb b/gcc/ada/libgnat/s-arit32.adb index 5172d1dba0e6..eb4e6e5590f6 100644 --- a/gcc/ada/libgnat/s-arit32.adb +++ b/gcc/ada/libgnat/s-arit32.adb @@ -96,7 +96,8 @@ is -- Convert absolute value of X to unsigned. Note that we can't just use -- the expression of the Else since it overflows for X = Int32'First. - function Lo (A : Uns64) return Uns32 is (Uns32 (A and (2 ** 32 - 1))); + function Lo (A : Uns64) return Uns32 is (Uns32 (A and (2 ** 32 - 1))) + with Ghost; -- Low order half of 64-bit value function Hi (A : Uns64) return Uns32 is (Uns32 (Shift_Right (A, 32)));
[gcc r16-1159] ada: Missing error on expression function returning incomplete type
https://gcc.gnu.org/g:9fc6eedace2607c5e322f4b874f290975f0d2b0e
commit r16-1159-g9fc6eedace2607c5e322f4b874f290975f0d2b0e
Author: Javier Miranda
Date: Tue Feb 4 19:41:53 2025 +
ada: Missing error on expression function returning incomplete type
When the type of the expression of an expression function is
an incomplete type, the frontend does not report the expected
error.
gcc/ada/ChangeLog:
* sem_ch6.adb (Analyze_Expression_Function): Add missing check
on premature use of incomplete type.
Diff:
---
gcc/ada/sem_ch6.adb | 5 +
1 file changed, 5 insertions(+)
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 0cfcc1cb263b..d4e6d1693263 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -591,6 +591,11 @@ package body Sem_Ch6 is
End_Scope;
end if;
+ if Is_Incomplete_Type (Typ) then
+Error_Msg_NE
+ ("premature usage of incomplete}", Expr, First_Subtype (Typ));
+ end if;
+
-- In the case of an expression function marked with the aspect
-- Static, we need to check the requirement that the function's
-- expression is a potentially static expression. This is done
[gcc r16-1162] ada: Spurious compilation error with repeated loop index
https://gcc.gnu.org/g:5ece6a808254ca1653872cc2ca64a72e91d19731 commit r16-1162-g5ece6a808254ca1653872cc2ca64a72e91d19731 Author: Javier Miranda Date: Thu Feb 6 09:40:57 2025 + ada: Spurious compilation error with repeated loop index When multiple for-loop statements in the same scope use the same index name to iterate through container elements, the compiler reports a spurious error indicating a conflict between index names. gcc/ada/ChangeLog: * exp_ch7.adb (Process_Object_Declaration): Avoid generating duplicate names for master nodes. Diff: --- gcc/ada/exp_ch7.adb | 15 +++ 1 file changed, 15 insertions(+) diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 67af1d772631..905094c7e404 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -2783,16 +2783,31 @@ package body Exp_Ch7 is Master_Node_Id := Make_Defining_Identifier (Master_Node_Loc, Chars => New_External_Name (Chars (Obj_Id), Suffix => "MN")); + Master_Node_Decl := Make_Master_Node_Declaration (Master_Node_Loc, Master_Node_Id, Obj_Id); Push_Scope (Scope (Obj_Id)); + +-- Avoid generating duplicate names for master nodes + +if Ekind (Obj_Id) = E_Loop_Parameter + and then +Present (Current_Entity_In_Scope (Chars (Master_Node_Id))) +then + Set_Chars (Master_Node_Id, + New_External_Name (Chars (Obj_Id), + Suffix => "MN", + Suffix_Index => -1)); +end if; + if not Has_Strict_Ctrl_Objs or else Count = 1 then Prepend_To (Decls, Master_Node_Decl); else Insert_Before (Decl, Master_Node_Decl); end if; + Analyze (Master_Node_Decl); Pop_Scope;
[gcc r16-1131] ada: Use absolute paths in SARIF reports
https://gcc.gnu.org/g:0827f611f87041f1b0fadba68c0f08506d44ce3e
commit r16-1131-g0827f611f87041f1b0fadba68c0f08506d44ce3e
Author: Viljar Indus
Date: Mon Dec 2 12:18:06 2024 +0200
ada: Use absolute paths in SARIF reports
gcc/ada/ChangeLog:
* diagnostics-json_utils.adb: Add new method To_File_Uri to
convert any path to the URI standard.
* diagnostics-json_utils.ads: Likewise.
* diagnostics-sarif_emitter.adb: Converted Artifact_Change
types to use the Source_File_Index instead of the file name
to store the source file.
Removed the body from Destroy (Elem : in out Artifact_Change)
since it no longer contained elements with dynamic memory.
Updated the implementation of Equals (L, R : Artifact_Change)
to take into account the changes for Artifact_Change.
Print_Artifact_Location: Use the Source_File_Index as an
input argument. Now prints the uriBaseId attribute and a
relative path from the uriBaseId to the file in question as
the value of the uri attribute.
New method Print_Original_Uri_Base_Ids to print the
originalUriBaseIds node.
Print_Run no prints the originalUriBaseIds node.
Use constants instead of strings for all the SARIF attributes.
* osint.adb: Add new method Relative_Path to calculate the
relative path from a base directory.
Add new method Root to calculate the root of each directory.
Add new method Get_Current_Dir to get the current working
directory for the execution environment.
* osint.ads: Likewise.
* clean.adb: Use full names for calls to Get_Current_Dir.
* gnatls.adb: Likewise.
Diff:
---
gcc/ada/clean.adb | 7 +-
gcc/ada/diagnostics-json_utils.adb| 139 ++
gcc/ada/diagnostics-json_utils.ads| 5 +
gcc/ada/diagnostics-sarif_emitter.adb | 263 --
gcc/ada/gnatls.adb| 4 +-
gcc/ada/osint.adb | 118 +--
gcc/ada/osint.ads | 10 ++
7 files changed, 460 insertions(+), 86 deletions(-)
diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb
index f28cf691cf9d..dcbeffe1b8e9 100644
--- a/gcc/ada/clean.adb
+++ b/gcc/ada/clean.adb
@@ -319,7 +319,9 @@ package body Clean is
Delete ("", Executable);
end if;
- Delete_Binder_Generated_Files (Get_Current_Dir, Source);
+ Delete_Binder_Generated_Files
+ (GNAT.Directory_Operations.Get_Current_Dir,
+ Source);
end;
end if;
end loop;
@@ -405,7 +407,8 @@ package body Clean is
Source : File_Name_Type)
is
Source_Name : constant String := Get_Name_String (Source);
- Current : constant String := Get_Current_Dir;
+ Current : constant String :=
+GNAT.Directory_Operations.Get_Current_Dir;
Last: constant Positive := B_Start'Length + Source_Name'Length;
File_Name : String (1 .. Last + 4);
diff --git a/gcc/ada/diagnostics-json_utils.adb
b/gcc/ada/diagnostics-json_utils.adb
index 072cab4a4928..8ce04c4631f6 100644
--- a/gcc/ada/diagnostics-json_utils.adb
+++ b/gcc/ada/diagnostics-json_utils.adb
@@ -22,7 +22,11 @@
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
--
+
+with Namet; use Namet;
+with Osint;
with Output; use Output;
+with System.OS_Lib;
package body Diagnostics.JSON_Utils is
@@ -64,6 +68,141 @@ package body Diagnostics.JSON_Utils is
end if;
end NL_And_Indent;
+ -
+ -- To_File_Uri --
+ -
+
+ function To_File_Uri (Path : String) return String is
+
+ function Normalize_Uri (Path : String) return String;
+ -- Construct a normalized URI from the path name by replacing reserved
+ -- URI characters that can appear in paths with their escape character
+ -- combinations.
+ --
+ -- According to the URI standard reserved charcthers within the paths
+ -- should be percent encoded:
+ --
+ -- https://www.rfc-editor.org/info/rfc3986
+ --
+ -- Reserved charcters are defined as:
+ --
+ -- reserved = gen-delims / sub-delims
+ -- gen-delims = ":" / "/" / "?" / "#" / "[" / "]" / "@"
+ -- sub-delims = "!" / "$" / "&" / "’" / "(" / ")"
+ -- / "*" / "+" / "," / ";" / "="
+
+ ---
+ -- Normalize_Uri --
+ ---
+
+ function Normalize_Uri (Path : String) return String is
+ Buf : Bounded_String;
+ begin
+ for C of Path loop
+
[gcc r16-1138] ada: Fix New_Char_Array with empty arrays
https://gcc.gnu.org/g:ac936aa57ee0b0a867e80233efefa204b2ae2bc7
commit r16-1138-gac936aa57ee0b0a867e80233efefa204b2ae2bc7
Author: Ronan Desplanques
Date: Thu Jan 16 12:55:37 2025 +0100
ada: Fix New_Char_Array with empty arrays
This patch fixes an integer underflow issue on calls of the form
New_Char_Array (X) with X'Last < X'First - 2. That integer underflow
caused attempts at allocating impossibly large amount of memory in some
cases.
gcc/ada/ChangeLog:
* libgnat/i-cstrin.adb (Position_Of_Nul): Change specification and
adjust body accordingly.
(New_Char_Array): Fix size of allocation.
(To_Chars_Ptr): Adapt to Position_Of_Nul change.
Diff:
---
gcc/ada/libgnat/i-cstrin.adb | 62 +---
1 file changed, 35 insertions(+), 27 deletions(-)
diff --git a/gcc/ada/libgnat/i-cstrin.adb b/gcc/ada/libgnat/i-cstrin.adb
index 7bf881f87167..6d329254aff3 100644
--- a/gcc/ada/libgnat/i-cstrin.adb
+++ b/gcc/ada/libgnat/i-cstrin.adb
@@ -66,8 +66,11 @@ is
pragma Inline ("+");
-- Address arithmetic on chars_ptr value
- function Position_Of_Nul (Into : char_array) return size_t;
- -- Returns position of the first Nul in Into or Into'Last + 1 if none
+ procedure Position_Of_Nul
+ (Into : char_array; Found : out Boolean; Index : out size_t);
+ -- If into contains a Nul character, Found is set to True and Index
+ -- contains the position of the first Nul character in Into. Otherwise
+ -- Found is set to False and the value of Index is not meaningful.
-- We can't use directly System.Memory because the categorization is not
-- compatible, so we directly import here the malloc and free routines.
@@ -107,6 +110,7 @@ is
function New_Char_Array (Chars : char_array) return chars_ptr is
+ Found : Boolean;
Index : size_t;
Pointer : chars_ptr;
@@ -114,24 +118,25 @@ is
-- Get index of position of null. If Index > Chars'Last,
-- nul is absent and must be added explicitly.
- Index := Position_Of_Nul (Into => Chars);
- Pointer := Memory_Alloc ((Index - Chars'First + 1));
+ Position_Of_Nul (Into => Chars, Found => Found, Index => Index);
-- If nul is present, transfer string up to and including nul
- if Index <= Chars'Last then
- Update (Item => Pointer,
- Offset => 0,
- Chars => Chars (Chars'First .. Index),
- Check => False);
+ if Found then
+ Pointer := Memory_Alloc (Index - Chars'First + 1);
+
+ Update
+ (Item => Pointer,
+Offset => 0,
+Chars => Chars (Chars'First .. Index),
+Check => False);
else
-- If original string has no nul, transfer whole string and add
-- terminator explicitly.
- Update (Item => Pointer,
- Offset => 0,
- Chars => Chars,
- Check => False);
+ Pointer := Memory_Alloc (Chars'Length + 1);
+
+ Update (Item => Pointer, Offset => 0, Chars => Chars, Check => False);
Poke (nul, Into => Pointer + size_t'(Chars'Length));
end if;
@@ -187,19 +192,19 @@ is
-- Position_Of_Nul --
-
- function Position_Of_Nul (Into : char_array) return size_t is
+ procedure Position_Of_Nul
+ (Into : char_array; Found : out Boolean; Index : out size_t) is
begin
- pragma Annotate (Gnatcheck, Exempt_On, "Improper_Returns",
- "early returns for performance");
+ Found := False;
+ Index := 0;
+
for J in Into'Range loop
if Into (J) = nul then
-return J;
+Found := True;
+Index := J;
+return;
end if;
end loop;
-
- return Into'Last + 1;
-
- pragma Annotate (Gnatcheck, Exempt_Off, "Improper_Returns");
end Position_Of_Nul;
@@ -231,19 +236,22 @@ is
(Item : char_array_access;
Nul_Check : Boolean := False) return chars_ptr
is
+ Found : Boolean;
+ Index : size_t;
begin
pragma Annotate (Gnatcheck, Exempt_On, "Improper_Returns",
"early returns for performance");
if Item = null then
return Null_Ptr;
- elsif Nul_Check
-and then Position_Of_Nul (Into => Item.all) > Item'Last
- then
- raise Terminator_Error;
- else
- return To_chars_ptr (Item (Item'First)'Address);
+ elsif Nul_Check then
+ Position_Of_Nul (Item.all, Found, Index);
+ if not Found then
+raise Terminator_Error;
+ end if;
end if;
+ return To_chars_ptr (Item (Item'First)'Address);
+
pragma Annotate (Gnatcheck, Exempt_Off, "Improper_Returns");
end To_Chars_Ptr;
[gcc r16-1132] ada: Spurious accessibility error with -gnatc
https://gcc.gnu.org/g:b56a782224d90205710311a3623769a5d8befe28 commit r16-1132-gb56a782224d90205710311a3623769a5d8befe28 Author: squirek Date: Tue Jan 14 06:40:08 2025 + ada: Spurious accessibility error with -gnatc The patch fixes an issue in the compiler whereby a spurious accessibility error gets generated in semantic checking mode (-gnatc) when an explicitly aliased formal gets used as an actual for an access disriminant in a return object. gcc/ada/ChangeLog: * accessibility.adb (Check_Return_Construct_Accessibility): Disable check generation when we are only checking semantics. Diff: --- gcc/ada/accessibility.adb | 7 +++ 1 file changed, 7 insertions(+) diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb index 8c85173aa34c..200f892a96f0 100644 --- a/gcc/ada/accessibility.adb +++ b/gcc/ada/accessibility.adb @@ -1642,6 +1642,13 @@ package body Accessibility is (No (Extra_Accessibility_Of_Result (Scope_Id)) and then Is_Formal_Of_Current_Function (Assoc_Expr) and then Is_Tagged_Type (Etype (Scope_Id))) + + -- Disable the check generation when we are only checking semantics + -- since required locals do not get generated (e.g. extra + -- accessibility of result), and constant folding can occur and + -- lead to spurious errors. + + and then Operating_Mode /= Check_Semantics then -- Generate a dynamic check based on the extra accessibility of -- the result or the scope of the current function.
[gcc r16-1140] ada: Fix couple of remaining incompatibilities with CHERI architecture
https://gcc.gnu.org/g:9a6162488992afca390e01d4c1ba9264fd10eab8 commit r16-1140-g9a6162488992afca390e01d4c1ba9264fd10eab8 Author: Eric Botcazou Date: Thu Jan 16 15:51:00 2025 +0100 ada: Fix couple of remaining incompatibilities with CHERI architecture These are the usual problematic patterns in the expanded code. gcc/ada/ChangeLog: * exp_ch9.adb (Build_Dispatching_Requeue): Take 'Tag of the concurrent object instead of doing an unchecked conversion. * exp_pakd.adb (Expand_Packed_Address_Reference): Perform address arithmetic using an operator of System.Storage_Elements. Diff: --- gcc/ada/exp_ch9.adb | 6 -- gcc/ada/exp_pakd.adb | 31 +-- 2 files changed, 21 insertions(+), 16 deletions(-) diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index d75fd3a68256..dd59af970f56 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -9877,7 +9877,7 @@ package body Exp_Ch9 is -- (T=> To_Tag_Ptr (Obj'Address).all, -- Position => -- Ada.Tags.Get_Offset_Index - -- (Ada.Tags.Tag (Concval), + -- (Concval._Tag, --)); -- Note that Obj'Address is recursively expanded into a call to @@ -9898,7 +9898,9 @@ package body Exp_Ch9 is Make_Function_Call (Loc, Name => New_Occurrence_Of (RTE (RE_Get_Offset_Index), Loc), Parameter_Associations => New_List ( - Unchecked_Convert_To (RTE (RE_Tag), Concval), + Make_Attribute_Reference (Loc, +Prefix => Concval, +Attribute_Name => Name_Tag), Make_Integer_Literal (Loc, DT_Position (Entity (Ename; diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index 26ef065b529b..f04016fa8117 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -1526,21 +1526,24 @@ package body Exp_Pakd is Get_Base_And_Bit_Offset (Prefix (N), Base, Offset); + Offset := Unchecked_Convert_To (RTE (RE_Storage_Offset), Offset); + Rewrite (N, -Unchecked_Convert_To (RTE (RE_Address), - Make_Op_Add (Loc, -Left_Opnd => - Unchecked_Convert_To (RTE (RE_Integer_Address), -Make_Attribute_Reference (Loc, - Prefix => Base, - Attribute_Name => Name_Address)), - -Right_Opnd => - Unchecked_Convert_To (RTE (RE_Integer_Address), -Make_Op_Divide (Loc, - Left_Opnd => Offset, - Right_Opnd => -Make_Integer_Literal (Loc, System_Storage_Unit)); +Make_Function_Call (Loc, + Name => +Make_Expanded_Name (Loc, + Chars => Name_Op_Add, + Prefix=> +New_Occurrence_Of (RTU_Entity (System_Storage_Elements), Loc), + Selector_Name => Make_Identifier (Loc, Name_Op_Add)), + Parameter_Associations => New_List ( +Make_Attribute_Reference (Loc, + Prefix => Base, + Attribute_Name => Name_Address), +Make_Op_Divide (Loc, + Left_Opnd => Offset, + Right_Opnd => +Make_Integer_Literal (Loc, System_Storage_Unit); Analyze_And_Resolve (N, RTE (RE_Address)); end Expand_Packed_Address_Reference;
[gcc r16-1133] ada: Cleanup preanalysis of static expressions (part 6)
https://gcc.gnu.org/g:3c95e0e8938e26298534eceb70a3ffb7b56c413e commit r16-1133-g3c95e0e8938e26298534eceb70a3ffb7b56c413e Author: Javier Miranda Date: Tue Jan 14 11:08:57 2025 + ada: Cleanup preanalysis of static expressions (part 6) Rename Preanalyze_Spec_Expression as Preanalyze_And_Resolve_Spec_Expression, Preanalyze_Assert_Expression as Preanalyze_And_Resolve_Assert_Expression, and Preanalyze_Default_Expression as Preanalyze_And_Resolve_Default_Expression; cleanup the version of Preanalyze_Assert_Expression without context type. gcc/ada/ChangeLog: * sem.ads: Update reference to renamed subprogram in documentation. * sem_ch3.ads (Preanalyze_Assert_Expression): Renamed. (Preanalyze_Spec_Expression): Renamed. * sem_ch3.adb (Preanalyze_Assert_Expression): Renamed and code cleanup. (Preanalyze_Spec_Expression): Renamed. (Preanalyze_Default_Expression): Renamed. * contracts.adb: Update calls to renamed subprograms. * exp_pakd.adb: Ditto. * exp_util.adb: Ditto. * freeze.adb: Ditto. * sem_ch12.adb: Ditto. * sem_ch13.adb: Ditto. * sem_ch6.adb: Ditto. * sem_prag.adb: Ditto. * sem_res.adb (Preanalyze_And_Resolve): Add to the version without context type the special handling for GNATprove mode provided by the version with context type; required to cleanup the body of Preanalyze_Assert_Expression. Diff: --- gcc/ada/contracts.adb | 2 +- gcc/ada/exp_pakd.adb | 3 +- gcc/ada/exp_util.adb | 12 +++ gcc/ada/freeze.adb| 9 ++--- gcc/ada/sem.ads | 12 +++ gcc/ada/sem_ch12.adb | 4 +-- gcc/ada/sem_ch13.adb | 38 ++-- gcc/ada/sem_ch3.adb | 99 +++ gcc/ada/sem_ch3.ads | 17 ++--- gcc/ada/sem_ch6.adb | 12 +++ gcc/ada/sem_prag.adb | 60 ++- gcc/ada/sem_res.adb | 11 +++--- 12 files changed, 155 insertions(+), 124 deletions(-) diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb index 8b94a67639f2..c0a57e6d0bae 100644 --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -4909,7 +4909,7 @@ package body Contracts is Install_Formals (Subp); Inside_Class_Condition_Preanalysis := True; - Preanalyze_Spec_Expression (Expr, Standard_Boolean); + Preanalyze_And_Resolve_Spec_Expression (Expr, Standard_Boolean); Inside_Class_Condition_Preanalysis := False; End_Scope; diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index 4eb93c3192a6..26ef065b529b 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -904,7 +904,8 @@ package body Exp_Pakd is -- discriminants, so we treat it as a default/per-object expression. Set_Parent (Len_Expr, Typ); - Preanalyze_Spec_Expression (Len_Expr, Standard_Long_Long_Integer); + Preanalyze_And_Resolve_Spec_Expression + (Len_Expr, Standard_Long_Long_Integer); -- Use a modular type if possible. We can do this if we have -- static bounds, and the length is small enough, and the length diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index b8c6a9f8848b..513662af383a 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -1956,7 +1956,7 @@ package body Exp_Util is -- time capture the visibility of the proper package part. Set_Parent (Expr, Typ_Decl); - Preanalyze_Assert_Expression (Expr, Any_Boolean); + Preanalyze_And_Resolve_Assert_Expression (Expr, Any_Boolean); -- Save a copy of the expression with all replacements and analysis -- already taken place in case a derived type inherits the pragma. @@ -1969,8 +1969,8 @@ package body Exp_Util is -- If the pragma comes from an aspect specification, replace the -- saved expression because all type references must be substituted - -- for the call to Preanalyze_Spec_Expression in Check_Aspect_At_xxx - -- routines. + -- for the call to Preanalyze_And_Resolve_Spec_Expression in + -- Check_Aspect_At_xxx routines. if Present (DIC_Asp) then Set_Expression_Copy (DIC_Asp, New_Copy_Tree (Expr)); @@ -3217,7 +3217,7 @@ package body Exp_Util is -- part. Set_Parent (Expr, Parent (Prag_Expr)); - Preanalyze_Assert_Expression (Expr, Any_Boolean); + Preanalyze_And_Resolve_Assert_Expression (Expr, Any_Boolean); -- Save a copy of the expression when T is tagged to detect -- errors and capture the visibility of the proper package part @@ -3229,8 +3229,8 @@ package body Exp_Util is -- If the pragma comes from an aspect specification, replace -- the saved expre
[gcc r16-1150] ada: Fix reproducer generation
https://gcc.gnu.org/g:df0d3b2491c5ee7859762c4b677b17b3dede3dc5 commit r16-1150-gdf0d3b2491c5ee7859762c4b677b17b3dede3dc5 Author: Ronan Desplanques Date: Mon Jan 20 16:14:21 2025 +0100 ada: Fix reproducer generation This patch fixes reproducer generation in the case of crashes in the back end in the presence of preprocessing dependencies. gcc/ada/ChangeLog: * generate_minimal_reproducer.adb (Generate_Minimal_Reproducer): Fix handling of preprocessing dependencies. Diff: --- gcc/ada/generate_minimal_reproducer.adb | 50 + 1 file changed, 26 insertions(+), 24 deletions(-) diff --git a/gcc/ada/generate_minimal_reproducer.adb b/gcc/ada/generate_minimal_reproducer.adb index 2378f60c4729..5a5ae16193e5 100644 --- a/gcc/ada/generate_minimal_reproducer.adb +++ b/gcc/ada/generate_minimal_reproducer.adb @@ -140,28 +140,30 @@ begin end if; for J in Main_Unit .. Lib.Last_Unit loop - declare -Path : File_Name_Type := - Fmap.Mapped_Path_Name (Lib.Unit_File_Name (J)); - -Unit_Name : constant Unit_Name_Type := - (if J = Main_Unit then Main_Unit_Name else Lib.Unit_Name (J)); - -Default_File_Name : constant String := - Fname.UF.Get_Default_File_Name (Unit_Name); - -File_Copy_Path : constant String := - Src_Dir_Path & Directory_Separator & Default_File_Name; - --- We may have synthesized units for child subprograms without --- spec files. We need to filter out those units because we would --- create bogus spec files that break compilation if we didn't. -Is_Synthetic_Subprogram_Spec : constant Boolean := - not Comes_From_Source (Lib.Cunit (J)); - begin -if not Lib.Is_Internal_Unit (J) - and then not Is_Synthetic_Subprogram_Spec -then + -- We skip library units that fall under one of the following cases: + -- - Internal library units. + -- - Units that were synthesized for child subprograms without spec + --files. + -- - Dummy entries that Add_Preprocessing_Dependency puts in + --Lib.Units. + -- Those cases correspond to the conjuncts in the condition below. + if not Lib.Is_Internal_Unit (J) + and then Comes_From_Source (Lib.Cunit (J)) + and then Lib.Unit_Name (J) /= No_Unit_Name + then +declare + Path : File_Name_Type := + Fmap.Mapped_Path_Name (Lib.Unit_File_Name (J)); + + Unit_Name : constant Unit_Name_Type := + (if J = Main_Unit then Main_Unit_Name else Lib.Unit_Name (J)); + + Default_File_Name : constant String := + Fname.UF.Get_Default_File_Name (Unit_Name); + + File_Copy_Path : constant String := + Src_Dir_Path & Directory_Separator & Default_File_Name; +begin -- Mapped_Path_Name might have returned No_File. This has been -- observed for files with a Source_File_Name pragma. if Path = No_File then @@ -178,8 +180,8 @@ begin pragma Assert (Success); end; -end if; - end; +end; + end if; end loop; end Create_Semantic_Closure_Project;
[gcc r16-1142] ada: Spurious accessibility error with -gnatc
https://gcc.gnu.org/g:c328b54f15d81b021bb3ae3084f49b61cd52b1d3
commit r16-1142-gc328b54f15d81b021bb3ae3084f49b61cd52b1d3
Author: squirek
Date: Thu Jan 16 17:09:49 2025 +
ada: Spurious accessibility error with -gnatc
The patch fixes an issue in the compiler whereby a spurious accessibility
error gets generated in semantic checking mode (-gnatc) when an explicitly
aliased formal gets used as an actual for an access disriminant in a return
object.
gcc/ada/ChangeLog:
* accessibility.adb (Check_Return_Construct_Accessibility):
Disable check generation when we are only checking semantics.
* opt.ads: Add new flag for -gnatc mode
* switch-c.adb (Scan_Front_End_Switches): Set flag for -gnatc mode
Diff:
---
gcc/ada/accessibility.adb | 6 +++---
gcc/ada/opt.ads | 4
gcc/ada/switch-c.adb | 1 +
3 files changed, 8 insertions(+), 3 deletions(-)
diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb
index 200f892a96f0..0b8d3f7746d7 100644
--- a/gcc/ada/accessibility.adb
+++ b/gcc/ada/accessibility.adb
@@ -1648,7 +1648,7 @@ package body Accessibility is
-- accessibility of result), and constant folding can occur and
-- lead to spurious errors.
- and then Operating_Mode /= Check_Semantics
+ and then not Check_Semantics_Only_Mode
then
-- Generate a dynamic check based on the extra accessibility of
-- the result or the scope of the current function.
@@ -1691,8 +1691,8 @@ package body Accessibility is
and then Entity (Check_Cond) = Standard_True
then
Error_Msg_N
- ("access discriminant in return object would be a dangling"
- & " reference", Return_Stmt);
+ ("access discriminant in return object could be a dangling"
+ & " reference??", Return_Stmt);
end if;
end if;
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 687d1ed8836a..87ce3a1d4639 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -308,6 +308,10 @@ package Opt is
-- GNATMAKE
-- Set to True to check readonly files during the make process
+ Check_Semantics_Only_Mode : Boolean := False;
+ -- GNATMAKE
+ -- Set to True when -gnatc is present to only perform semantic checking.
+
Check_Source_Files : Boolean := True;
-- GNATBIND, GNATMAKE
-- Set to True to enable consistency checking for any source files that
diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb
index 6344a0b3a3cf..1e54340d5202 100644
--- a/gcc/ada/switch-c.adb
+++ b/gcc/ada/switch-c.adb
@@ -335,6 +335,7 @@ package body Switch.C is
end if;
Ptr := Ptr + 1;
+ Check_Semantics_Only_Mode := True;
Operating_Mode := Check_Semantics;
-- -gnatC (Generate CodePeer information)
[gcc r16-1143] ada: Extend and clarify documentation of stack size settings for Windows
https://gcc.gnu.org/g:59772414183d2df27efbd7bff7aaabba19e32309
commit r16-1143-g59772414183d2df27efbd7bff7aaabba19e32309
Author: Piotr Trojanek
Date: Thu Jan 16 17:41:56 2025 +0100
ada: Extend and clarify documentation of stack size settings for Windows
The original documentation for more recent versions of Windows didn't
specify
whether the specified stack size acts as a "reserved" or "committed" stack
size.
Also, clarify the wording for older versions of Windows.
gcc/ada/ChangeLog:
* doc/gnat_ugn/platform_specific_information.rst
(Setting Stack Size from gnatlink): Improve documentation.
* gnat-style.texi: Regenerate.
* gnat_rm.texi: Regenerate.
* gnat_ugn.texi: Regenerate.
Diff:
---
gcc/ada/doc/gnat_ugn/platform_specific_information.rst | 7 ---
gcc/ada/gnat-style.texi| 4 ++--
gcc/ada/gnat_rm.texi | 14 +++---
gcc/ada/gnat_ugn.texi | 13 +++--
4 files changed, 20 insertions(+), 18 deletions(-)
diff --git a/gcc/ada/doc/gnat_ugn/platform_specific_information.rst
b/gcc/ada/doc/gnat_ugn/platform_specific_information.rst
index f2fc737f90d2..6493a065960d 100644
--- a/gcc/ada/doc/gnat_ugn/platform_specific_information.rst
+++ b/gcc/ada/doc/gnat_ugn/platform_specific_information.rst
@@ -2212,11 +2212,12 @@ Setting Stack Size from ``gnatlink``
You can specify the program stack size at link time. On most versions
of Windows, starting with XP, this is mostly useful to set the size of
the main stack (environment task). The other task stacks are set with
-pragma Storage_Size or with the *gnatbind -d* command.
+pragma Storage_Size or with the *gnatbind -d* command. The specified size will
+become the reserved memory size of the underlying thread.
Since very old versions of Windows (2000, NT4, etc.) don't allow setting the
-reserve size of individual tasks, the link-time stack size applies to all
-tasks, and pragma Storage_Size has no effect.
+reserve size of individual tasks, for those versions the link-time stack size
+applies to all tasks, and pragma Storage_Size has no effect.
In particular, Stack Overflow checks are made against this
link-time specified size.
diff --git a/gcc/ada/gnat-style.texi b/gcc/ada/gnat-style.texi
index dde6ec4a6e7d..0880400bd28a 100644
--- a/gcc/ada/gnat-style.texi
+++ b/gcc/ada/gnat-style.texi
@@ -3,7 +3,7 @@
@setfilename gnat-style.info
@documentencoding UTF-8
@ifinfo
-@*Generated by Sphinx 8.0.2.@*
+@*Generated by Sphinx 8.2.3.@*
@end ifinfo
@settitle GNAT Coding Style A Guide for GNAT Developers
@defindex ge
@@ -19,7 +19,7 @@
@copying
@quotation
-GNAT Coding Style: A Guide for GNAT Developers , Jan 03, 2025
+GNAT Coding Style: A Guide for GNAT Developers , Jun 02, 2025
AdaCore
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 97469d739520..00236ee6c5ca 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -3,7 +3,7 @@
@setfilename gnat_rm.info
@documentencoding UTF-8
@ifinfo
-@*Generated by Sphinx 8.0.2.@*
+@*Generated by Sphinx 8.2.3.@*
@end ifinfo
@settitle GNAT Reference Manual
@defindex ge
@@ -19,7 +19,7 @@
@copying
@quotation
-GNAT Reference Manual , Jan 03, 2025
+GNAT Reference Manual , Jun 02, 2025
AdaCore
@@ -4682,8 +4682,8 @@ pragma Interrupt_State
Normally certain interrupts are reserved to the implementation. Any attempt
to attach an interrupt causes Program_Error to be raised, as described in
RM C.3.2(22). A typical example is the @code{SIGINT} interrupt used in
-many systems for an @code{Ctrl-C} interrupt. Normally this interrupt is
-reserved to the implementation, so that @code{Ctrl-C} can be used to
+many systems for an @code{Ctrl}-@code{C} interrupt. Normally this interrupt is
+reserved to the implementation, so that @code{Ctrl}-@code{C} can be used to
interrupt execution. Additionally, signals such as @code{SIGSEGV},
@code{SIGABRT}, @code{SIGFPE} and @code{SIGILL} are often mapped to specific
Ada exceptions, or used to implement run-time functions such as the
@@ -8837,15 +8837,15 @@ pragma Unreserve_All_Interrupts;
Normally certain interrupts are reserved to the implementation. Any attempt
to attach an interrupt causes Program_Error to be raised, as described in
RM C.3.2(22). A typical example is the @code{SIGINT} interrupt used in
-many systems for a @code{Ctrl-C} interrupt. Normally this interrupt is
-reserved to the implementation, so that @code{Ctrl-C} can be used to
+many systems for a @code{Ctrl}-@code{C} interrupt. Normally this interrupt is
+reserved to the implementation, so that @code{Ctrl}-@code{C} can be used to
interrupt execution.
If the pragma @code{Unreserve_All_Interrupts} appears anywhere in any unit in
a program, then all such interrupts are unreserved. This allows the
program to handle these interrupts, but disables their standard
[gcc r16-1129] ada: Compiler crash on array aggregate association iterating over function result
https://gcc.gnu.org/g:1869441107b42ab00e8ea3d69c496dfb1cb9aecd commit r16-1129-g1869441107b42ab00e8ea3d69c496dfb1cb9aecd Author: Gary Dismukes Date: Fri Jan 10 22:39:52 2025 + ada: Compiler crash on array aggregate association iterating over function result The compiler triggers a bug box when compiling an array aggregate with an iterated_component_association that iterates over another array object, failing when trying to retrieve a Choices field, which isn't an allowed field for N_Iterated_Component_Association nodes. This occurs in procedure Check_Function_Writable_Actuals, which wasn't accounting for the iterated association forms. gcc/ada/ChangeLog: * sem_util.adb (Check_Function_Writable_Actuals): Add handling for N_Iterated_Component_Association and N_Iterated_Element_Association. Fix a typo in an RM reference (6.4.1(20/3) => 6.4.1(6.20/3)). (Collect_Expression_Ids): New procedure factoring code for collecting identifiers from expressions of aggregate associations. (Handle_Association_Choices): New procedure factoring code for handling id collection for expressions of aggregate associations with multiple choices. Removed redundant test of Box_Present from original code. Diff: --- gcc/ada/sem_util.adb | 115 ++- 1 file changed, 86 insertions(+), 29 deletions(-) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 0e1505bbdbe6..5f9f2755c949 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -3025,7 +3025,7 @@ package body Sem_Util is -- For an array aggregate, a discrete_choice_list that has -- a nonstatic range is considered as two or more separate - -- occurrences of the expression (RM 6.4.1(20/3)). + -- occurrences of the expression (RM 6.4.1(6.20/3)). elsif Is_Array_Type (Etype (N)) and then Nkind (N) = N_Aggregate @@ -3110,48 +3110,105 @@ package body Sem_Util is end loop; end if; - -- Handle discrete associations + -- Handle named associations if Present (Component_Associations (N)) then Assoc := First (Component_Associations (N)); while Present (Assoc) loop - if not Box_Present (Assoc) then -Choice := First (Choices (Assoc)); -while Present (Choice) loop + Handle_Association : declare - -- For now we skip discriminants since it requires - -- performing the analysis in two phases: first one - -- analyzing discriminants and second one analyzing - -- the rest of components since discriminants are - -- evaluated prior to components: too much extra - -- work to detect a corner case??? +procedure Collect_Expression_Ids (Expr : Node_Id); +-- Collect identifiers in association expression Expr - if Nkind (Choice) in N_Has_Entity - and then Present (Entity (Choice)) - and then Ekind (Entity (Choice)) = E_Discriminant - then - null; +procedure Handle_Association_Choices + (Choices : List_Id; Expr : Node_Id); +-- Collect identifiers in an association expression +-- Expr for each choice in Choices. - elsif Box_Present (Assoc) then - null; + +-- Collect_Expression_Ids -- + +procedure Collect_Expression_Ids (Expr : Node_Id) is + Comp_Expr : Node_Id; + +begin + if not Analyzed (Expr) then + Comp_Expr := New_Copy_Tree (Expr); + Set_Parent (Comp_Expr, Parent (N)); + Preanalyze_Without_Errors (Comp_Expr); else - if not Analyzed (Expression (Assoc)) then - Comp_Expr := - New_Copy_Tree (Expression (Assoc)); - Set_Parent (Comp_Expr, Parent (N)); - Preanalyze_Without_Errors (Comp_Expr); + Comp_Expr := Expr; + end if; + +
[gcc r16-1136] ada: Fix Generate_Minimal_Reproducer on instantiations
https://gcc.gnu.org/g:2f65e9eaafbc5aec42fbb3bf0a01c1a930e8ac9e
commit r16-1136-g2f65e9eaafbc5aec42fbb3bf0a01c1a930e8ac9e
Author: Ronan Desplanques
Date: Wed Jan 15 09:54:45 2025 +0100
ada: Fix Generate_Minimal_Reproducer on instantiations
Before this patch, the code that creates a copy of the semantic closure
with the default naming convention was incorrect when the compiler was
processing a library unit that was an instantiation of a generic with a
body. This patch adds code to detect that situation and adjusts the
copying process accordingly.
gcc/ada/ChangeLog:
* generate_minimal_reproducer.adb (Generate_Minimal_Reproducer):
Fix when main library item is an instantiation.
Diff:
---
gcc/ada/generate_minimal_reproducer.adb | 41 ++---
1 file changed, 33 insertions(+), 8 deletions(-)
diff --git a/gcc/ada/generate_minimal_reproducer.adb
b/gcc/ada/generate_minimal_reproducer.adb
index 66d34fe1a4f3..d13709af6bba 100644
--- a/gcc/ada/generate_minimal_reproducer.adb
+++ b/gcc/ada/generate_minimal_reproducer.adb
@@ -23,16 +23,18 @@
-- --
--
+with Atree;
with Fmap;
with Fname.UF;
with Lib;
-with Namet; use Namet;
-with Osint; use Osint;
-with Output; use Output;
-with Sinfo.Nodes;
+with Namet; use Namet;
+with Osint; use Osint;
+with Output;use Output;
+with Sinfo.Nodes; use Sinfo.Nodes;
with System.CRTL;
with System.OS_Lib; use System.OS_Lib;
-with Types; use Types;
+with Types; use Types;
+with Uname;
procedure Generate_Minimal_Reproducer is
Reproducer_Generation_Failed : exception;
@@ -85,6 +87,26 @@ procedure Generate_Minimal_Reproducer is
Oracle_Path : constant String :=
Dirname & Directory_Separator & Executable_Name ("oracle");
+ Main_Library_Item : constant Node_Id := Unit (Lib.Cunit (Main_Unit));
+
+ -- There is a special case that we need to detect: when the main library
+ -- item is the instantiation of a generic that has a body, and the
+ -- instantiation of generic bodies has started. We start by binding whether
+ -- the main library item is an instantiation to the following constant.
+ Main_Is_Instantiation : constant Boolean :=
+ Nkind (Atree.Original_Node (Main_Library_Item))
+ in N_Generic_Instantiation;
+
+ -- If the main library item is an instantiation and its unit name is a body
+ -- name, it means that Make_Instance_Unit has been called. We need to use
+ -- the corresponding spec name to reconstruct the on-disk form of the
+ -- semantic closure.
+ Main_Unit_Name : constant Unit_Name_Type :=
+ (if Main_Is_Instantiation
+and then Uname.Is_Body_Name (Lib.Unit_Name (Main_Unit))
+ then Uname.Get_Spec_Name (Lib.Unit_Name (Main_Unit))
+ else Lib.Unit_Name (Main_Unit));
+
Result : Integer;
begin
Create_Semantic_Closure_Project :
@@ -122,8 +144,11 @@ begin
Path : File_Name_Type :=
Fmap.Mapped_Path_Name (Lib.Unit_File_Name (J));
+Unit_Name : constant Unit_Name_Type :=
+ (if J = Main_Unit then Main_Unit_Name else Lib.Unit_Name (J));
+
Default_File_Name : constant String :=
- Fname.UF.Get_Default_File_Name (Lib.Unit_Name (J));
+ Fname.UF.Get_Default_File_Name (Unit_Name);
File_Copy_Path : constant String :=
Src_Dir_Path & Directory_Separator & Default_File_Name;
@@ -132,7 +157,7 @@ begin
-- spec files. We need to filter out those units because we would
-- create bogus spec files that break compilation if we didn't.
Is_Synthetic_Subprogram_Spec : constant Boolean :=
- not Sinfo.Nodes.Comes_From_Source (Lib.Cunit (J));
+ not Comes_From_Source (Lib.Cunit (J));
begin
if not Lib.Is_Internal_Unit (J)
and then not Is_Synthetic_Subprogram_Spec
@@ -197,7 +222,7 @@ begin
(Fmap.Mapped_Path_Name (Lib.Unit_File_Name (Main_Unit)));
Default_Main_Name : constant String :=
- Fname.UF.Get_Default_File_Name (Lib.Unit_Name (Main_Unit));
+ Fname.UF.Get_Default_File_Name (Main_Unit_Name);
New_Main_Path : constant String :=
Src_Dir_Path & Directory_Separator & Default_Main_Name;
[gcc r16-1137] ada: Fix adareducer oracle generation
https://gcc.gnu.org/g:f606f2417b33d88f70b735c1f94f52de5d121ae7
commit r16-1137-gf606f2417b33d88f70b735c1f94f52de5d121ae7
Author: Ronan Desplanques
Date: Wed Jan 15 09:57:10 2025 +0100
ada: Fix adareducer oracle generation
This patch adds a missing "-quiet" switch to the compiler invocations
performed by generated oracles. Without that switch, log lines could be
present before bug boxes for crashes in gigi and that caused the crash
detection logic to fail.
gcc/ada/ChangeLog:
* generate_minimal_reproducer.adb (Generate_Minimal_Reproducer): Fix
oracle generation.
Diff:
---
gcc/ada/generate_minimal_reproducer.adb | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/gcc/ada/generate_minimal_reproducer.adb
b/gcc/ada/generate_minimal_reproducer.adb
index d13709af6bba..2378f60c4729 100644
--- a/gcc/ada/generate_minimal_reproducer.adb
+++ b/gcc/ada/generate_minimal_reproducer.adb
@@ -253,7 +253,8 @@ begin
Write_Eol;
Write_Line (" Args : constant GNAT.OS_Lib.Argument_List :=");
- Write_Str (" (new String'(""-gnatd_M"")");
+ Write_Str
+ (" (new String'(""-quiet""), new String'(""-gnatd_M"")");
-- The following way of iterating through the command line arguments
-- was copied from Set_Targ. TODO factorize???
[gcc r16-1139] ada: Fix buffer overflow for function call returning discriminated limited record
https://gcc.gnu.org/g:484795c24b2f4629db8b91e37656c0e6bd514156 commit r16-1139-g484795c24b2f4629db8b91e37656c0e6bd514156 Author: Eric Botcazou Date: Wed Jan 15 20:37:48 2025 +0100 ada: Fix buffer overflow for function call returning discriminated limited record This occurs when the discriminated limited record type is declared with default values for its discriminants, is not controlled, and the context of the call is anonymous, i.e. the result of the call is not assigned to an object. In this case, a temporary is created to hold the result of the call, with the default values of the discriminants, but the result may have different values for the discriminants and, in particular, may be larger than the temporary, which leads to a buffer overflow. This problem does not occur when the context is an object declaration, so the fix just makes sure that the expansion in an anonymous context always uses the model of an object declaration. It requires a minor tweak to the helper function Entity_Of of the Sem_Util package. gcc/ada/ChangeLog: * exp_ch6.adb (Expand_Actuals): Remove obsolete comment. (Make_Build_In_Place_Call_In_Anonymous_Context): Always use a proper object declaration initialized with the function call in the cases where a temporary is needed, with Assignment_OK set on it. * sem_util.adb (Entity_Of): Deal with rewritten function call first. Diff: --- gcc/ada/exp_ch6.adb | 100 +-- gcc/ada/sem_util.adb | 18 +- 2 files changed, 33 insertions(+), 85 deletions(-) diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 7e464541be25..d5667b423deb 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -2470,11 +2470,6 @@ package body Exp_Ch6 is -- (and ensure that we have an activation chain defined for tasks -- and a Master variable). --- Currently we limit such functions to those with inherently --- limited result subtypes, but eventually we plan to expand the --- functions that are treated as build-in-place to include other --- composite result types. - -- But do not do it here for intrinsic subprograms since this will -- be done properly after the subprogram is expanded. @@ -8562,12 +8557,10 @@ package body Exp_Ch6 is procedure Make_Build_In_Place_Call_In_Anonymous_Context (Function_Call : Node_Id) is - Loc : constant Source_Ptr := Sloc (Function_Call); - Func_Call : constant Node_Id := Unqual_Conv (Function_Call); - Function_Id : Entity_Id; - Result_Subt : Entity_Id; - Return_Obj_Id : Entity_Id; - Return_Obj_Decl : Entity_Id; + Loc : constant Source_Ptr := Sloc (Function_Call); + Func_Call : constant Node_Id:= Unqual_Conv (Function_Call); + Function_Id : Entity_Id; + Result_Subt : Entity_Id; begin -- If the call has already been processed to add build-in-place actuals @@ -8580,10 +8573,6 @@ package body Exp_Ch6 is return; end if; - -- Mark the call as processed as a build-in-place call - - Set_Is_Expanded_Build_In_Place_Call (Func_Call); - if Is_Entity_Name (Name (Func_Call)) then Function_Id := Entity (Name (Func_Call)); @@ -8601,8 +8590,13 @@ package body Exp_Ch6 is -- If the build-in-place function returns a controlled object, then the -- object needs to be finalized immediately after the context. Since -- this case produces a transient scope, the servicing finalizer needs - -- to name the returned object. Create a temporary which is initialized - -- with the function call: + -- to name the returned object. + + -- If the build-in-place function returns a definite subtype, then an + -- object also needs to be created and an access value designating it + -- passed as an actual. + + -- Create a temporary which is initialized with the function call: -- --Temp_Id : Func_Type := BIP_Func_Call; -- @@ -8610,75 +8604,25 @@ package body Exp_Ch6 is -- the expander using the appropriate mechanism in Make_Build_In_Place_ -- Call_In_Object_Declaration. - if Needs_Finalization (Result_Subt) then + if Needs_Finalization (Result_Subt) +or else Caller_Known_Size (Func_Call, Result_Subt) + then declare Temp_Id : constant Entity_Id := Make_Temporary (Loc, 'R'); -Temp_Decl : Node_Id; - - begin --- Reset the guard on the function call since the following does --- not perform actual call expansion. - -Set_Is_Expanded_Build_In_Place_Call (Func_Call, False); - -Temp_Decl := +Temp_Decl : constant Node_Id
[gcc r16-1145] ada: Fix unnecessarily large allocation in New_String
https://gcc.gnu.org/g:d8610fb01b7a380acdd5872f4eb080599643f903 commit r16-1145-gd8610fb01b7a380acdd5872f4eb080599643f903 Author: Ronan Desplanques Date: Mon Jan 20 13:37:08 2025 +0100 ada: Fix unnecessarily large allocation in New_String This patches fixes an issue where Interfaces.C.Strings.New_String allocates more memory than necessary when passed a string that contains a NUL character. gcc/ada/ChangeLog: * libgnat/i-cstrin.adb (New_String): Fix size of allocation. Diff: --- gcc/ada/libgnat/i-cstrin.adb | 35 --- 1 file changed, 24 insertions(+), 11 deletions(-) diff --git a/gcc/ada/libgnat/i-cstrin.adb b/gcc/ada/libgnat/i-cstrin.adb index 6d329254aff3..974ba3a0e8ca 100644 --- a/gcc/ada/libgnat/i-cstrin.adb +++ b/gcc/ada/libgnat/i-cstrin.adb @@ -153,20 +153,33 @@ is -- the result, and doesn't copy the string on the stack, otherwise its -- use is limited when used from tasks on large strings. - Result : constant chars_ptr := Memory_Alloc (Str'Length + 1); + Len : Natural := 0; + -- Length of the longest prefix of Str that doesn't contain NUL - Result_Array : char_array (1 .. Str'Length + 1); - for Result_Array'Address use To_Address (Result); - pragma Import (Ada, Result_Array); + Result : chars_ptr; + begin + for C of Str loop + if C = ASCII.NUL then +exit; + end if; + Len := Len + 1; + end loop; - Count : size_t; + Result := Memory_Alloc (size_t (Len) + 1); + + declare + Result_Array : char_array (1 .. size_t (Len) + 1) + with Address => To_Address (Result), Import, Convention => Ada; + + Count : size_t; + begin + To_C + (Item => Str (Str'First .. Str'First + Len - 1), +Target => Result_Array, +Count => Count, +Append_Nul => True); + end; - begin - To_C -(Item => Str, - Target => Result_Array, - Count => Count, - Append_Nul => True); return Result; end New_String;
[gcc r16-1135] ada: Fix compile-time failure due to duplicated attribute subprograms.
https://gcc.gnu.org/g:755f3d9ba29953f2bee6e46644a5233b31ea2f4f commit r16-1135-g755f3d9ba29953f2bee6e46644a5233b31ea2f4f Author: Steve Baird Date: Mon Jan 13 14:18:26 2025 -0800 ada: Fix compile-time failure due to duplicated attribute subprograms. For a given type, and for certain attributes (the 4 streaming attributes and, for Ada2022, the Put_Image attribute), the compiler needs to keep track of whether a subprogram has already been generated for the given type/attribute pair. In some cases this was being done incorrectly; the compiler ended up generating duplicate subprograms (with the same name), resulting in compilation failures. This could occur if the prefix of an attribute reference denoted a subtype (more precisely, a non-first subtype). This includes the case of a subtype declaration that is implicitly introduced by the compiler to capture the binding between a formal type in a generic and the corresponding actual type in an instantiation. gcc/ada/ChangeLog: * exp_attr.adb (Expand_N_Attribute_Reference): When accessing the maps declared in package Cached_Attribute_Ops, the key value passed to Get or to Set should never be the entity node for a subtype. Use the entity of the corresponding type declaration instead. Diff: --- gcc/ada/exp_attr.adb | 39 --- 1 file changed, 24 insertions(+), 15 deletions(-) diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index b896228a70e3..aea9e8ad3afd 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -88,8 +88,10 @@ package body Exp_Attr is function Attribute_Op_Hash (Id : Entity_Id) return Header_Num is (Header_Num (Id mod Map_Size)); - -- Cache used to avoid building duplicate subprograms for a single - -- type/streaming-attribute pair. + -- Caches used to avoid building duplicate subprograms for a single + -- type/attribute pair (where the attribute is either Put_Image or + -- one of the four streaming attributes). The type used as a key in + -- in accessing these maps should not be the entity of a subtype. package Read_Map is new GNAT.HTable.Simple_HTable (Header_Num => Header_Num, @@ -4669,7 +4671,7 @@ package body Exp_Attr is end if; if not Is_Tagged_Type (P_Type) then -Cached_Attribute_Ops.Input_Map.Set (P_Type, Fname); +Cached_Attribute_Ops.Input_Map.Set (U_Type, Fname); end if; end Input; @@ -5750,7 +5752,7 @@ package body Exp_Attr is Rewrite_Attribute_Proc_Call (Pname); if not Is_Tagged_Type (P_Type) then -Cached_Attribute_Ops.Output_Map.Set (P_Type, Pname); +Cached_Attribute_Ops.Output_Map.Set (U_Type, Pname); end if; end Output; @@ -6669,7 +6671,7 @@ package body Exp_Attr is Rewrite_Attribute_Proc_Call (Pname); if not Is_Tagged_Type (P_Type) then -Cached_Attribute_Ops.Read_Map.Set (P_Type, Pname); +Cached_Attribute_Ops.Read_Map.Set (U_Type, Pname); end if; end Read; @@ -8349,7 +8351,7 @@ package body Exp_Attr is Rewrite_Attribute_Proc_Call (Pname); if not Is_Tagged_Type (P_Type) then -Cached_Attribute_Ops.Write_Map.Set (P_Type, Pname); +Cached_Attribute_Ops.Write_Map.Set (U_Type, Pname); end if; end Write; @@ -8951,15 +8953,22 @@ package body Exp_Attr is return Empty; end if; - if Nam = TSS_Stream_Read then - Ent := Cached_Attribute_Ops.Read_Map.Get (Typ); - elsif Nam = TSS_Stream_Write then - Ent := Cached_Attribute_Ops.Write_Map.Get (Typ); - elsif Nam = TSS_Stream_Input then - Ent := Cached_Attribute_Ops.Input_Map.Get (Typ); - elsif Nam = TSS_Stream_Output then - Ent := Cached_Attribute_Ops.Output_Map.Get (Typ); - end if; + declare + function U_Base return Entity_Id is + (Underlying_Type (Base_Type (Typ))); + -- Return the right type node for use in a C_A_O map lookup. + -- In particular, we do not want the entity for a subtype. + begin + if Nam = TSS_Stream_Read then +Ent := Cached_Attribute_Ops.Read_Map.Get (U_Base); + elsif Nam = TSS_Stream_Write then +Ent := Cached_Attribute_Ops.Write_Map.Get (U_Base); + elsif Nam = TSS_Stream_Input then +Ent := Cached_Attribute_Ops.Input_Map.Get (U_Base); + elsif Nam = TSS_Stream_Output then +Ent := Cached_Attribute_Ops.Output_Map.Get (U_Base); + end if; + end; Cached_Attribute_Ops.Validate_Cached_Candidate (Subp => Ent, Attr_Ref => Attr_Ref);
[gcc r16-1134] ada: Mark constants inside a declare expression as referenced
https://gcc.gnu.org/g:453724978e48cc0fb9854cbb961ba2cd96192ba8 commit r16-1134-g453724978e48cc0fb9854cbb961ba2cd96192ba8 Author: Viljar Indus Date: Tue Jan 14 13:31:04 2025 +0200 ada: Mark constants inside a declare expression as referenced Expressions within a declare expression were simply bound to locally defined constants. However they were never marked as referenced. This would trigger an unreferenced constant warning if -gnatwu was used. gcc/ada/ChangeLog: * sem_res.adb (Resolve_Declare_Expression): Mark used local variables inside a declare expression as referenced. Diff: --- gcc/ada/sem_res.adb | 1 + 1 file changed, 1 insertion(+) diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index bbf7bb95ed84..865f967a5b93 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -7806,6 +7806,7 @@ package body Sem_Res is then Set_Entity (N, Local); Set_Etype (N, Etype (Local)); +Generate_Reference (Local, N); end if; return OK;
[gcc r16-1146] ada: Fix various issues in the SARIF report
https://gcc.gnu.org/g:64d277b6b823966fefd2818005de1789de9ca016 commit r16-1146-g64d277b6b823966fefd2818005de1789de9ca016 Author: Viljar Indus Date: Mon Jan 20 20:04:59 2025 +0200 ada: Fix various issues in the SARIF report gcc/ada/ChangeLog: * diagnostics-sarif_emitter.adb (Print_Invocations): fix commandLine and executionSuccessful nodes. Fix typo in the name for startLine. * osint.adb (Modified Get_Current_Dir) Fix generation of the current directory. (Relative_Path): Avoid relative paths starting with a path separator. * osint.ads: Update the documentation for Relative_Path. Diff: --- gcc/ada/diagnostics-sarif_emitter.adb | 7 +-- gcc/ada/osint.adb | 22 ++ gcc/ada/osint.ads | 5 + 3 files changed, 28 insertions(+), 6 deletions(-) diff --git a/gcc/ada/diagnostics-sarif_emitter.adb b/gcc/ada/diagnostics-sarif_emitter.adb index bae2dc0a88e6..d7f923437012 100644 --- a/gcc/ada/diagnostics-sarif_emitter.adb +++ b/gcc/ada/diagnostics-sarif_emitter.adb @@ -66,7 +66,7 @@ package body Diagnostics.SARIF_Emitter is N_RUNS : constant String := "runs"; N_SCHEMA: constant String := "$schema"; N_START_COLUMN : constant String := "startColumn"; - N_START_LINE: constant String := "strartLine"; + N_START_LINE: constant String := "startLine"; N_TEXT : constant String := "text"; N_TOOL : constant String := "tool"; N_URI : constant String := "uri"; @@ -687,6 +687,9 @@ package body Diagnostics.SARIF_Emitter is function Compose_Command_Line return String is Buffer : Bounded_String; begin + Find_Program_Name; + Append (Buffer, Name_Buffer (1 .. Name_Len)); + Append (Buffer, ' '); Append (Buffer, Get_First_Main_File_Name); for I in 1 .. Compilation_Switches_Last loop declare @@ -718,7 +721,7 @@ package body Diagnostics.SARIF_Emitter is -- Print executionSuccessful - Write_Boolean_Attribute (N_EXECUTION_SUCCESSFUL, Compilation_Errors); + Write_Boolean_Attribute (N_EXECUTION_SUCCESSFUL, not Compilation_Errors); End_Block; NL_And_Indent; diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index 46334aa97af1..26b0dbb1ae46 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -1439,11 +1439,17 @@ package body Osint is - function Get_Current_Dir return String is - Current_Dir : String (1 .. Max_Path + 1); - Last: Natural; + Path_Len : Natural := Max_Path; + Buffer : String (1 .. 1 + Max_Path + 1); + begin - Get_Current_Dir (Current_Dir'Address, Last'Address); - return Current_Dir (1 .. Last); + Get_Current_Dir (Buffer'Address, Path_Len'Address); + + if Path_Len = 0 then + raise Program_Error; + end if; + + return Buffer (1 .. Path_Len); end Get_Current_Dir; --- @@ -2801,6 +2807,14 @@ package body Osint is Append (Rel_Path, ".." & System.OS_Lib.Directory_Separator); end loop; + -- Avoid starting the relative path with a directory separator + + if Last < Norm_Path'Length +and then Is_Directory_Separator (Norm_Path (Norm_Path'First + Last)) + then + Last := Last + 1; + end if; + -- Add the rest of the path from the common point Append diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads index 5dbbfd8fd7ff..77aaf04a7712 100644 --- a/gcc/ada/osint.ads +++ b/gcc/ada/osint.ads @@ -236,6 +236,11 @@ package Osint is function Relative_Path (Path : String; Ref : String) return String; -- Given an absolute path Path calculate its relative path from a reference -- directory Ref. + -- + -- If the paths are the same it will return ".". + -- + -- If the paths are on different drives on Windows based systems then it + -- will return the normalized version of Path. function Relocate_Path (Prefix : String;
[gcc r16-1144] ada: Implement use implies with experimental extension
https://gcc.gnu.org/g:83790d83c9f3eb0c2819d0e22e529cf785c71bd9 commit r16-1144-g83790d83c9f3eb0c2819d0e22e529cf785c71bd9 Author: squirek Date: Fri Jan 17 15:38:43 2025 + ada: Implement use implies with experimental extension The patch implements the experimental feature to allow use package clauses within the context area to imply with. gcc/ada/ChangeLog: * sem_ch8.adb (Analyze_Package_Name): Add code to expand use clauses such that they have an implicit with associated with them when extensions are enabled. * sem_ch10.ads (Analyze_With_Clause): New. * sem_ch10.adb (Analyze_With_Clause): Add comes from source check for warning. (Expand_With_Clause): Moved to the spec. * sem_util.adb, sem_util.ads (Is_In_Context_Clause): Moved from sem_prag. * sem_prag.adb (Analyze_Pragma): Update calls to Is_In_Context_Clause. (Is_In_Context_Clause): Moved to sem_util. Diff: --- gcc/ada/sem_ch10.adb | 10 +- gcc/ada/sem_ch10.ads | 9 + gcc/ada/sem_ch8.adb | 39 +++ gcc/ada/sem_prag.adb | 31 +++ gcc/ada/sem_util.adb | 21 + gcc/ada/sem_util.ads | 4 6 files changed, 77 insertions(+), 37 deletions(-) diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index de5a8c846ba7..9af96fc41b6b 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -123,15 +123,6 @@ package body Sem_Ch10 is -- Verify that a stub is declared immediately within a compilation unit, -- and not in an inner frame. - procedure Expand_With_Clause (Item : Node_Id; Nam : Node_Id; N : Node_Id); - -- When a child unit appears in a context clause, the implicit withs on - -- parents are made explicit, and with clauses are inserted in the context - -- clause before the one for the child. If a parent in the with_clause - -- is a renaming, the implicit with_clause is on the renaming whose name - -- is mentioned in the with_clause, and not on the package it renames. - -- N is the compilation unit whose list of context items receives the - -- implicit with_clauses. - procedure Generate_Parent_References (N : Node_Id; P_Id : Entity_Id); -- Generate cross-reference information for the parents of child units -- and of subunits. N is a defining_program_unit_name, and P_Id is the @@ -2955,6 +2946,7 @@ package body Sem_Ch10 is if Ada_Version >= Ada_95 and then In_Predefined_Renaming (U) +and then Comes_From_Source (N) then if Restriction_Check_Required (No_Obsolescent_Features) then Check_Restriction (No_Obsolescent_Features, N); diff --git a/gcc/ada/sem_ch10.ads b/gcc/ada/sem_ch10.ads index c80c41295064..9585785f10a6 100644 --- a/gcc/ada/sem_ch10.ads +++ b/gcc/ada/sem_ch10.ads @@ -45,6 +45,15 @@ package Sem_Ch10 is -- set when Ent is a tagged type and its class-wide type needs to appear -- in the tree. + procedure Expand_With_Clause (Item : Node_Id; Nam : Node_Id; N : Node_Id); + -- When a child unit appears in a context clause, the implicit withs on + -- parents are made explicit, and with clauses are inserted in the context + -- clause before the one for the child. If a parent in the with_clause + -- is a renaming, the implicit with_clause is on the renaming whose name + -- is mentioned in the with_clause, and not on the package it renames. + -- N is the compilation unit whose list of context items receives the + -- implicit with_clauses. + procedure Install_Context (N : Node_Id; Chain : Boolean := True); -- 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_ch8.adb b/gcc/ada/sem_ch8.adb index 6fb9a9a1f5a7..65d30967ae02 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -77,6 +77,7 @@ with Style; with Table; with Tbuild; use Tbuild; with Uintp; use Uintp; +with Uname; use Uname; with Warnsw; use Warnsw; package body Sem_Ch8 is @@ -4300,6 +4301,44 @@ package body Sem_Ch8 is begin pragma Assert (Nkind (Clause) = N_Use_Package_Clause); + + -- Perform "use implies with" expansion (when extensions are enabled) + -- by inserting an extra with clause since redundant clauses don't + -- really matter. + + if All_Extensions_Allowed and then Is_In_Context_Clause (Clause) then +declare + Unum: Unit_Number_Type; + With_Clause : constant Node_Id := + Make_With_Clause (Sloc (Clause), + Name => New_Copy_Tree (Pack)); +begin + -- Attempt to load the unit mentioned in the use clause + + Unum :=
[gcc r16-1147] ada: Add error message for a declared-too-late abstract state constituent
https://gcc.gnu.org/g:2172d3efbc6ad5fad78288ece54cd0149838e8cf
commit r16-1147-g2172d3efbc6ad5fad78288ece54cd0149838e8cf
Author: Steve Baird
Date: Tue Jan 14 15:53:57 2025 -0800
ada: Add error message for a declared-too-late abstract state constituent
In the error case of an undefined abstract state constituent, we want to
help users distinguish between the case where the constituent is
"really" undefined versus being defined "too late" (i.e., after a body).
So in the latter case we generate an additional message.
gcc/ada/ChangeLog:
* sem_prag.adb
(Analyze_Constituent): In the specific case case of a
defined-too-late
abstract state constituent, generate an additional error message.
Diff:
---
gcc/ada/sem_prag.adb | 79 +---
1 file changed, 56 insertions(+), 23 deletions(-)
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index dcee8600d7c3..83aae7c89a62 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -30940,34 +30940,67 @@ package body Sem_Prag is
--end Pack;
if Constit_Id = Any_Id then
- SPARK_Msg_NE ("& is undefined", Constit, Constit_Id);
+ -- A "Foo is undefined" message has already been
+ -- generated for this constituent. Emit an additional
+ -- message in the special case where the named
+ -- would-be constituent was declared too late in the
+ -- declaration list (as opposed to, for example, not
+ -- being declared at all).
+
+ -- Look for named constituent after freezing point
+ if Present (Freeze_Id) then
+declare
+ Decl : Node_Id;
+begin
+ Decl := Enclosing_Declaration (Freeze_Id);
- -- Emit a specialized info message when the contract of
- -- the related package body was "frozen" by another body.
- -- Note that it is not possible to precisely identify why
- -- the constituent is undefined because it is not visible
- -- when pragma Refined_State is analyzed. This message is
- -- a reasonable approximation.
+ while Present (Decl) loop
+ if Nkind (Decl) = N_Object_Declaration
+and then Same_Name (Defining_Identifier (Decl),
+Constit)
+and then not Constant_Present (Decl)
+ then
+ Error_Msg_Node_1 := Constit;
+ Error_Msg_Sloc :=
+ Sloc (Defining_Identifier (Decl));
- if Present (Freeze_Id) and then not Freeze_Posted then
-Freeze_Posted := True;
+ SPARK_Msg_NE
+ ("abstract state constituent & declared"
+ & " too late #!", Constit, Constit);
-Error_Msg_Name_1 := Chars (Body_Id);
-Error_Msg_Sloc := Sloc (Freeze_Id);
-SPARK_Msg_NE
- ("body & declared # freezes the contract of %",
- N, Freeze_Id);
-SPARK_Msg_N
- ("\all constituents must be declared before body #",
- N);
+ exit;
+ end if;
+ Next (Decl);
+ end loop;
+end;
+
+-- Emit a specialized info message when the contract
+-- of the related package body was "frozen" by
+-- another body. If a "declared too late" message
+-- is generated, this will clarify what is meant by
+-- "too late".
+
+if not Freeze_Posted then
+ Freeze_Posted := True;
--- A misplaced constituent is a critical error because
--- pragma Refined_Depends or Refined_Global depends on
--- the proper link between a state and a constituent.
--- Stop the compilation, as this leads to a multitude
--- of misleading cascaded errors.
+ Error_Msg_Name_1 := Chars (Body_Id);
+ Error_Msg_Sloc := Sloc (Freeze_Id);
+ SPARK_Msg_NE
+
[gcc r16-1148] ada: Error about assignment to limited target on aggregate with "for of" iterator
https://gcc.gnu.org/g:69f1d543edeb192a05bac7ff8a07350dbb3d986f commit r16-1148-g69f1d543edeb192a05bac7ff8a07350dbb3d986f Author: Gary Dismukes Date: Sat Jan 18 01:11:12 2025 + ada: Error about assignment to limited target on aggregate with "for of" iterator The compiler reports a spurious error about an assignment to a limited object on an aggregate of a array type with limited components that has an association with a "for of" iterator. This is fixed by arranging to have the Assignment_OK flag set on the indexed_names generated by the expander for initializing the aggregate object. gcc/ada/ChangeLog: * exp_aggr.adb (Two_Pass_Aggregate_Expansion): Change call to Make_Assignment for the indexed aggregate object to call Change_Make_OK_Assignment instead. Diff: --- gcc/ada/exp_aggr.adb | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 7cb26ce1af51..3c4576df3b83 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -5749,7 +5749,7 @@ package body Exp_Aggr is while Present (Assoc) loop Iter := Iterator_Specification (Assoc); Iter_Id := Defining_Identifier (Iter); -New_Comp := Make_Assignment_Statement (Loc, +New_Comp := Make_OK_Assignment_Statement (Loc, Name => Make_Indexed_Component (Loc, Prefix => New_Occurrence_Of (TmpE, Loc),
[gcc r16-1161] ada: Remove useless global variable
https://gcc.gnu.org/g:cf1f3f7c34292a11ee831b61d44b5cbab280e272 commit r16-1161-gcf1f3f7c34292a11ee831b61d44b5cbab280e272 Author: Ronan Desplanques Date: Wed Feb 5 14:45:28 2025 +0100 ada: Remove useless global variable This patch removes a global variable that was made useless by a previous change and mistakenly hadn't been removed then. gcc/ada/ChangeLog: * opt.ads: Remove useless variable. * sem_ch9.adb (Analyze_Abort_Statement, Analyze_Accept_Alternative, Analyze_Accept_Statement, Analyze_Asynchronous_Select, Analyze_Conditional_Entry_Call, Analyze_Delay_Alternative, Analyze_Delay_Relative, Analyze_Delay_Until, Analyze_Entry_Body, Analyze_Entry_Body_Formal_Part, Analyze_Entry_Call_Alternative, Analyze_Entry_Declaration, Analyze_Entry_Index_Specification, Analyze_Protected_Body, Analyze_Protected_Definition, Analyze_Protected_Type_Declaration, Analyze_Requeue, Analyze_Selective_Accept, Analyze_Single_Protected_Declaration, Analyze_Single_Task_Declaration, Analyze_Task_Body, Analyze_Task_Definition, Analyze_Task_Type_Declaration, Analyze_Terminate_Alternative, Analyze_Timed_Entry_Call, Analyze_Triggering_Alternative): Remove useless assignments. Diff: --- gcc/ada/opt.ads | 4 gcc/ada/sem_ch9.adb | 37 - 2 files changed, 41 deletions(-) diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 87ce3a1d4639..cbe470105fd1 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -1522,10 +1522,6 @@ package Opt is -- used for inconsistency error messages. A value of System_Location is -- used if the policy is set in package System. - Tasking_Used : Boolean := False; - -- Set True if any tasking construct is encountered. Used to activate the - -- output of the Q, L and T lines in ALI files. - Time_Slice_Set : Boolean := False; -- GNATBIND -- Set True if a pragma Time_Slice is processed in the main unit, or diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index 71394aa563ff..031c49f0e362 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -753,8 +753,6 @@ package body Sem_Ch9 is T_Name : Node_Id; begin - Tasking_Used := True; - T_Name := First (Names (N)); while Present (T_Name) loop Analyze (T_Name); @@ -790,8 +788,6 @@ package body Sem_Ch9 is procedure Analyze_Accept_Alternative (N : Node_Id) is begin - Tasking_Used := True; - if Present (Pragmas_Before (N)) then Analyze_List (Pragmas_Before (N)); end if; @@ -823,8 +819,6 @@ package body Sem_Ch9 is Task_Nam : Entity_Id := Empty; -- initialize to prevent warning begin - Tasking_Used := True; - -- Entry name is initialized to Any_Id. It should get reset to the -- matching entry entity. An error is signalled if it is not reset. @@ -1064,7 +1058,6 @@ package body Sem_Ch9 is Trigger: Node_Id; begin - Tasking_Used := True; Check_Restriction (Max_Asynchronous_Select_Nesting, N); Check_Restriction (No_Select_Statements, N); @@ -1109,7 +1102,6 @@ package body Sem_Ch9 is Is_Disp_Select : Boolean := False; begin - Tasking_Used := True; Check_Restriction (No_Select_Statements, N); -- Ada 2005 (AI-345): The trigger may be a dispatching call @@ -1154,7 +1146,6 @@ package body Sem_Ch9 is Typ : Entity_Id; begin - Tasking_Used := True; Check_Restriction (No_Delay, N); if Present (Pragmas_Before (N)) then @@ -1206,7 +1197,6 @@ package body Sem_Ch9 is E : constant Node_Id := Expression (N); begin - Tasking_Used := True; Check_Restriction (No_Relative_Delay, N); Check_Restriction (No_Delay, N); Check_Potentially_Blocking_Operation (N); @@ -1231,7 +1221,6 @@ package body Sem_Ch9 is Typ : Entity_Id; begin - Tasking_Used := True; Check_Restriction (No_Delay, N); Check_Potentially_Blocking_Operation (N); Analyze_And_Resolve (E); @@ -1266,8 +1255,6 @@ package body Sem_Ch9 is Freeze_Previous_Contracts (N); - Tasking_Used := True; - -- Entry_Name is initialized to Any_Id. It should get reset to the -- matching entry entity. An error is signalled if it is not reset. @@ -1518,8 +1505,6 @@ package body Sem_Ch9 is Formals : constant List_Id := Parameter_Specifications (N); begin - Tasking_Used := True; - if Present (Index) then Analyze (Index); @@ -1545,8 +1530,6 @@ package body Sem_Ch9 is Call : constant Node_Id := Entry_Call_Statement (N); begin - Tasking_Used := True; - if Present (Pragmas_Before (N)) then Analyze_List (Pragmas_Before (N)); end if; @@ -1589,8 +1572,6 @@ package body
[gcc r16-1154] ada: Add missing Ghost aspect to Lemma_Not_In_Range_Big2xx64 in s-aridou.adb
https://gcc.gnu.org/g:d57eddd9b211d4f7ded33e59f173bb2694afb835 commit r16-1154-gd57eddd9b211d4f7ded33e59f173bb2694afb835 Author: Aleksandra Pasek Date: Mon Feb 3 16:29:21 2025 + ada: Add missing Ghost aspect to Lemma_Not_In_Range_Big2xx64 in s-aridou.adb gcc/ada/ChangeLog: * libgnat/s-aridou.adb: Add missing Ghost aspect to Lemma_Not_In_Range_Big2xx64. Diff: --- gcc/ada/libgnat/s-aridou.adb | 1 + 1 file changed, 1 insertion(+) diff --git a/gcc/ada/libgnat/s-aridou.adb b/gcc/ada/libgnat/s-aridou.adb index e4140e837799..e3f83ca2aca0 100644 --- a/gcc/ada/libgnat/s-aridou.adb +++ b/gcc/ada/libgnat/s-aridou.adb @@ -508,6 +508,7 @@ is procedure Lemma_Not_In_Range_Big2xx64 with + Ghost, Post => not In_Double_Int_Range (Big_2xxDouble) and then not In_Double_Int_Range (-Big_2xxDouble);
[gcc r16-1167] ada: Add explicit null pointer check in C.Strings.Update
https://gcc.gnu.org/g:35260dd303a1f5c911310f87e7ddc3f1b580abbd commit r16-1167-g35260dd303a1f5c911310f87e7ddc3f1b580abbd Author: Tonu Naks Date: Fri Feb 7 12:55:30 2025 + ada: Add explicit null pointer check in C.Strings.Update gcc/ada/ChangeLog: * libgnat/i-cstrin.adb: null pointer check in Update Diff: --- gcc/ada/libgnat/i-cstrin.adb | 5 + 1 file changed, 5 insertions(+) diff --git a/gcc/ada/libgnat/i-cstrin.adb b/gcc/ada/libgnat/i-cstrin.adb index 974ba3a0e8ca..82795627a290 100644 --- a/gcc/ada/libgnat/i-cstrin.adb +++ b/gcc/ada/libgnat/i-cstrin.adb @@ -281,6 +281,11 @@ is Index : chars_ptr := Item + Offset; begin + -- Check for null pointer as mandated by the RM. + if Item = Null_Ptr then + raise Dereference_Error; + end if; + if Check and then Offset + Chars'Length > Strlen (Item) then raise Update_Error; end if;
[gcc r16-1156] ada: Improve efficiency of very large shift counts
https://gcc.gnu.org/g:a7c5e316e28c993952337ea7a5570cb5d1df1daa commit r16-1156-ga7c5e316e28c993952337ea7a5570cb5d1df1daa Author: Bob Duff Date: Tue Feb 4 14:36:03 2025 -0500 ada: Improve efficiency of very large shift counts For a call to an intrinsic shift function with a large Amount, for example Shift_Right(..., Amount => Natural'Last), and a compile-time-known value, the compiler would take an absurdly long time to compute the value. This patch fixes that by special-casing shift counts that are larger than the size of the thing being shifted. gcc/ada/ChangeLog: * sem_eval.adb (Fold_Shift): If the Amount parameter is greater than the size in bits, use the size. For example, if we are shifting an Unsigned_8 value, then Amount => 1_000_001 gives the same result as Amount => 8. This change avoids computing the value of 2**1_000_000, which takes too long and uses too much memory. Note that the computation we're talking about is a compile-time computation. Minor cleanup. DRY. * sem_eval.ads (Fold_Str, Fold_Uint, Fold_Ureal): Fold the comments into one comment, because DRY. Remove useless verbiage. Diff: --- gcc/ada/sem_eval.adb | 95 ++-- gcc/ada/sem_eval.ads | 37 +++- 2 files changed, 51 insertions(+), 81 deletions(-) diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index b7dfe01f2973..5d1506364956 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -4989,27 +4989,41 @@ package body Sem_Eval is end if; end Check_Elab_Call; - Modulus, Val : Uint; - begin - if Compile_Time_Known_Value (Left) -and then Compile_Time_Known_Value (Right) + if not (Compile_Time_Known_Value (Left) + and then Compile_Time_Known_Value (Right)) then - pragma Assert (not Non_Binary_Modulus (Typ)); + return; + end if; + + pragma Assert (not Non_Binary_Modulus (Typ)); + pragma Assert (Expr_Value (Right) >= Uint_0); -- Amount is always Natural + + -- Shift by zero bits is a no-op + if Expr_Value (Right) = Uint_0 then + Fold_Uint (N, Expr_Value (Left), Static => Static); + return; + end if; + + declare + Modulus : constant Uint := + (if Is_Modular_Integer_Type (Typ) then Einfo.Entities.Modulus (Typ) +else Uint_2 ** RM_Size (Typ)); + Amount : constant Uint := UI_Min (Expr_Value (Right), RM_Size (Typ)); + -- Shift by an Amount greater than the size is all-zeros or all-ones. + -- Without this "min", we could use huge amounts of time and memory + -- below (e.g. 2**Amount, if Amount were a billion). + + Val : Uint; + begin if Op = N_Op_Shift_Left then Check_Elab_Call; -if Is_Modular_Integer_Type (Typ) then - Modulus := Einfo.Entities.Modulus (Typ); -else - Modulus := Uint_2 ** RM_Size (Typ); -end if; - -- Fold Shift_Left (X, Y) by computing -- (X * 2**Y) rem modulus [- Modulus] -Val := (Expr_Value (Left) * (Uint_2 ** Expr_Value (Right))) +Val := (Expr_Value (Left) * (Uint_2 ** Amount)) rem Modulus; if Is_Modular_Integer_Type (Typ) @@ -5023,49 +5037,32 @@ package body Sem_Eval is elsif Op = N_Op_Shift_Right then Check_Elab_Call; --- X >> 0 is a no-op +-- Fold X >> Y by computing (X [+ Modulus]) / 2**Y. +-- Note that after a Shift_Right operation (with Y > 0), the +-- result is always positive, even if the original operand was +-- negative. -if Expr_Value (Right) = Uint_0 then - Fold_Uint (N, Expr_Value (Left), Static => Static); -else - if Is_Modular_Integer_Type (Typ) then - Modulus := Einfo.Entities.Modulus (Typ); +declare + M : Unat; +begin + if Expr_Value (Left) >= Uint_0 then + M := Uint_0; else - Modulus := Uint_2 ** RM_Size (Typ); + M := Modulus; end if; - -- Fold X >> Y by computing (X [+ Modulus]) / 2**Y - -- Note that after a Shift_Right operation (with Y > 0), the - -- result is always positive, even if the original operand was - -- negative. - - declare - M : Unat; - begin - if Expr_Value (Left) >= Uint_0 then - M := Uint_0; - else - M := Modulus; - end if; + Fold_Uint + (N, +
[gcc r16-1313] ada: Incorrect creation of corresponding expression of class-wide contracts
https://gcc.gnu.org/g:250392311d5bc6d167f87d4ad65c3e9df8981fba commit r16-1313-g250392311d5bc6d167f87d4ad65c3e9df8981fba Author: Gary Dismukes Date: Fri Feb 28 00:08:19 2025 + ada: Incorrect creation of corresponding expression of class-wide contracts GNAT was incorrectly implementing the Ada rules for resolving calls to primitive functions within inherited class-wide pre- and postconditions, as specified in RM22 6.1.1 (relating to AI12-0113). Only function calls that involve formals of the associated primitive subprogram should be treated using the "(notional) formal derived type" rules. In particular, calls that are tag-indeterminate (for example, "F(G)") should not be mapped to call the corresponding primitives of the derived type (they should still call the primitives of the ancestor type). The fix for this involves a new predicate function that recursively traverses calls to determine the calls that satisfy the criteria for mapping. These changes also completely remove the mapping of formals that was done in Contracts.Merge_Class_Conditions (in Inherit_Condition), since the mapping will be done later anyway by Build_Class_Wide_Expression, and the earlier mapping interferes with that. Note: The utility function Sem_Util.Check_Parents is no longer called after removal of the single call to it from contracts.adb, but it's being retained (along with the generic subprograms in Atree that it depends on) for possible use in VAST. gcc/ada/ChangeLog: * contracts.adb (Inherit_Condition): Remove Assoc_List and its uses along with function Check_Condition, since mapping of formals will effectively be done in Build_Class_Wide_Expression (by Replace_Entity). * exp_util.adb (Replace_Entity): Only rewrite entity references in function calls that qualify according to the result of calling the new function Call_To_Parent_Dispatching_Op_Must_Be_Mapped. (Call_To_Parent_Dispatching_Op_Must_Be_Mapped): New function that determines whether a function call to a primitive of Par_Subp associated tagged type needs to be mapped (according to whether it has any actuals that reference controlling formals of the primitive). Diff: --- gcc/ada/contracts.adb | 103 - gcc/ada/exp_util.adb | 113 +- 2 files changed, 121 insertions(+), 95 deletions(-) diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb index 810458a7d9b1..70e94874a23f 100644 --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -4399,10 +4399,10 @@ package body Contracts is Seen: Subprogram_List (Subps'Range) := (others => Empty); function Inherit_Condition - (Par_Subp : Entity_Id; -Subp : Entity_Id) return Node_Id; - -- Inherit the class-wide condition from Par_Subp to Subp and adjust - -- all the references to formals in the inherited condition. + (Par_Subp : Entity_Id) return Node_Id; + -- Inherit the class-wide condition from Par_Subp. Simply makes + -- a copy of the condition in preparation for later mapping of + -- referenced formals and functions by Build_Class_Wide_Expression. procedure Merge_Conditions (From : Node_Id; Into : Node_Id); -- Merge two class-wide preconditions or postconditions (the former @@ -4417,92 +4417,11 @@ package body Contracts is --- function Inherit_Condition - (Par_Subp : Entity_Id; -Subp : Entity_Id) return Node_Id - is -function Check_Condition (Expr : Node_Id) return Boolean; --- Used in assertion to check that Expr has no reference to the --- formals of Par_Subp. - -- --- Check_Condition -- -- - -function Check_Condition (Expr : Node_Id) return Boolean is - Par_Formal_Id : Entity_Id; - - function Check_Entity (N : Node_Id) return Traverse_Result; - -- Check occurrence of Par_Formal_Id - - -- - -- Check_Entity -- - -- - - function Check_Entity (N : Node_Id) return Traverse_Result is - begin - if Nkind (N) = N_Identifier -and then Present (Entity (N)) -and then Entity (N) = Par_Formal_Id - then - return Abandon; - end if; - - return OK; - end Check_Entity; - - function Check_Expression is new Traverse_Func (Check_Entity); - --- Start of processing for Check_Co
[gcc r16-1312] ada: Remove outdated comment
https://gcc.gnu.org/g:5fba1c986d619908174bb27dd1478c80e2007818 commit r16-1312-g5fba1c986d619908174bb27dd1478c80e2007818 Author: Ronan Desplanques Date: Mon Mar 3 15:42:32 2025 +0100 ada: Remove outdated comment This patch removes a comment that was made incorrect by the introduction of Is_Self_Hidden. gcc/ada/ChangeLog: * sem_ch3.adb (Analyze_Object_Declaration): Remove comment. Diff: --- gcc/ada/sem_ch3.adb | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 690d66889588..a8764db65032 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -4659,9 +4659,7 @@ package body Sem_Ch3 is Set_Has_Completion (Id); end if; - -- Set type and resolve (type may be overridden later on). Note: - -- Ekind (Id) must still be E_Void at this point so that incorrect - -- early usage within E is properly diagnosed. + -- Set type and resolve (type may be overridden later on) Set_Etype (Id, T);
[gcc r16-1303] ada: Fix bindings for CHERI Set_Bounds and Set_Exact_Bounds intrinsics.
https://gcc.gnu.org/g:9f106c7dfafb89c17f65d2128d738cf7d9962307 commit r16-1303-g9f106c7dfafb89c17f65d2128d738cf7d9962307 Author: Daniel King Date: Thu Feb 27 14:11:16 2025 + ada: Fix bindings for CHERI Set_Bounds and Set_Exact_Bounds intrinsics. gcc/ada/ChangeLog: * libgnat/i-cheri.ads (Set_Bounds, Set_Exact_Bounds): Remove wrong intrinsic binding. * libgnat/i-cheri.adb (Set_Bounds, Set_Exact_Bounds): New subprogram bodies. Diff: --- gcc/ada/libgnat/i-cheri.adb | 24 gcc/ada/libgnat/i-cheri.ads | 6 ++ 2 files changed, 26 insertions(+), 4 deletions(-) diff --git a/gcc/ada/libgnat/i-cheri.adb b/gcc/ada/libgnat/i-cheri.adb index 37e5c3d28889..157570577168 100644 --- a/gcc/ada/libgnat/i-cheri.adb +++ b/gcc/ada/libgnat/i-cheri.adb @@ -31,6 +31,30 @@ package body Interfaces.CHERI is + + -- Set_Bounds -- + + + procedure Set_Bounds + (Cap: in out Capability; + Length :Bounds_Length) + is + begin + Cap := Capability_With_Bounds (Cap, Length); + end Set_Bounds; + + -- + -- Set_Exact_Bounds -- + -- + + procedure Set_Exact_Bounds + (Cap: in out Capability; + Length :Bounds_Length) + is + begin + Cap := Capability_With_Exact_Bounds (Cap, Length); + end Set_Exact_Bounds; + -- Set_Address_And_Bounds -- diff --git a/gcc/ada/libgnat/i-cheri.ads b/gcc/ada/libgnat/i-cheri.ads index ed26e55c7972..4186b6d47a9a 100644 --- a/gcc/ada/libgnat/i-cheri.ads +++ b/gcc/ada/libgnat/i-cheri.ads @@ -273,8 +273,7 @@ is (Cap: in out Capability; Length :Bounds_Length) with - Import, Convention => Intrinsic, - External_Name => "__builtin_cheri_bounds_set"; + Inline; -- Narrow the bounds of a capability so that the lower bound is the -- current address and the upper bound is suitable for the Length. -- @@ -287,8 +286,7 @@ is (Cap: in out Capability; Length :Bounds_Length) with - Import, Convention => Intrinsic, - External_Name => "__builtin_cheri_bounds_set_exact"; + Inline; -- Narrow the bounds of a capability so that the lower bound is the -- current address and the upper bound is suitable for the Length. --
[gcc r16-1304] ada: Rename Is_Infinity to Is_Infinity_Or_NaN in System.Double_Real
https://gcc.gnu.org/g:a289abde122d56cec29b8499f39fb65eba2c59ae
commit r16-1304-ga289abde122d56cec29b8499f39fb65eba2c59ae
Author: Eric Botcazou
Date: Thu Feb 27 12:09:03 2025 +0100
ada: Rename Is_Infinity to Is_Infinity_Or_NaN in System.Double_Real
The predicate is used to detect corner cases in multiplicative operations
and also returns True for NaNs.
gcc/ada/ChangeLog:
* libgnat/s-dourea.adb (Is_Infinity): Rename to...
(Is_Infinity_Or_NaN): ...this.
("*"): Adjust accordingly.
("/"): Likewise.
(Sqr): Likewise.
* libgnat/s-dorepr.adb (Two_Prod): Likewise.
(Two_Sqr): Likewise.
* libgnat/s-dorepr__fma.adb (Two_Prod): Likewise.
Diff:
---
gcc/ada/libgnat/s-dorepr.adb | 4 ++--
gcc/ada/libgnat/s-dorepr__fma.adb | 2 +-
gcc/ada/libgnat/s-dourea.adb | 18 +-
3 files changed, 12 insertions(+), 12 deletions(-)
diff --git a/gcc/ada/libgnat/s-dorepr.adb b/gcc/ada/libgnat/s-dorepr.adb
index ddc7c1dad17e..1d9604aa1fda 100644
--- a/gcc/ada/libgnat/s-dorepr.adb
+++ b/gcc/ada/libgnat/s-dorepr.adb
@@ -134,7 +134,7 @@ package body Product is
Ahi, Alo, Bhi, Blo, E : Num;
begin
- if Is_Infinity (P) or else Is_Zero (P) then
+ if Is_Infinity_Or_NaN (P) or else Is_Zero (P) then
return (P, 0.0);
else
@@ -157,7 +157,7 @@ package body Product is
Hi, Lo, E : Num;
begin
- if Is_Infinity (Q) or else Is_Zero (Q) then
+ if Is_Infinity_Or_NaN (Q) or else Is_Zero (Q) then
return (Q, 0.0);
else
diff --git a/gcc/ada/libgnat/s-dorepr__fma.adb
b/gcc/ada/libgnat/s-dorepr__fma.adb
index 0d3dc5382447..45a92238e829 100644
--- a/gcc/ada/libgnat/s-dorepr__fma.adb
+++ b/gcc/ada/libgnat/s-dorepr__fma.adb
@@ -78,7 +78,7 @@ package body Product is
E : Num;
begin
- if Is_Infinity (P) or else Is_Zero (P) then
+ if Is_Infinity_Or_NaN (P) or else Is_Zero (P) then
return (P, 0.0);
else
diff --git a/gcc/ada/libgnat/s-dourea.adb b/gcc/ada/libgnat/s-dourea.adb
index a37f2eb03c3f..68d4d9a02d88 100644
--- a/gcc/ada/libgnat/s-dourea.adb
+++ b/gcc/ada/libgnat/s-dourea.adb
@@ -34,12 +34,12 @@ package body System.Double_Real is
function Is_NaN (N : Num) return Boolean is (N /= N);
-- Return True if N is a NaN
- function Is_Infinity (N : Num) return Boolean is (Is_NaN (N - N));
- -- Return True if N is an infinity. Used to avoid propagating meaningless
- -- errors when the result of a product is an infinity.
+ function Is_Infinity_Or_NaN (N : Num) return Boolean is (Is_NaN (N - N));
+ -- Return True if N is either an infinity or NaN. Used to avoid propagating
+ -- meaningless errors when the result of a product is an infinity or NaN.
function Is_Zero (N : Num) return Boolean is (N = -N);
- -- Return True if N is a Zero. Used to preserve the sign when the result of
+ -- Return True if N is a zero. Used to preserve the sign when the result of
-- a product is a zero.
package Product is
@@ -151,7 +151,7 @@ package body System.Double_Real is
P : constant Double_T := Two_Prod (A.Hi, B);
begin
- if Is_Infinity (P.Hi) or else Is_Zero (P.Hi) then
+ if Is_Infinity_Or_NaN (P.Hi) or else Is_Zero (P.Hi) then
return (P.Hi, 0.0);
else
return Quick_Two_Sum (P.Hi, P.Lo + A.Lo * B);
@@ -162,7 +162,7 @@ package body System.Double_Real is
P : constant Double_T := Two_Prod (A.Hi, B.Hi);
begin
- if Is_Infinity (P.Hi) or else Is_Zero (P.Hi) then
+ if Is_Infinity_Or_NaN (P.Hi) or else Is_Zero (P.Hi) then
return (P.Hi, 0.0);
else
return Quick_Two_Sum (P.Hi, P.Lo + A.Hi * B.Lo + A.Lo * B.Hi);
@@ -178,7 +178,7 @@ package body System.Double_Real is
P, R : Double_T;
begin
- if Is_Infinity (B) or else Is_Zero (B) then
+ if Is_Infinity_Or_NaN (B) or else Is_Zero (B) then
return (A.Hi / B, 0.0);
end if;
pragma Annotate (CodePeer, Intentional, "test always false",
@@ -202,7 +202,7 @@ package body System.Double_Real is
R, S : Double_T;
begin
- if Is_Infinity (B.Hi) or else Is_Zero (B.Hi) then
+ if Is_Infinity_Or_NaN (B.Hi) or else Is_Zero (B.Hi) then
return (A.Hi / B.Hi, 0.0);
end if;
pragma Annotate (CodePeer, Intentional, "test always false",
@@ -228,7 +228,7 @@ package body System.Double_Real is
Q : constant Double_T := Two_Sqr (A.Hi);
begin
- if Is_Infinity (Q.Hi) or else Is_Zero (Q.Hi) then
+ if Is_Infinity_Or_NaN (Q.Hi) or else Is_Zero (Q.Hi) then
return (Q.Hi, 0.0);
else
return Quick_Two_Sum (Q.Hi, Q.Lo + 2.0 * A.Hi * A.Lo + A.Lo * A.Lo);
[gcc r16-1306] ada: Fix spurious error on anonymous array initialized by conditional expression
https://gcc.gnu.org/g:109ea2d2884eac0297847af1b3a41fede3b671cc commit r16-1306-g109ea2d2884eac0297847af1b3a41fede3b671cc Author: Eric Botcazou Date: Thu Feb 27 20:43:04 2025 +0100 ada: Fix spurious error on anonymous array initialized by conditional expression Even though the actual subtype of the anonymous array is not yet set on the object itself by the time Insert_Conditional_Object_Declaration is called, it is set on its initialization expression, so it can simply be forwarded to Insert_Conditional_Object_Declaration from there, which avoids creating a new one for each new object and triggering a subtype mismatch later. gcc/ada/ChangeLog: * exp_ch4.adb (Insert_Conditional_Object_Declaration): Remove Decl formal parameter, add Typ and Const formal parameters. (Expand_N_Case_Expression): Fix pasto in comment. Adjust call to Insert_Conditional_Object_Declaration and tidy up surrounding code. (Expand_N_If_Expression): Adjust couple of calls to Insert_Conditional_Object_Declaration. Diff: --- gcc/ada/exp_ch4.adb | 43 +-- 1 file changed, 21 insertions(+), 22 deletions(-) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 01be3dff89bc..1c2a87637111 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -193,12 +193,12 @@ package body Exp_Ch4 is procedure Insert_Conditional_Object_Declaration (Obj_Id : Entity_Id; + Typ: Entity_Id; Expr : Node_Id; - Decl : Node_Id); - -- Expr is the dependent expression of a conditional expression and Decl - -- is the declaration of an object whose initialization expression is the - -- conditional expression. Insert in the actions of Expr the declaration - -- of Obj_Id modeled on Decl and with Expr as initialization expression. + Const : Boolean); + -- Expr is the dependent expression of a conditional expression. Insert in + -- the actions of Expr the declaration of Obj_Id with type Typ and Expr as + -- initialization expression. Const is True when Obj_Id is a constant. procedure Insert_Dereference_Action (N : Node_Id); -- N is an expression whose type is an access. When the type of the @@ -5313,7 +5313,7 @@ package body Exp_Ch4 is -- 'Unrestricted_Access. -- Generate: - --type Ptr_Typ is not null access all [constant] Typ; + --type Target_Typ is not null access all [constant] Typ; else Target_Typ := Make_Temporary (Loc, 'P'); @@ -5411,20 +5411,16 @@ package body Exp_Ch4 is elsif Optimize_Object_Decl then Obj := Make_Temporary (Loc, 'C', Alt_Expr); - Insert_Conditional_Object_Declaration (Obj, Alt_Expr, Par); - - Alt_Expr := - Make_Attribute_Reference (Alt_Loc, - Prefix => New_Occurrence_Of (Obj, Alt_Loc), - Attribute_Name => Name_Unrestricted_Access); - - LHS := New_Occurrence_Of (Target, Loc); - Set_Assignment_OK (LHS); + Insert_Conditional_Object_Declaration + (Obj, Typ, Alt_Expr, Const => Constant_Present (Par)); Stmts := New_List ( Make_Assignment_Statement (Alt_Loc, - Name => LHS, - Expression => Alt_Expr)); + Name => New_Occurrence_Of (Target, Loc), + Expression => + Make_Attribute_Reference (Alt_Loc, + Prefix => New_Occurrence_Of (Obj, Alt_Loc), + Attribute_Name => Name_Unrestricted_Access))); -- Take the unrestricted access of the expression value for non- -- scalar types. This approach avoids big copies and covers the @@ -6022,8 +6018,10 @@ package body Exp_Ch4 is Target : constant Entity_Id := Make_Temporary (Loc, 'C', N); begin -Insert_Conditional_Object_Declaration (Then_Obj, Thenx, Par); -Insert_Conditional_Object_Declaration (Else_Obj, Elsex, Par); +Insert_Conditional_Object_Declaration + (Then_Obj, Typ, Thenx, Const => Constant_Present (Par)); +Insert_Conditional_Object_Declaration + (Else_Obj, Typ, Elsex, Const => Constant_Present (Par)); -- Generate: --type Ptr_Typ is not null access all [constant] Typ; @@ -13294,16 +13292,17 @@ package body Exp_Ch4 is procedure Insert_Conditional_Object_Declaration (Obj_Id : Entity_Id; + Typ: Entity_Id; Expr : Node_Id; - Decl : Node_Id) + Const : Boolean) is Loc : constant Source_Ptr := Sloc (Expr); Obj_Decl : constant Node_Id := Make_Object_Declaration (Loc, Defining_Identifier => Obj_Id, Aliased_Pre
[gcc r16-1305] ada: Fix assertion failure on error path
https://gcc.gnu.org/g:2e0e76ca8e37c42af96d6c2c581a8ee4b600a278 commit r16-1305-g2e0e76ca8e37c42af96d6c2c581a8ee4b600a278 Author: Ronan Desplanques Date: Thu Feb 27 15:45:01 2025 +0100 ada: Fix assertion failure on error path gcc/ada/ChangeLog: * sem_ch8.adb (Find_Selected_Component): Fix error path. Diff: --- gcc/ada/sem_ch8.adb | 1 + 1 file changed, 1 insertion(+) diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 4cd6b7d93402..db892d0a5bef 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -8419,6 +8419,7 @@ package body Sem_Ch8 is if Found then Error_Msg_N ( "prefix must be unique enclosing scope", N); + Change_Selected_Component_To_Expanded_Name (N); Set_Entity (N, Any_Id); Set_Etype (N, Any_Type); return;
[gcc r16-1311] ada: Add example in Current_Entity_In_Scope comment
https://gcc.gnu.org/g:7ab63499ac8a0883a53fbc85e7868d5f72f42571 commit r16-1311-g7ab63499ac8a0883a53fbc85e7868d5f72f42571 Author: Ronan Desplanques Date: Mon Mar 3 12:03:02 2025 +0100 ada: Add example in Current_Entity_In_Scope comment gcc/ada/ChangeLog: * sem_util.ads (Current_Entity_In_Scope): Add example in comment. Diff: --- gcc/ada/sem_util.ads | 16 +++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 38e9676c5c4b..29dbae8073ef 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -619,7 +619,21 @@ package Sem_Util is -- Find whether there is a previous definition for name or identifier N in -- the current scope. Because declarations for a scope are not necessarily -- contiguous (e.g. for packages) the first entry on the visibility chain - -- for N is not necessarily in the current scope. + -- for N is not necessarily in the current scope. Take, for example: + -- + -- package P is + -- X : constant := 13; + -- + -- package Q is + --X : constant := 67; + -- end Q; + -- + -- Y : constant := X; + -- end P; + -- + -- When the declaration of Y is analyzed, the first entry on the visibility + -- chain is the X equal to 67, but Current_Entity_In_Scope returns the X + -- equal to 13. function Current_Scope return Entity_Id; -- Get entity representing current scope
[gcc r16-1307] ada: Tweak Kill_Current_Values
https://gcc.gnu.org/g:acc54e0cf014b01b4e8b2579002729316fe93834 commit r16-1307-gacc54e0cf014b01b4e8b2579002729316fe93834 Author: Ronan Desplanques Date: Thu Feb 27 11:25:45 2025 +0100 ada: Tweak Kill_Current_Values Is_Object returns True for "record field" entities, which might make sense in some contexts but not when Kill_Current_Values is called in a default expression of a record component. This patch refines the choice of considered entities in Kill_Current_Values accordingly. gcc/ada/ChangeLog: * sem_util.adb (Kill_Current_Values): Tweak condition. Diff: --- gcc/ada/sem_util.adb | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 0ce9e95a6206..02ebb71b562c 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -21907,7 +21907,7 @@ package body Sem_Util is Set_Last_Assignment (Ent, Empty); end if; - if Is_Object (Ent) then + if Is_Object (Ent) and then Ekind (Ent) not in Record_Field_Kind then if not Last_Assignment_Only then Kill_Checks (Ent); Set_Current_Value (Ent, Empty);
[gcc r16-1302] ada: Add Ada RM clause mention
https://gcc.gnu.org/g:7c9069750405d147670ad9143d19505a5dea8240 commit r16-1302-g7c9069750405d147670ad9143d19505a5dea8240 Author: Ronan Desplanques Date: Thu Feb 27 14:34:49 2025 +0100 ada: Add Ada RM clause mention This patch adds a mention of the relevant Ada RM clause to a comment about a part of Find_Selected_Component, to make it easier to find. gcc/ada/ChangeLog: * sem_ch8.adb (Find_Selected_Component): Add mention. Diff: --- gcc/ada/sem_ch8.adb | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index fe9328833df4..4cd6b7d93402 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -8404,7 +8404,8 @@ package body Sem_Ch8 is if Is_Overloaded (P) then - -- The prefix must resolve to a unique enclosing construct + -- The prefix must resolve to a unique enclosing construct, per + -- the last sentence of RM 4.1.3 (13). declare Found : Boolean := False;
[gcc r16-1324] ada: Specialize syntax error on malformed Abstract_State contract
https://gcc.gnu.org/g:fd98d3b9b1cb3109a36957a401ba7bc7097ca267
commit r16-1324-gfd98d3b9b1cb3109a36957a401ba7bc7097ca267
Author: Piotr Trojanek
Date: Thu Mar 6 10:01:35 2025 +0100
ada: Specialize syntax error on malformed Abstract_State contract
Syntax for the Abstract_State contract is the same as for extended
aggregates,
but conceptually they are completely different. This patch specializes error
messages emitted on syntax errors for these constructs.
gcc/ada/ChangeLog:
* par-ch13.adb (Get_Aspect_Specifications): Save and restore flag
while
parsing aspect Abstract_State.
* par-ch2.adb (P_Pragma): Same while parsing pragma Abstract_State.
* par-ch4.adb (P_Aggregate_Or_Paren_Expr): Specialize error message
for contract Abstract_State and extended aggregate.
* par.adb (Inside_Abstract_State): Add new context flag.
Diff:
---
gcc/ada/par-ch13.adb | 7 +--
gcc/ada/par-ch2.adb | 15 +--
gcc/ada/par-ch4.adb | 9 +++--
gcc/ada/par.adb | 5 +
4 files changed, 26 insertions(+), 10 deletions(-)
diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb
index f52136c916a7..dbb894f79cd3 100644
--- a/gcc/ada/par-ch13.adb
+++ b/gcc/ada/par-ch13.adb
@@ -503,6 +503,8 @@ package body Ch13 is
or else A_Id = Aspect_Refined_Depends
then
Inside_Depends := True;
+ elsif A_Id = Aspect_Abstract_State then
+ Inside_Abstract_State := True;
end if;
-- Note that we have seen an Import aspect specification.
@@ -529,9 +531,10 @@ package body Ch13 is
Set_Expression (Aspect, P_Expression);
end if;
- -- Unconditionally reset flag for Inside_Depends
+ -- Unconditionally reset flag for being inside aspects
- Inside_Depends := False;
+ Inside_Depends:= False;
+ Inside_Abstract_State := False;
end if;
-- Add the aspect to the resulting list only when it was properly
diff --git a/gcc/ada/par-ch2.adb b/gcc/ada/par-ch2.adb
index 20640d5547b8..11c9a8384df4 100644
--- a/gcc/ada/par-ch2.adb
+++ b/gcc/ada/par-ch2.adb
@@ -385,6 +385,8 @@ package body Ch2 is
or else Chars (Ident_Node) = Name_Refined_Depends
then
Inside_Depends := True;
+ elsif Chars (Ident_Node) = Name_Abstract_State then
+ Inside_Abstract_State := True;
end if;
-- Scan arguments. We assume that arguments are present if there is
@@ -441,11 +443,11 @@ package body Ch2 is
Semicolon_Loc := Token_Ptr;
- -- Cancel indication of being within a pragma or in particular a Depends
- -- pragma.
+ -- Cancel indication of being within a pragma
- Inside_Depends := False;
- Inside_Pragma := False;
+ Inside_Depends:= False;
+ Inside_Abstract_State := False;
+ Inside_Pragma := False;
-- Now we have two tasks left, we need to scan out the semicolon
-- following the pragma, and we have to call Par.Prag to process
@@ -472,8 +474,9 @@ package body Ch2 is
exception
when Error_Resync =>
Resync_Past_Semicolon;
- Inside_Depends := False;
- Inside_Pragma := False;
+ Inside_Depends:= False;
+ Inside_Abstract_State := False;
+ Inside_Pragma := False;
return Error;
end P_Pragma;
diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index 8267a0c06d3b..e6cf93ab3878 100644
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -1607,8 +1607,13 @@ package body Ch4 is
-- Improper use of WITH
elsif Token = Tok_With then
-Error_Msg_SC ("WITH must be preceded by single expression in " &
- "extension aggregate");
+if Inside_Abstract_State then
+ Error_Msg_SC ("state name with options must be enclosed in " &
+ "parentheses");
+else
+ Error_Msg_SC ("WITH must be preceded by single expression in " &
+ "extension aggregate");
+end if;
raise Error_Resync;
-- Range attribute can only appear as part of a discrete choice list
diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb
index 5d61fac3c113..0003a33e 100644
--- a/gcc/ada/par.adb
+++ b/gcc/ada/par.adb
@@ -80,6 +80,11 @@ function Par (Configuration_Pragmas : Boolean) return
List_Id is
-- True within a delta aggregate (but only after the "delta" token has
-- been scanned). Used to distinguish syntax errors from syntactically
-- correct "deep" delta aggregates (enabled via -gnatX0).
+
+ Inside_Abstract_State : Boolean := False;
+ -- True within an Abstract_State contract. Used to distinguish syntax error
+ --
[gcc r16-1334] ada: Remove duplicated code in parser for Chapter 4 (continued)
https://gcc.gnu.org/g:7e948513468e9beddb5e1978ef64851e9cd44055
commit r16-1334-g7e948513468e9beddb5e1978ef64851e9cd44055
Author: Eric Botcazou
Date: Mon Mar 10 12:02:45 2025 +0100
ada: Remove duplicated code in parser for Chapter 4 (continued)
P_Qualified_Simple_Name and P_Function_Name contain essentially the same
code, except that P_Function_Name does not error out on an operator symbol
that is followed by something else than a dot.
This deletes P_Function_Name and changes P_Qualified_Simple_Name[_Resync]
to not error out either in this case, with the only consequence that the
error message given for:
generic
type T is private;
function "&" (A, B : String) return String;
procedure Proc is new "&" (Integer);
is now identical to the one given for:
generic
type T is private;
function "&" (A, B : String) return String;
function Func is new "&" (Integer);
namely:
q.ads:7:12: error: operator symbol not allowed for generic subprogram
gcc/ada/ChangeLog:
* par-ch4.adb (P_Function_Name): Delete body.
(P_Qualified_Simple_Name_Resync): Do not raise Error_Resync on an
operator symbol followed by something else than a dot.
* par-ch6.adb (P_Subprogram): Do not call P_Function_Name.
* par.adb (P_Function_Name): Delete declaration.
Diff:
---
gcc/ada/par-ch4.adb | 77 +++--
gcc/ada/par-ch6.adb | 3 +--
gcc/ada/par.adb | 1 -
3 files changed, 4 insertions(+), 77 deletions(-)
diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index 1f1366817cc1..ebdc587f0e15 100644
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -935,69 +935,6 @@ package body Ch4 is
-- Error recovery: cannot raise Error_Resync
- function P_Function_Name return Node_Id is
- Designator_Node : Node_Id;
- Prefix_Node : Node_Id;
- Selector_Node : Node_Id;
- Dot_Sloc: Source_Ptr := No_Location;
-
- begin
- -- Prefix_Node is set to the gathered prefix so far, Empty means that
- -- no prefix has been scanned. This allows us to build up the result
- -- in the required right recursive manner.
-
- Prefix_Node := Empty;
-
- -- Loop through prefixes
-
- loop
- Designator_Node := Token_Node;
-
- if Token not in Token_Class_Desig then
-return P_Identifier; -- let P_Identifier issue the error message
-
- else -- Token in Token_Class_Desig
-Scan; -- past designator
-exit when Token /= Tok_Dot;
- end if;
-
- -- Here at a dot, with token just before it in Designator_Node
-
- if No (Prefix_Node) then
-Prefix_Node := Designator_Node;
- else
-Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
-Set_Prefix (Selector_Node, Prefix_Node);
-Set_Selector_Name (Selector_Node, Designator_Node);
-Prefix_Node := Selector_Node;
- end if;
-
- Dot_Sloc := Token_Ptr;
- Scan; -- past dot
- end loop;
-
- -- Fall out of the loop having just scanned a designator
-
- if No (Prefix_Node) then
- return Designator_Node;
- else
- Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
- Set_Prefix (Selector_Node, Prefix_Node);
- Set_Selector_Name (Selector_Node, Designator_Node);
- return Selector_Node;
- end if;
-
- exception
- when Error_Resync =>
- return Error;
- end P_Function_Name;
-
- -- This function parses a restricted form of Names which are either
- -- identifiers, or identifiers preceded by a sequence of prefixes
- -- that are direct names.
-
- -- Error recovery: cannot raise Error_Resync
-
function P_Qualified_Simple_Name return Node_Id is
begin
return P_Qualified_Simple_Name_Resync;
@@ -1019,7 +956,7 @@ package body Ch4 is
Dot_Sloc: Source_Ptr := No_Location;
begin
- -- Prefix node is set to the gathered prefix so far, Empty means that
+ -- Prefix_Node is set to the gathered prefix so far, Empty means that
-- no prefix has been scanned. This allows us to build up the result
-- in the required right recursive manner.
@@ -1030,21 +967,13 @@ package body Ch4 is
loop
Designator_Node := Token_Node;
- if Token = Tok_Identifier then
-Scan; -- past identifier
-exit when Token /= Tok_Dot;
-
- elsif Token not in Token_Class_Desig then
+ if Token not in Token_Class_Desig then
Discard_Junk_Node (P_Identifier); -- to issue the error message
raise Error_Resync;
else
Scan; -- past designator
-
-if Token /= Tok_Dot then
- Error_Msg_SP ("identifier expected");
-
[gcc r16-1327] ada: Back out removal of renaming tranformation
https://gcc.gnu.org/g:027457ded6416c36f5b76a24153a69b7ff3f2f0e commit r16-1327-g027457ded6416c36f5b76a24153a69b7ff3f2f0e Author: Bob Duff Date: Thu Mar 6 14:21:51 2025 -0500 ada: Back out removal of renaming tranformation A previous change (commit 33eebd96d27fa2b29cec79f55167a11aaf7f4802) removed code in Analyze_Object_Renaming that tranformed renamings into object declarations. This reinstates that code. Removing the code causes failures in gnatbugs-large/2023/gnat-435_deep_blue_capital. Ideally, we SHOULD remove that transformation at some point, but that will require further changes. gcc/ada/ChangeLog: * exp_ch6.adb: (Make_Build_In_Place_Call_In_Object_Declaration): Deal with renamings transformed into object declarations. * sem_ch8.adb (Analyze_Object_Renaming): Reinstate transformation of a renaming into an object declaration. Diff: --- gcc/ada/exp_ch6.adb | 6 ++ gcc/ada/sem_ch8.adb | 23 +++ 2 files changed, 29 insertions(+) diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 84847377bf33..3a45b1c59340 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -8819,6 +8819,8 @@ package body Exp_Ch6 is Constraint_Check_Needed : constant Boolean := (Has_Discriminants (Obj_Typ) or else Is_Array_Type (Obj_Typ)) and then Is_Tagged_Type (Obj_Typ) + and then Nkind (Original_Node (Obj_Decl)) /= +N_Object_Renaming_Declaration and then Is_Constrained (Obj_Typ); -- We are processing a call in the context of something like -- "X : T := F (...);". This is True if we need to do a constraint @@ -8828,6 +8830,10 @@ package body Exp_Ch6 is -- which is possible only in the callee-allocates case, -- which is why we have Is_Tagged_Type above. -- ???The check is missing in the untagged caller-allocates case. + -- ???The check for renaming declarations above is needed because + -- Sem_Ch8.Analyze_Object_Renaming sometimes changes a renaming + -- into an object declaration. We probably shouldn't do that, + -- but for now, we need this check. -- Start of processing for Make_Build_In_Place_Call_In_Object_Declaration diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 4ed0598bcec9..db892d0a5bef 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -1149,6 +1149,29 @@ package body Sem_Ch8 is Resolve (Nam, T); + -- If the renamed object is a function call of a limited type, + -- the expansion of the renaming is complicated by the presence + -- of various temporaries and subtypes that capture constraints + -- of the renamed object. Rewrite node as an object declaration, + -- whose expansion is simpler. Given that the object is limited + -- there is no copy involved and no performance hit. + + if Nkind (Nam) = N_Function_Call + and then Is_Inherently_Limited_Type (Etype (Nam)) + and then not Is_Constrained (Etype (Nam)) + and then Comes_From_Source (N) + then +Set_Etype (Id, T); +Mutate_Ekind (Id, E_Constant); +Rewrite (N, + Make_Object_Declaration (Loc, +Defining_Identifier => Id, +Constant_Present=> True, +Object_Definition => New_Occurrence_Of (Etype (Nam), Loc), +Expression => Relocate_Node (Nam))); +return; + end if; + -- Ada 2012 (AI05-149): Reject renaming of an anonymous access object -- when renaming declaration has a named access type. The Ada 2012 -- coverage rules allow an anonymous access type in the context of
[gcc r16-1328] ada: Restrict Overlays_Constant flag to selected entities
https://gcc.gnu.org/g:4413a6312672a2b2e37244828deec622d40cd03f commit r16-1328-g4413a6312672a2b2e37244828deec622d40cd03f Author: Eric Botcazou Date: Fri Mar 7 09:36:45 2025 +0100 ada: Restrict Overlays_Constant flag to selected entities Namely E_Constant and E_Variable entities. gcc/ada/ChangeLog: * einfo.ads (Overlays_Constant): Define in constants and variables. * gen_il-gen-gen_entities.adb (Entity_Kind): Move Overlays_Constant semantic flag to... (Constant_Or_Variable_Kind): ...here. * sem_util.adb (Note_Possible_Modification): Add guard. Diff: --- gcc/ada/einfo.ads | 10 +- gcc/ada/gen_il-gen-gen_entities.adb | 2 +- gcc/ada/sem_util.adb| 1 + 3 files changed, 7 insertions(+), 6 deletions(-) diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 545c15de24a2..1cbac6d9a7d7 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -3927,9 +3927,8 @@ package Einfo is -- Points to the component in the base type. --Overlays_Constant --- Defined in all entities. Set only for E_Constant or E_Variable for --- which there is an address clause that causes the entity to overlay --- a constant object. +-- Defined in constants and variables. Set if there is an address clause +-- that causes the entity to overlay a constant object. --Overridden_Operation -- Defined in subprograms. For overriding operations, points to the @@ -4961,7 +4960,6 @@ package Einfo is --Materialize_Entity --Needs_Debug_Info --Never_Set_In_Source - --Overlays_Constant --Referenced --Referenced_As_LHS --Referenced_As_Out_Parameter @@ -5288,7 +5286,7 @@ package Einfo is --Interface_Name(constants only) --Related_Type (constants only) --Initialization_Statements - --BIP_Initialization_Call + --BIP_Initialization_Call (constants only) --Finalization_Master_Node --Last_Aggregate_Assignment --Activation_Record_Component @@ -5318,6 +5316,7 @@ package Einfo is --Is_Volatile_Full_Access --Optimize_Alignment_Space (constants only) --Optimize_Alignment_Time (constants only) + --Overlays_Constant (constants only) --SPARK_Pragma_Inherited(constants only) --Stores_Attribute_Old_Prefix (constants only) --Treat_As_Volatile @@ -6205,6 +6204,7 @@ package Einfo is --OK_To_Rename --Optimize_Alignment_Space --Optimize_Alignment_Time + --Overlays_Constant --SPARK_Pragma_Inherited --Suppress_Initialization --Treat_As_Volatile diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb index bfa634f8a692..8af261ac0364 100644 --- a/gcc/ada/gen_il-gen-gen_entities.adb +++ b/gcc/ada/gen_il-gen-gen_entities.adb @@ -215,7 +215,6 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (May_Inherit_Delayed_Rep_Aspects, Flag), Sm (Needs_Debug_Info, Flag), Sm (Never_Set_In_Source, Flag), -Sm (Overlays_Constant, Flag), Sm (Prev_Entity, Node_Id), Sm (Referenced, Flag), Sm (Referenced_As_LHS, Flag), @@ -353,6 +352,7 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Last_Aggregate_Assignment, Node_Id), Sm (Optimize_Alignment_Space, Flag), Sm (Optimize_Alignment_Time, Flag), +Sm (Overlays_Constant, Flag), Sm (Prival_Link, Node_Id), Sm (Related_Type, Node_Id), Sm (Return_Statement, Node_Id), diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index c74c10f2b5f6..2b7296b67e8c 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -25586,6 +25586,7 @@ package body Sem_Util is if Sure and then Modification_Comes_From_Source + and then Ekind (Ent) in E_Constant | E_Variable and then Overlays_Constant (Ent) and then Address_Clause_Overlay_Warnings then
[gcc r16-1329] ada: Simplify handling of selected components as name references
https://gcc.gnu.org/g:0ab32e590fa97e7dc54e171f1a7b5f9b7069c309 commit r16-1329-g0ab32e590fa97e7dc54e171f1a7b5f9b7069c309 Author: Piotr Trojanek Date: Fri Mar 7 12:08:44 2025 +0100 ada: Simplify handling of selected components as name references The selector_name of a selected_component always points to an identifier than is an object name, i.e. specifically, name of a component or discriminant. There is no need to examine this. Code cleanup; behavior is unaffected. gcc/ada/ChangeLog: * sem_util.adb (Is_Name_Reference): Remove check for selector_name of a selected_component; reuse existing code for indexed components and slices. (Statically_Names_Object): Remove dead code. Diff: --- gcc/ada/sem_util.adb | 14 +- 1 file changed, 1 insertion(+), 13 deletions(-) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 2b7296b67e8c..3c80d236af81 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -18375,6 +18375,7 @@ package body Sem_Util is case Nkind (N) is when N_Indexed_Component +| N_Selected_Component | N_Slice => return @@ -18386,13 +18387,6 @@ package body Sem_Util is when N_Attribute_Reference => return Attribute_Name (N) in Name_Input | Name_Old | Name_Result; - when N_Selected_Component => -return - Is_Name_Reference (Selector_Name (N)) -and then - (Is_Name_Reference (Prefix (N)) -or else Is_Access_Type (Etype (Prefix (N; - when N_Explicit_Dereference => return True; @@ -28517,12 +28511,6 @@ package body Sem_Util is return False; end if; -if Ekind (Entity (Selector_Name (N))) not in - E_Component | E_Discriminant -then - return False; -end if; - declare Comp : constant Entity_Id := Original_Record_Component (Entity (Selector_Name (N)));
[gcc r16-1323] ada: Do not build dispatch tables for generics
https://gcc.gnu.org/g:31b7b7518e5842509e8fdbef6dc38e6a4ce28396 commit r16-1323-g31b7b7518e5842509e8fdbef6dc38e6a4ce28396 Author: Ronan Desplanques Date: Wed Mar 5 16:18:49 2025 +0100 ada: Do not build dispatch tables for generics Before this patch, Build_Static_Dispatch_Tables was called on generic package bodies. While this has not been proved to cause any actual bug, it was clearly inappropriate and also useless, so this patch removes those calls. gcc/ada/ChangeLog: * sem_ch10.adb (Analyze_Compilation_Unit): Check for generic bodies. * exp_disp.adb (Build_Dispatch_Tables): Likewise. Diff: --- gcc/ada/exp_disp.adb | 4 +++- gcc/ada/sem_ch10.adb | 8 +++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 458b32c1730e..080a2e1a6c16 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -413,7 +413,9 @@ package body Exp_Disp is if Nkind (D) = N_Package_Declaration then Build_Package_Dispatch_Tables (D); -elsif Nkind (D) = N_Package_Body then +elsif Nkind (D) = N_Package_Body + and then Ekind (Corresponding_Spec (D)) /= E_Generic_Package +then Build_Dispatch_Tables (Declarations (D)); elsif Nkind (D) = N_Package_Body_Stub diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 25bba9b60759..45aabadf21f8 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -1225,9 +1225,15 @@ package body Sem_Ch10 is if Expander_Active and then Tagged_Type_Expansion then case Nkind (Unit_Node) is -when N_Package_Declaration | N_Package_Body => +when N_Package_Declaration => Build_Static_Dispatch_Tables (Unit_Node); +when N_Package_Body => + if Ekind (Corresponding_Spec (Unit_Node)) /= E_Generic_Package + then + Build_Static_Dispatch_Tables (Unit_Node); + end if; + when N_Package_Instantiation => Build_Static_Dispatch_Tables (Instance_Spec (Unit_Node));
[gcc r16-1325] ada: Tweak error recovery path
https://gcc.gnu.org/g:e9066cf788e689a119a068ecf38e17c666bfb6a4
commit r16-1325-ge9066cf788e689a119a068ecf38e17c666bfb6a4
Author: Ronan Desplanques
Date: Thu Mar 6 12:54:44 2025 +0100
ada: Tweak error recovery path
Before this patch, the constant mark of object declarations was stripped
in some error situations. This behavior is currently not useful so this
patch removes it.
gcc/ada/ChangeLog:
* sem_ch3.adb (Analyze_Object_Declaration): Tweak error handling.
Diff:
---
gcc/ada/sem_ch3.adb | 1 -
1 file changed, 1 deletion(-)
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index a8764db65032..4161ce39fa3e 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -4552,7 +4552,6 @@ package body Sem_Ch3 is
Error_Msg_N
("\declaration requires an initialization expression",
N);
-Set_Constant_Present (N, False);
-- In Ada 83, deferred constant must be of private type
[gcc r16-1315] ada: Check validity using signedness from the type and not its base type
https://gcc.gnu.org/g:bba4596132cb75d2892e7475aa67d32e15439c39 commit r16-1315-gbba4596132cb75d2892e7475aa67d32e15439c39 Author: Piotr Trojanek Date: Tue Mar 4 12:33:34 2025 +0100 ada: Check validity using signedness from the type and not its base type When attribute Valid is applied to a private type, we used the signedness of its implementation base type which wrongly included negative values. gcc/ada/ChangeLog: * exp_attr.adb (Expand_N_Attribute_Reference): When expanding attribute Valid, use signedness from the validated view, not from its base type. Diff: --- gcc/ada/exp_attr.adb | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index f1f8424d7202..3d1bff93b408 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -8183,9 +8183,8 @@ package body Exp_Attr is else declare Uns : constant Boolean := -Is_Unsigned_Type (Ptyp) - or else (Is_Private_Type (Ptyp) -and then Is_Unsigned_Type (PBtyp)); + Is_Unsigned_Type (Validated_View (Ptyp)); + Size : Uint; P: Node_Id := Pref;
[gcc r16-1309] ada: Remove incorrect comment
https://gcc.gnu.org/g:9334a4a2c5ecfb56997a38030a8963f4462e7436 commit r16-1309-g9334a4a2c5ecfb56997a38030a8963f4462e7436 Author: Ronan Desplanques Date: Fri Feb 28 12:24:04 2025 +0100 ada: Remove incorrect comment This patchs removes a comment that was incorrect, as noted by a ??? comment that was right after and that this patch also removes. gcc/ada/ChangeLog: * atree.ads (Rewrite): Remove comment. Diff: --- gcc/ada/atree.ads | 6 +- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index c8cc2bcf0c4f..142616921421 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -536,11 +536,7 @@ package Atree is procedure Rewrite (Old_Node, New_Node : Node_Id); -- This is used when a complete subtree is to be replaced. Old_Node is the -- root of the old subtree to be replaced, and New_Node is the root of the - -- newly constructed replacement subtree. The actual mechanism is to swap - -- the contents of these two nodes fixing up the parent pointers of the - -- replaced node (we do not attempt to preserve parent pointers for the - -- original node). - -- ??? The above explanation is incorrect, instead Copy_Node is called. + -- newly constructed replacement subtree. -- -- Note: New_Node may not contain references to Old_Node, for example as -- descendants, since the rewrite would make such references invalid. If
[gcc r16-1318] ada: Remove misleading comment
https://gcc.gnu.org/g:ff9781d1dc58f6a015c51bedc655ceaa3858b62d commit r16-1318-gff9781d1dc58f6a015c51bedc655ceaa3858b62d Author: Ronan Desplanques Date: Tue Mar 4 14:24:32 2025 +0100 ada: Remove misleading comment This patch removes a comment that misleadingly presented a condition as being met only in rare situations, while it's in fact satisfied in very basic cases such as simple object declarations. gcc/ada/ChangeLog: * sem_util.adb (Enter_Name): Remove comment. Diff: --- gcc/ada/sem_util.adb | 3 --- 1 file changed, 3 deletions(-) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 40e3da36c201..523aff33f95a 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -8089,9 +8089,6 @@ package body Sem_Util is if Ekind (Def_Id) in E_Discriminant | E_Component then null; - -- If a type is already set, leave it alone (happens when a type - -- declaration is reanalyzed following a call to the optimizer). - elsif Present (Etype (Def_Id)) then null;
[gcc r16-1321] ada: Pragma Ada_XX not propagated from library level spec to body
https://gcc.gnu.org/g:108e346ced2a5589b90577f25c9559a61ae95eb9 commit r16-1321-g108e346ced2a5589b90577f25c9559a61ae95eb9 Author: Javier Miranda Date: Mon Mar 3 11:34:35 2025 + ada: Pragma Ada_XX not propagated from library level spec to body Add documentation to pragmas Ada_83, Ada_95, Ada_05, Ada_12, and Ada_2022: when placed before a library level package specification they are not propagated to the corresponding package body; they must be added explicitly to the package body. gcc/ada/ChangeLog: * doc/gnat_rm/implementation_defined_pragmas.rst: Adding documentation. * doc/gnat_ugn/the_gnat_compilation_model.rst: ditto. * gnat_rm.texi: Regenerate. * gnat_ugn.texi: Regenerate. Diff: --- .../doc/gnat_rm/implementation_defined_pragmas.rst | 25 ++ .../doc/gnat_ugn/the_gnat_compilation_model.rst| 4 gcc/ada/gnat_rm.texi | 25 ++ gcc/ada/gnat_ugn.texi | 6 +- 4 files changed, 59 insertions(+), 1 deletion(-) diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst index cae8c168562b..02013f1d9b12 100644 --- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst @@ -123,6 +123,11 @@ and generics may name types with unknown discriminants without using the ``(<>)`` notation. In addition, some but not all of the additional restrictions of Ada 83 are enforced. +Like all configuration pragmas, if the pragma is placed before a library +level package specification it is not propagated to the corresponding +package body (see RM 10.1.5(8)); it must be added explicitly to the +package body. + Ada 83 mode is intended for two purposes. Firstly, it allows existing Ada 83 code to be compiled and adapted to GNAT with less effort. Secondly, it aids in keeping code backwards compatible with Ada 83. @@ -149,6 +154,11 @@ contexts. This pragma is useful when writing a reusable component that itself uses Ada 95 features, but which is intended to be usable from either Ada 83 or Ada 95 programs. +Like all configuration pragmas, if the pragma is placed before a library +level package specification it is not propagated to the corresponding +package body (see RM 10.1.5(8)); it must be added explicitly to the +package body. + Pragma Ada_05 = @@ -166,6 +176,11 @@ This pragma is useful when writing a reusable component that itself uses Ada 2005 features, but which is intended to be usable from either Ada 83 or Ada 95 programs. +Like all configuration pragmas, if the pragma is placed before a library +level package specification it is not propagated to the corresponding +package body (see RM 10.1.5(8)); it must be added explicitly to the +package body. + The one argument form (which is not a configuration pragma) is used for managing the transition from Ada 95 to Ada 2005 in the run-time library. If an entity is marked @@ -209,6 +224,11 @@ contexts. This pragma is useful when writing a reusable component that itself uses Ada 2012 features, but which is intended to be usable from Ada 83, Ada 95, or Ada 2005 programs. +Like all configuration pragmas, if the pragma is placed before a library +level package specification it is not propagated to the corresponding +package body (see RM 10.1.5(8)); it must be added explicitly to the +package body. + The one argument form, which is not a configuration pragma, is used for managing the transition from Ada 2005 to Ada 2012 in the run-time library. If an entity is marked @@ -252,6 +272,11 @@ contexts. This pragma is useful when writing a reusable component that itself uses Ada 2022 features, but which is intended to be usable from Ada 83, Ada 95, Ada 2005 or Ada 2012 programs. +Like all configuration pragmas, if the pragma is placed before a library +level package specification it is not propagated to the corresponding +package body (see RM 10.1.5(8)); it must be added explicitly to the +package body. + The one argument form, which is not a configuration pragma, is used for managing the transition from Ada 2012 to Ada 2022 in the run-time library. If an entity is marked diff --git a/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst b/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst index 64a363132c71..891886b53601 100644 --- a/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst +++ b/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst @@ -1477,6 +1477,10 @@ You can place configuration pragmas either appear at the start of a compilation unit or in a configuration pragma file that applies to all compilations performed in a given compilation environment. +Configuration pragmas placed before a library level package specification +are not propagated to the corresponding package body (se
[gcc r16-1322] ada: Tune recent change for warning about unsupported overlays
https://gcc.gnu.org/g:7f31b28fe199e35a9f19cf1b15e632880a6d7706 commit r16-1322-g7f31b28fe199e35a9f19cf1b15e632880a6d7706 Author: Piotr Trojanek Date: Wed Mar 5 11:19:22 2025 +0100 ada: Tune recent change for warning about unsupported overlays Fix crash occurring when overlay applies to protected component and expansion is disabled, e.g. because of semantic checking mode (switch -gnatc) or because the compiler is running in GNATprove mode. Also, simply pick the type of overlaid object from the attribute prefix itself. gcc/ada/ChangeLog: * sem_util.adb (Find_Overlaid_Entity): Don't call Etype on empty Ent; tune style; move computation of Overl_Typ out of the loop. Diff: --- gcc/ada/sem_util.adb | 30 ++ 1 file changed, 6 insertions(+), 24 deletions(-) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 59bf060ee740..c74c10f2b5f6 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -8935,9 +8935,9 @@ package body Sem_Util is -- In the second case, the expr is either Y'Address, or recursively a -- constant that eventually references Y'Address. - Ent := Empty; + Ent := Empty; Ovrl_Typ := Empty; - Off := False; + Off := False; Expr := Expression (N); @@ -8967,6 +8967,8 @@ package body Sem_Util is end if; end loop; + Ovrl_Typ := Etype (Expr); + -- This loop checks the form of the prefix for an entity, using -- recursion to deal with intermediate components. @@ -8985,11 +8987,8 @@ package body Sem_Util is pragma Assert (not Expander_Active and then Is_Concurrent_Type (Scope (Ent))); - Ent := Empty; -end if; - -if No (Ovrl_Typ) then - Ovrl_Typ := Etype (Ent); + Ent := Empty; + Ovrl_Typ := Empty; end if; return; @@ -8997,23 +8996,6 @@ package body Sem_Util is -- Check for components elsif Nkind (Expr) in N_Selected_Component | N_Indexed_Component then -if Nkind (Expr) = N_Selected_Component then - -- If Something.Other'Address, use - -- the Etype of the Other component. - - if No (Ovrl_Typ) then - Ovrl_Typ := Etype (Entity (Selector_Name (Expr))); - end if; - -else - -- If Something(Index)'Address, use - -- the Etype of the array component. - - if No (Ovrl_Typ) then - Ovrl_Typ := Etype (Expr); - end if; -end if; - Expr := Prefix (Expr); Off := True;
[gcc r16-1317] ada: Constraint check on tagged build-in-place object decls
https://gcc.gnu.org/g:a23938b3a7d7dd7a3dcb3216ec0de4a24a1ff069 commit r16-1317-ga23938b3a7d7dd7a3dcb3216ec0de4a24a1ff069 Author: Bob Duff Date: Tue Mar 4 14:47:41 2025 -0500 ada: Constraint check on tagged build-in-place object decls In the case of "X : T := F (...);", where T is a constrained discriminated tagged subtype, perform a constraint check after F returns. The result of F is allocated by the callee on the secondary stack in this case. Note that there are still missing checks for some build-in-place calls. gcc/ada/ChangeLog: * exp_ch6.adb: Remove a couple of "???" suggesting something that we will likely never do. (Make_Build_In_Place_Call_In_Object_Declaration): When a constraint check is needed, do the check. Do it at the call site for now. The check is still missing in the untagged case, because the caller allocates in that case. * sem_ch8.adb (Analyze_Object_Renaming): Remove obsolete transformation of a renaming into an object declaration. Given that we also (sometimes) tranform object declarations into renamings, this transformation was adding complexity; the new code in Make_Build_In_Place_Call_In_Object_Declaration above would need to explicitly avoid the run-time check in the case of renamings, because renamings are supposed to ignore the nominal subtype. Anyway, it is no longer needed. * exp_ch3.adb (Expand_N_Object_Declaration): Rewrite comment; it IS clear how to do it, but we haven't done it right yet. Diff: --- gcc/ada/exp_ch3.adb | 5 +++-- gcc/ada/exp_ch6.adb | 41 +++-- gcc/ada/sem_ch8.adb | 23 --- 3 files changed, 30 insertions(+), 39 deletions(-) diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index d884e755d66b..cf2238e9ee19 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -8741,8 +8741,9 @@ package body Exp_Ch3 is -- be illegal in some cases (such as converting access- -- to-unconstrained to access-to-constrained), but the -- the unchecked conversion will presumably fail to work - -- right in just such cases. It's not clear at all how to - -- handle this. + -- right in just such cases. In order to handle this + -- properly, in the Caller_Allocation case, the callee + -- needs to do the constraint check. Alloc_Stmt := Make_If_Statement (Loc, diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index f85d977d0d80..84847377bf33 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -158,7 +158,7 @@ package body Exp_Ch6 is Alloc_Form_Exp : Node_Id := Empty; Pool_Exp : Node_Id := Empty); -- Ada 2005 (AI-318-02): If the result type of a build-in-place call needs - -- them, add the actuals parameters BIP_Alloc_Form and BIP_Storage_Pool. + -- them, add the actual parameters BIP_Alloc_Form and BIP_Storage_Pool. -- If Alloc_Form_Exp is present, then pass it for the first parameter, -- otherwise pass a literal corresponding to the Alloc_Form parameter -- (which must not be Unspecified in that case). If Pool_Exp is present, @@ -442,9 +442,7 @@ package body Exp_Ch6 is return; end if; - -- Locate the implicit allocation form parameter in the called function. - -- Maybe it would be better for each implicit formal of a build-in-place - -- function to have a flag or a Uint attribute to identify it. ??? + -- Locate the implicit allocation form parameter in the called function Alloc_Form_Formal := Build_In_Place_Formal (Function_Id, BIP_Alloc_Form); @@ -928,9 +926,6 @@ package body Exp_Ch6 is Formal_Suffix : constant String := BIP_Formal_Suffix (Kind); begin - -- Maybe it would be better for each implicit formal of a build-in-place - -- function to have a flag or a Uint attribute to identify it. ??? - -- The return type in the function declaration may have been a limited -- view, and the extra formals for the function were not generated at -- that point. At the point of call the full view must be available and @@ -8821,6 +8816,19 @@ package body Exp_Ch6 is and then not Has_Foreign_Convention (Return_Applies_To (Scope (Obj_Def_Id))); + Constraint_Check_Needed : constant Boolean := +(Has_Discriminants (Obj_Typ) or else Is_Array_Type (Obj_Typ)) + and then Is_Tagged_Type (Obj_Typ) + and then Is_Constrained (Obj_Typ); + -- We are processing a call in the context of something like + -- "X : T := F (...);". This is True if we need
[gcc r16-1308] ada: Improve readability in Atree.Rewrite body
https://gcc.gnu.org/g:880e6752ad94fe0b690fbe39b49e1d6db026db12 commit r16-1308-g880e6752ad94fe0b690fbe39b49e1d6db026db12 Author: Ronan Desplanques Date: Fri Feb 28 12:19:12 2025 +0100 ada: Improve readability in Atree.Rewrite body This patch visually packs together the statements that implement the exceptions in Rewrite that a few fields are not actually overwritten, in order to improve the readability of the code. gcc/ada/ChangeLog: * atree.adb (Rewrite): Improve readability. Diff: --- gcc/ada/atree.adb | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 8a69a0c224de..3fa55a7fc653 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -2271,10 +2271,10 @@ package body Atree is -- Copy substitute node into place, preserving old fields as required Copy_Node (Source => New_Node, Destination => Old_Node); - Set_Error_Posted (Old_Node, Old_Error_Posted); Set_Check_Actuals (Old_Node, Old_CA); Set_Is_Ignored_Ghost_Node (Old_Node, Old_Is_IGN); + Set_Error_Posted (Old_Node, Old_Error_Posted); if Nkind (New_Node) in N_Subexpr then Set_Paren_Count (Old_Node, Old_Paren_Count);
[gcc r16-1314] ada: Emit more warnings on unsupported overlay
https://gcc.gnu.org/g:5069485475173307d5144c60d63651ca3b56b6fb
commit r16-1314-g5069485475173307d5144c60d63651ca3b56b6fb
Author: Marc Poulhiès
Date: Tue Feb 25 16:50:04 2025 +0100
ada: Emit more warnings on unsupported overlay
In the case where the overlaid object is nested in a record or is an
array element as in:
for Foo'Address use Item.Nested_Item'Address;
or for Foo'Address use Item (Bar)'Address;
the compiler was not emitting a warning in case of differing
Scalar_Storage_Order values.
gcc/ada/ChangeLog:
* sem_util.adb (Find_Overlaid_Entity): Add extra parameter to
extract the type being overlaid.
(Note_Possible_Modification): Adjust call to Find_Overlaid_Entity.
(Ultimate_Overlaid_Entity): Likewise.
* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Likewise.
* sem_util.ads (Find_Overlaid_Entity): Add extra parameter to
extract the type being overlaid.
* freeze.adb (Check_Address_Clause): Likewise.
Diff:
---
gcc/ada/freeze.adb | 3 ++-
gcc/ada/sem_ch13.adb | 9 +
gcc/ada/sem_util.adb | 42 ++
gcc/ada/sem_util.ads | 10 +++---
4 files changed, 48 insertions(+), 16 deletions(-)
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index ec0fb16e741e..ce9a97422746 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -715,10 +715,11 @@ package body Freeze is
then
declare
O_Ent : Entity_Id;
+ O_Typ : Entity_Id;
Off : Boolean;
begin
- Find_Overlaid_Entity (Addr, O_Ent, Off);
+ Find_Overlaid_Entity (Addr, O_Ent, O_Typ, Off);
if Ekind (O_Ent) = E_Constant
and then Etype (O_Ent) = Typ
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 76a8c0ba7331..22575f9cbf5f 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -6208,6 +6208,7 @@ package body Sem_Ch13 is
declare
Expr : constant Node_Id := Expression (N);
O_Ent : Entity_Id;
+ O_Typ : Entity_Id;
Off : Boolean;
begin
@@ -6220,7 +6221,7 @@ package body Sem_Ch13 is
return;
end if;
- Find_Overlaid_Entity (N, O_Ent, Off);
+ Find_Overlaid_Entity (N, O_Ent, O_Typ, Off);
if Present (O_Ent) then
@@ -6273,10 +6274,10 @@ package body Sem_Ch13 is
if (Is_Record_Type (Etype (U_Ent))
or else Is_Array_Type (Etype (U_Ent)))
- and then (Is_Record_Type (Etype (O_Ent))
- or else Is_Array_Type (Etype (O_Ent)))
+ and then (Is_Record_Type (O_Typ)
+ or else Is_Array_Type (O_Typ))
and then Reverse_Storage_Order (Etype (U_Ent)) /=
-Reverse_Storage_Order (Etype (O_Ent))
+Reverse_Storage_Order (O_Typ)
then
Error_Msg_N
("??overlay changes scalar storage order", Expr);
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 02ebb71b562c..40e3da36c201 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -8923,9 +8923,10 @@ package body Sem_Util is
--
procedure Find_Overlaid_Entity
- (N : Node_Id;
- Ent : out Entity_Id;
- Off : out Boolean)
+ (N: Node_Id;
+ Ent : out Entity_Id;
+ Ovrl_Typ : out Entity_Id;
+ Off : out Boolean)
is
pragma Assert
(Nkind (N) = N_Attribute_Definition_Clause
@@ -8948,6 +8949,7 @@ package body Sem_Util is
-- constant that eventually references Y'Address.
Ent := Empty;
+ Ovrl_Typ := Empty;
Off := False;
Expr := Expression (N);
@@ -8998,11 +9000,33 @@ package body Sem_Util is
and then Is_Concurrent_Type (Scope (Ent)));
Ent := Empty;
end if;
+
+if No (Ovrl_Typ) then
+ Ovrl_Typ := Etype (Ent);
+end if;
+
return;
-- Check for components
elsif Nkind (Expr) in N_Selected_Component | N_Indexed_Component then
+if Nkind (Expr) = N_Selected_Component then
+ -- If Something.Other'Address, use
+ -- the Etype of the Other component.
+
+ if No (Ovrl_Typ) then
+ Ovrl_Typ := Etype (Entity (Selector_Name (Expr)));
+ end if;
+
+else
+ -- If Something(Index)'Address, use
+ -- the Etype of the array component.
+
+ if No (Ovrl_Typ) then
+
[gcc r16-1310] ada: Clarify warning in Atree.Rewrite documentation
https://gcc.gnu.org/g:8577f2ebef69b4c6a15ca9db2a93acbb2eccb73f commit r16-1310-g8577f2ebef69b4c6a15ca9db2a93acbb2eccb73f Author: Ronan Desplanques Date: Fri Feb 28 12:25:20 2025 +0100 ada: Clarify warning in Atree.Rewrite documentation The documentation of Atree.Rewrite warns about a potential misuse of that subprogram. This patch makes the text of that warning more specific. The documentation of Atree.Replace had the same note but this patch replaces it with a mention of the one in Rewrite's documentation. gcc/ada/ChangeLog: * atree.ads (Rewrite, Replace): Clarify comments. Diff: --- gcc/ada/atree.ads | 13 ++--- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index 142616921421..760c63b9bea1 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -539,9 +539,10 @@ package Atree is -- newly constructed replacement subtree. -- -- Note: New_Node may not contain references to Old_Node, for example as - -- descendants, since the rewrite would make such references invalid. If - -- New_Node does need to reference Old_Node, then these references should - -- be to a relocated copy of Old_Node (see Relocate_Node procedure). + -- descendants, since the rewrite would turn them into cyclic + -- self-references. If New_Node does need to reference Old_Node, then these + -- references should be to a relocated copy of Old_Node (see Relocate_Node + -- procedure). -- -- Note: The Original_Node function applied to Old_Node (which has now -- been replaced by the contents of New_Node), can be used to obtain the @@ -555,10 +556,8 @@ package Atree is -- original contents of the Old_Node, but rather the New_Node value. -- Replace also preserves the setting of Comes_From_Source. -- - -- Note that New_Node must not contain references to Old_Node, for example - -- as descendants, since the rewrite would make such references invalid. If - -- New_Node does need to reference Old_Node, then these references should - -- be to a relocated copy of Old_Node (see Relocate_Node procedure). + -- The note in the documentation of Rewrite about the risk of creating + -- cyclic references also applies here. -- -- Replace is used in certain circumstances where it is desirable to -- suppress any history of the rewriting operation. Notably, it is used
[gcc r16-1316] ada: Remove incorrect bits in Copy_Node documentation
https://gcc.gnu.org/g:95da1ec42b9debc0c7c0ee1508dbc1493852b200 commit r16-1316-g95da1ec42b9debc0c7c0ee1508dbc1493852b200 Author: Ronan Desplanques Date: Fri Feb 28 11:50:30 2025 +0100 ada: Remove incorrect bits in Copy_Node documentation This patch removes a leftover reference to the concept of node extension and a note about aspect specification that's been incorrect since at least the latest rework of aspect specification representation. gcc/ada/ChangeLog: * atree.ads (Copy_Node): Fix comment. Diff: --- gcc/ada/atree.ads | 14 +- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index 760c63b9bea1..615d040c90a3 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -285,15 +285,11 @@ package Atree is procedure Copy_Node (Source, Destination : Node_Or_Entity_Id); -- Copy the entire contents of the source node to the destination node. - -- The contents of the source node is not affected. If the source node - -- has an extension, then the destination must have an extension also. - -- The parent pointer of the destination and its list link, if any, are - -- not affected by the copy. Note that parent pointers of descendants - -- are not adjusted, so the descendants of the destination node after - -- the Copy_Node is completed have dubious parent pointers. Note that - -- this routine does NOT copy aspect specifications, the Has_Aspects - -- flag in the returned node will always be False. The caller must deal - -- with copying aspect specifications where this is required. + -- The contents of the source node is not affected. The parent pointer of + -- the destination and its list link, if any, are not affected by the copy. + -- Note that parent pointers of descendants are not adjusted, so the + -- descendants of the destination node after the Copy_Node is completed + -- have dubious parent pointers. function New_Copy (Source : Node_Id) return Node_Id; -- This function allocates a new node, and then initializes it by copying
[gcc r16-1320] ada: Remove redundant error checking
https://gcc.gnu.org/g:fefac6864133950da1c61ab81c56bc3c68a57fcb
commit r16-1320-gfefac6864133950da1c61ab81c56bc3c68a57fcb
Author: Ronan Desplanques
Date: Tue Mar 4 13:16:39 2025 +0100
ada: Remove redundant error checking
This patch removes a test for a condition that can never be false.
gcc/ada/ChangeLog:
* sem_attr.adb (Analyze_Attribute): Remove test.
Diff:
---
gcc/ada/sem_attr.adb | 18 +++---
1 file changed, 7 insertions(+), 11 deletions(-)
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index bf4d68447c96..d4034d28da60 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -5693,19 +5693,15 @@ package body Sem_Attr is
when Attribute_Partition_ID =>
Check_E0;
- if P_Type /= Any_Type then
-if not Is_Library_Level_Entity (Entity (P)) then
- Error_Attr_P
- ("prefix of % attribute must be library-level entity");
+ if not Is_Library_Level_Entity (Entity (P)) then
+Error_Attr_P
+ ("prefix of % attribute must be library-level entity");
--- The defining entity of prefix should not be declared inside a
--- Pure unit. RM E.1(8). Is_Pure was set during declaration.
+ -- The defining entity of prefix should not be declared inside a
+ -- Pure unit. RM E.1(8). Is_Pure was set during declaration.
-elsif Is_Entity_Name (P)
- and then Is_Pure (Entity (P))
-then
- Error_Attr_P ("prefix of% attribute must not be declared pure");
-end if;
+ elsif Is_Entity_Name (P) and then Is_Pure (Entity (P)) then
+Error_Attr_P ("prefix of% attribute must not be declared pure");
end if;
Set_Etype (N, Universal_Integer);
[gcc r16-1335] ada: Missing discriminant check on assignment of Bounded_Vector aggregate
https://gcc.gnu.org/g:ff89e55497f1a36b6a37a43c5837d89d30fe9601 commit r16-1335-gff89e55497f1a36b6a37a43c5837d89d30fe9601 Author: Gary Dismukes Date: Sat Mar 8 01:05:35 2025 + ada: Missing discriminant check on assignment of Bounded_Vector aggregate When a container aggregate for a Bounded_Vector type involves an iterated association that is assigned to a vector object whose capacity (as defined by the Capacity discriminant) is less than the number of elements of the aggregate, Constraint_Error should be raised due to failing a discriminant check on the assignment. But the compiler fails to do proper expansion, plus omits the check, and instead creates a temporary whose capacity is bounded by that of the target vector of the assignment. It attempts to assign all elements of the aggregate to the temporary, resulting in a failure on a call to the Replace_Element operation that assigns past the length of the temporary vector (which can result in a Storage_Error due to a segment violation). This is fixed by ensuring that the temporary object is declared with an unconstrained base subtype rather than the assignment target's constrained subtype. gcc/ada/ChangeLog: * exp_aggr.adb (Expand_Container_Aggregate): Use the Base_Type of the subtype provided by the context as the subtype of the temporary object initialized by the aggregate. Diff: --- gcc/ada/exp_aggr.adb | 11 ++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 5450402f4749..8db15fa6a11d 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -7503,10 +7503,19 @@ package body Exp_Aggr is Set_Assignment_OK (Lhs); Aggr_Code := Build_Container_Aggr_Code (N, Typ, Lhs, Init); + + -- Use the unconstrained base subtype of the subtype provided by + -- the context for declaring the temporary object (which may come + -- from a constrained assignment target), to ensure that the + -- aggregate can be successfully expanded and assigned to the + -- temporary without exceeding its capacity. (Later assignment + -- of the temporary to a target object may result in failing + -- a discriminant check.) + Prepend_To (Aggr_Code, Make_Object_Declaration (Loc, Defining_Identifier => Obj_Id, - Object_Definition => New_Occurrence_Of (Typ, Loc), + Object_Definition => New_Occurrence_Of (Base_Type (Typ), Loc), Expression => Init)); Insert_Actions (N, Aggr_Code);
[gcc r16-1331] ada: Remove duplicated code in parser for Chapter 4
https://gcc.gnu.org/g:5ed1891054f13015719ed7a0d5e1ca799422ae74
commit r16-1331-g5ed1891054f13015719ed7a0d5e1ca799422ae74
Author: Eric Botcazou
Date: Fri Mar 7 17:37:58 2025 +0100
ada: Remove duplicated code in parser for Chapter 4
P_Qualified_Simple_Name and P_Qualified_Simple_Name_Resync contain exactly
the same code, so this change makes the former call the latter.
gcc/ada/ChangeLog:
* par-ch4.adb (P_Name): Remove obsolete references in comments.
(P_Qualified_Simple_Name): Call P_Qualified_Simple_Name_Resync.
(P_Qualified_Simple_Name_Resync): Adjust a couple of comments.
Diff:
---
gcc/ada/par-ch4.adb | 69 +++--
1 file changed, 8 insertions(+), 61 deletions(-)
diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index e6cf93ab3878..1f1366817cc1 100644
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -668,13 +668,13 @@ package body Ch4 is
-- (discrete_range)
- -- This is a slice. This case is handled in LP_State_Init
+ -- This is a slice
-- (expression, expression, ..)
-- This is interpreted as an indexed component, i.e. as a
-- case of a name which can be extended in the normal manner.
- -- This case is handled by LP_State_Name or LP_State_Expr.
+ -- This case is handled by LP_State_Expr.
-- Note: if and case expressions (without an extra level of
-- parentheses) are permitted in this context).
@@ -999,65 +999,8 @@ package body Ch4 is
-- Error recovery: cannot raise Error_Resync
function P_Qualified_Simple_Name return Node_Id is
- Designator_Node : Node_Id;
- Prefix_Node : Node_Id;
- Selector_Node : Node_Id;
- Dot_Sloc: Source_Ptr := No_Location;
-
begin
- -- Prefix node is set to the gathered prefix so far, Empty means that
- -- no prefix has been scanned. This allows us to build up the result
- -- in the required right recursive manner.
-
- Prefix_Node := Empty;
-
- -- Loop through prefixes
-
- loop
- Designator_Node := Token_Node;
-
- if Token = Tok_Identifier then
-Scan; -- past identifier
-exit when Token /= Tok_Dot;
-
- elsif Token not in Token_Class_Desig then
-return P_Identifier; -- let P_Identifier issue the error message
-
- else
-Scan; -- past designator
-
-if Token /= Tok_Dot then
- Error_Msg_SP ("identifier expected");
- return Error;
-end if;
- end if;
-
- -- Here at a dot, with token just before it in Designator_Node
-
- if No (Prefix_Node) then
-Prefix_Node := Designator_Node;
- else
-Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
-Set_Prefix (Selector_Node, Prefix_Node);
-Set_Selector_Name (Selector_Node, Designator_Node);
-Prefix_Node := Selector_Node;
- end if;
-
- Dot_Sloc := Token_Ptr;
- Scan; -- past dot
- end loop;
-
- -- Fall out of the loop having just scanned an identifier
-
- if No (Prefix_Node) then
- return Designator_Node;
- else
- Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
- Set_Prefix (Selector_Node, Prefix_Node);
- Set_Selector_Name (Selector_Node, Designator_Node);
- return Selector_Node;
- end if;
-
+ return P_Qualified_Simple_Name_Resync;
exception
when Error_Resync =>
return Error;
@@ -1076,6 +1019,10 @@ package body Ch4 is
Dot_Sloc: Source_Ptr := No_Location;
begin
+ -- Prefix node is set to the gathered prefix so far, Empty means that
+ -- no prefix has been scanned. This allows us to build up the result
+ -- in the required right recursive manner.
+
Prefix_Node := Empty;
-- Loop through prefixes
@@ -1112,7 +1059,7 @@ package body Ch4 is
end if;
Dot_Sloc := Token_Ptr;
- Scan; -- past period
+ Scan; -- past dot
end loop;
-- Fall out of the loop having just scanned an identifier
[gcc r16-1337] ada: Add null exclusion formal to Process_Subtype
https://gcc.gnu.org/g:83578594c5a68dc27a028191983ee9f3c57436df commit r16-1337-g83578594c5a68dc27a028191983ee9f3c57436df Author: Ronan Desplanques Date: Thu Mar 13 16:28:59 2025 +0100 ada: Add null exclusion formal to Process_Subtype Before this patch, Process_Subtype looked at the parent of its argument to determine whether it was called in a context that excluded null. This patch replaces this lookup with a new formal parameter to Process_Subtype, and updates the calls to it accordingly. gcc/ada/ChangeLog: * sem_ch3.ads (Process_Subtype): Add formal. * sem_ch3.adb (Process_Subtype): Use new formal. (Analyze_Subtype_Declaration, Array_Type_Declaration, Build_Derived_Access_Type): Pass new actual. * sem_ch4.adb (Find_Type_Of_Object): Likewise. Diff: --- gcc/ada/sem_ch3.adb | 78 + gcc/ada/sem_ch3.ads | 9 --- gcc/ada/sem_ch4.adb | 3 ++- 3 files changed, 38 insertions(+), 52 deletions(-) diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 7cec589731fd..6c2d0326c3f9 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -5769,7 +5769,13 @@ package body Sem_Ch3 is Enter_Name (Id); end if; - T := Process_Subtype (Subtype_Indication (N), N, Id, 'P'); + T := +Process_Subtype + (Subtype_Indication (N), + N, + Id, + 'P', + Excludes_Null => Null_Exclusion_Present (N)); -- Class-wide equivalent types of records with unknown discriminants -- involve the generation of an itype which serves as the private view @@ -6586,7 +6592,13 @@ package body Sem_Ch3 is -- Process subtype indication if one is present if Present (Component_Typ) then - Element_Type := Process_Subtype (Component_Typ, P, Related_Id, 'C'); + Element_Type := + Process_Subtype + (Component_Typ, + P, + Related_Id, + 'C', + Excludes_Null => Null_Exclusion_Present (Component_Def)); Set_Etype (Component_Typ, Element_Type); -- Ada 2005 (AI-230): Access Definition case @@ -7202,7 +7214,11 @@ package body Sem_Ch3 is Set_Directly_Designated_Type (Derived_Type, Designated_Type (Parent_Type)); - Subt := Process_Subtype (S, N); + Subt := +Process_Subtype + (S, + N, + Excludes_Null => Null_Exclusion_Present (Type_Definition (N))); if Nkind (S) /= N_Subtype_Indication and then Subt /= Base_Type (Subt) @@ -18826,7 +18842,11 @@ package body Sem_Ch3 is -- Otherwise, the object definition is just a subtype_mark else - T := Process_Subtype (Obj_Def, Related_Nod); + T := + Process_Subtype + (Obj_Def, + Related_Nod, + Excludes_Null => Null_Exclusion_Present (Parent (Obj_Def))); end if; return T; @@ -22501,10 +22521,11 @@ package body Sem_Ch3 is - function Process_Subtype - (S : Node_Id; - Related_Nod : Node_Id; - Related_Id : Entity_Id := Empty; - Suffix : Character := ' ') return Entity_Id + (S : Node_Id; + Related_Nod : Node_Id; + Related_Id: Entity_Id := Empty; + Suffix: Character := ' '; + Excludes_Null : Boolean := False) return Entity_Id is procedure Check_Incomplete (T : Node_Id); -- Called to verify that an incomplete type is not used prematurely @@ -22538,8 +22559,6 @@ package body Sem_Ch3 is Full_View_Id: Entity_Id; Subtype_Mark_Id : Entity_Id; - May_Have_Null_Exclusion : Boolean; - -- Start of processing for Process_Subtype begin @@ -22560,33 +22579,10 @@ package body Sem_Ch3 is Check_Incomplete (S); P := Parent (S); - -- The following mirroring of assertion in Null_Exclusion_Present is - -- ugly, can't we have a range, a static predicate or even a flag??? - - May_Have_Null_Exclusion := - Present (P) - and then - Nkind (P) in N_Access_Definition - | N_Access_Function_Definition - | N_Access_Procedure_Definition - | N_Access_To_Object_Definition - | N_Allocator - | N_Component_Definition - | N_Derived_Type_Definition - | N_Discriminant_Specification - | N_Formal_Object_Declaration - | N_Function_Specification - | N_Object_Declaration - | N_Object_Renaming_Declaration - | N_Parameter_Specification - | N_Subtype_Declaration; - -- Ada 2005 (AI-231): Static check
[gcc r16-1336] ada: Call Mutate_Ekind earlier for formal entities
https://gcc.gnu.org/g:51e01fb40a3f1309320207bdc12d4ae75b01a67a commit r16-1336-g51e01fb40a3f1309320207bdc12d4ae75b01a67a Author: Ronan Desplanques Date: Thu Mar 13 14:12:52 2025 +0100 ada: Call Mutate_Ekind earlier for formal entities This patch migrates the handling of "premature usage" type of error to the Is_Self_Hidden mechanism. gcc/ada/ChangeLog: * sem_ch6.adb (Set_Formal_Mode): Extend profile. Move parts of the body… (Process_Formals): … here. Move call to Set_Formal_Mode earlier. Call Set_Is_Not_Self_Hidden in second traversal. Diff: --- gcc/ada/sem_ch6.adb | 107 +--- 1 file changed, 52 insertions(+), 55 deletions(-) diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 913217102a7e..a142a1c2f627 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -225,7 +225,10 @@ package body Sem_Ch6 is -- Create the declaration for an inequality operator that is implicitly -- created by a user-defined equality operator that yields a boolean. - procedure Set_Formal_Mode (Formal_Id : Entity_Id); + procedure Set_Formal_Mode + (Formal_Id : Entity_Id; + Spec : N_Parameter_Specification_Id; + Subp_Id : Entity_Id); -- Set proper Ekind to reflect formal mode (in, out, in out), and set -- miscellaneous other attributes. @@ -13066,13 +13069,10 @@ package body Sem_Ch6 is -- Start of processing for Process_Formals begin - -- In order to prevent premature use of the formals in the same formal - -- part, the Ekind is left undefined until all default expressions are - -- analyzed. The Ekind is established in a separate loop at the end. - Param_Spec := First (T); while Present (Param_Spec) loop Formal := Defining_Identifier (Param_Spec); + Set_Formal_Mode (Formal, Param_Spec, Current_Scope); Set_Never_Set_In_Source (Formal, True); Enter_Name (Formal); @@ -13390,12 +13390,48 @@ package body Sem_Ch6 is Analyze_Return_Type (Related_Nod); end if; - -- Now set the kind (mode) of each formal - Param_Spec := First (T); while Present (Param_Spec) loop Formal := Defining_Identifier (Param_Spec); - Set_Formal_Mode (Formal); + Set_Is_Not_Self_Hidden (Formal); + + -- Set Is_Known_Non_Null for access parameters since the language + -- guarantees that access parameters are always non-null. We also set + -- Can_Never_Be_Null, since there is no way to change the value. + + if Nkind (Parameter_Type (Param_Spec)) = N_Access_Definition then + +-- Ada 2005 (AI-231): In Ada 95, access parameters are always non- +-- null; In Ada 2005, only if then null_exclusion is explicit. + +if Ada_Version < Ada_2005 + or else Can_Never_Be_Null (Etype (Formal)) +then + Set_Is_Known_Non_Null (Formal); + Set_Can_Never_Be_Null (Formal); +end if; + + -- Ada 2005 (AI-231): Null-exclusion access subtype + + elsif Is_Access_Type (Etype (Formal)) + and then Can_Never_Be_Null (Etype (Formal)) + then +Set_Is_Known_Non_Null (Formal); + +-- We can also set Can_Never_Be_Null (thus preventing some junk +-- access checks) for the case of an IN parameter, which cannot +-- be changed, or for an IN OUT parameter, which can be changed +-- but not to a null value. But for an OUT parameter, the initial +-- value passed in can be null, so we can't set this flag in that +-- case. + +if Ekind (Formal) /= E_Out_Parameter then + Set_Can_Never_Be_Null (Formal); +end if; + end if; + + Set_Mechanism (Formal, Default_Mechanism); + Set_Formal_Validity (Formal); if Ekind (Formal) = E_In_Parameter then Default := Expression (Param_Spec); @@ -13666,23 +13702,23 @@ package body Sem_Ch6 is -- Set_Formal_Mode -- - - procedure Set_Formal_Mode (Formal_Id : Entity_Id) is - Spec : constant Node_Id := Parent (Formal_Id); - Id : constant Entity_Id := Scope (Formal_Id); - + procedure Set_Formal_Mode + (Formal_Id : Entity_Id; + Spec : N_Parameter_Specification_Id; + Subp_Id : Entity_Id) is begin -- Note: we set Is_Known_Valid for IN parameters and IN OUT parameters -- since we ensure that corresponding actuals are always valid at the -- point of the call. if Out_Present (Spec) then - if Is_Entry (Id) - or else Is_Subprogram_Or_Generic_Subprogram (Id) + if Is_Entry (Subp_Id) + or else Is_Subprogram_Or_Generic_Subprogram (Subp_Id) then -Set_Has_Out_Or_In_Out_Pa
[gcc r16-1338] ada: Clarify code in Process_Subtype
https://gcc.gnu.org/g:3280bce431be5afb260fe59d01ef1deee38704e8
commit r16-1338-g3280bce431be5afb260fe59d01ef1deee38704e8
Author: Ronan Desplanques
Date: Fri Mar 14 14:41:56 2025 +0100
ada: Clarify code in Process_Subtype
This patch factorizes two if statements together in the body of
Process_Subtype, to improve readability.
gcc/ada/ChangeLog:
* sem_ch3.adb (Process_Subtype): Clarify code.
Diff:
---
gcc/ada/sem_ch3.adb | 90 +
1 file changed, 43 insertions(+), 47 deletions(-)
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 6c2d0326c3f9..9d93bf79c0ce 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -22579,63 +22579,59 @@ package body Sem_Ch3 is
Check_Incomplete (S);
P := Parent (S);
- -- Ada 2005 (AI-231): Static check
+ if Excludes_Null then
+-- Create an Itype that is a duplicate of Entity (S) but with the
+-- null-exclusion attribute.
+if Is_Access_Type (Entity (S)) then
+ if Can_Never_Be_Null (Entity (S)) then
+ case Nkind (Related_Nod) is
+ when N_Full_Type_Declaration =>
+if Nkind (Type_Definition (Related_Nod))
+ in N_Array_Type_Definition
+then
+ Error_Node :=
+ Subtype_Indication
+ (Component_Definition
+ (Type_Definition (Related_Nod)));
+else
+ Error_Node :=
+ Subtype_Indication
+ (Type_Definition (Related_Nod));
+end if;
- if Ada_Version >= Ada_2005
- and then Excludes_Null
- and then not Is_Access_Type (Entity (S))
- then
-Error_Msg_N ("`NOT NULL` only allowed for an access type", S);
- end if;
+ when N_Subtype_Declaration =>
+Error_Node := Subtype_Indication (Related_Nod);
- -- Create an Itype that is a duplicate of Entity (S) but with the
- -- null-exclusion attribute.
+ when N_Object_Declaration =>
+Error_Node := Object_Definition (Related_Nod);
- if Is_Access_Type (Entity (S)) and then Excludes_Null then
-if Can_Never_Be_Null (Entity (S)) then
- case Nkind (Related_Nod) is
- when N_Full_Type_Declaration =>
- if Nkind (Type_Definition (Related_Nod))
- in N_Array_Type_Definition
- then
+ when N_Component_Declaration =>
Error_Node :=
Subtype_Indication
-(Component_Definition
- (Type_Definition (Related_Nod)));
- else
-Error_Node :=
- Subtype_Indication (Type_Definition (Related_Nod));
- end if;
+(Component_Definition (Related_Nod));
- when N_Subtype_Declaration =>
- Error_Node := Subtype_Indication (Related_Nod);
+ when N_Allocator =>
+Error_Node := Expression (Related_Nod);
- when N_Object_Declaration =>
- Error_Node := Object_Definition (Related_Nod);
+ when others =>
+pragma Assert (False);
+Error_Node := Related_Nod;
+ end case;
- when N_Component_Declaration =>
- Error_Node :=
- Subtype_Indication (Component_Definition (Related_Nod));
-
- when N_Allocator =>
- Error_Node := Expression (Related_Nod);
-
- when others =>
- pragma Assert (False);
- Error_Node := Related_Nod;
- end case;
+ Error_Msg_NE
+("`NOT NULL` not allowed (& already excludes null)",
+ Error_Node,
+ Entity (S));
+ end if;
- Error_Msg_NE
- ("`NOT NULL` not allowed (& already excludes null)",
- Error_Node,
- Entity (S));
+ Set_Etype
+ (S,
+ Create_Null_Excluding_Itype
+(T => Entity (S), Related_Nod => P));
+ Set_Entity (S, Etype (S));
+elsif Ada_Version >= Ada_2005 then
+ Error_Msg_N ("`NOT NULL` only allowed for an access type", S);
end if;
-
-Set_Etype (S,
- Create_Null_Ex
[gcc r16-1333] ada: Set Ekind of components earlier
https://gcc.gnu.org/g:025f6caa60394dce9dfefb49341e539bb656264b commit r16-1333-g025f6caa60394dce9dfefb49341e539bb656264b Author: Ronan Desplanques Date: Mon Mar 10 10:37:11 2025 +0100 ada: Set Ekind of components earlier Before this patch, the calls to set the proper Ekind of component entities were delayed in order to catch "premature usage" type of errors. This patch moves those calls to the natural place, at the beginning of Analyze_Component_Declaration, and makes premature usage error dectection use the newer Is_Self_Hidden mechanism. The motivation for this patch is to accomodate future removals of operations on E_Void entities. gcc/ada/ChangeLog: * sem.adb (Analyze): Adapt to new Ekinds. * sem_ch3.adb (Analyze_Component_Declaration): Set Ekind early. (Is_Visible_Component, Record_Type_Definition): Adjust. Diff: --- gcc/ada/sem.adb | 3 +-- gcc/ada/sem_ch3.adb | 9 + 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index f5ce9f2300e0..449fd8ad2c4c 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -765,8 +765,7 @@ package body Sem is E : constant Entity_Id := Defining_Entity_Or_Empty (N); begin if Present (E) then -if Ekind (E) = E_Void - and then Nkind (N) = N_Component_Declaration +if Nkind (N) = N_Component_Declaration and then Present (Scope (E)) and then Ekind (Scope (E)) = E_Record_Type then diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 59f1dd2d8d30..7cec589731fd 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -2046,6 +2046,7 @@ package body Sem_Ch3 is -- Start of processing for Analyze_Component_Declaration begin + Mutate_Ekind (Id, E_Component); Generate_Definition (Id); Enter_Name (Id); @@ -19833,7 +19834,9 @@ package body Sem_Ch3 is -- Start of processing for Is_Visible_Component begin - if Ekind (C) in E_Component | E_Discriminant then + if Ekind (C) in E_Component | E_Discriminant +and then Is_Not_Self_Hidden (C) + then Original_Comp := Original_Record_Component (C); end if; @@ -23123,10 +23126,8 @@ package body Sem_Ch3 is Component := First_Entity (Current_Scope); while Present (Component) loop - if Ekind (Component) = E_Void - and then not Is_Itype (Component) + if Ekind (Component) = E_Component and then not Is_Itype (Component) then -Mutate_Ekind (Component, E_Component); Reinit_Component_Location (Component); Set_Is_Not_Self_Hidden (Component); end if;
[gcc r16-1319] ada: Remove unnecessary special handling
https://gcc.gnu.org/g:6ad0d51d4e1d4cc16a68d4e1c588c65849335493 commit r16-1319-g6ad0d51d4e1d4cc16a68d4e1c588c65849335493 Author: Ronan Desplanques Date: Tue Mar 4 14:29:07 2025 +0100 ada: Remove unnecessary special handling This patch removes a special exemption in Enter_Name. That exemption was preceded by a comment which described what situations it was supposed to be required for, but it was unnecessary even in those situations. gcc/ada/ChangeLog: * sem_util.adb (Enter_Name): Remove special handling. Diff: --- gcc/ada/sem_util.adb | 12 +--- 1 file changed, 1 insertion(+), 11 deletions(-) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 523aff33f95a..59bf060ee740 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -8082,17 +8082,7 @@ package body Sem_Util is -- If we fall through, declaration is OK, at least OK enough to continue - -- If Def_Id is a discriminant or a record component we are in the midst - -- of inheriting components in a derived record definition. Preserve - -- their Ekind and Etype. - - if Ekind (Def_Id) in E_Discriminant | E_Component then - null; - - elsif Present (Etype (Def_Id)) then - null; - - else + if No (Etype (Def_Id)) then Set_Etype (Def_Id, Any_Type); -- avoid cascaded errors end if;
[gcc r16-1326] ada: Set Ekind early in object declarations
https://gcc.gnu.org/g:af68e74167292709c238a35a40720714679bb394 commit r16-1326-gaf68e74167292709c238a35a40720714679bb394 Author: Ronan Desplanques Date: Thu Mar 6 12:54:44 2025 +0100 ada: Set Ekind early in object declarations Setting the proper Ekind on object entities was once needed to catch cases of premature usages. The introduction of Is_Self_Hidden changed that, so this patch replaces the Mutate_Ekind calls in the natural place. gcc/ada/ChangeLog: * sem_ch3.adb (Analyze_Object_Declaration): Call Mutate_Ekind earlier. Diff: --- gcc/ada/sem_ch3.adb | 20 ++-- 1 file changed, 6 insertions(+), 14 deletions(-) diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 4161ce39fa3e..59f1dd2d8d30 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -4364,6 +4364,12 @@ package body Sem_Ch3 is -- Start of processing for Analyze_Object_Declaration begin + if Constant_Present (N) then + Mutate_Ekind (Id, E_Constant); + else + Mutate_Ekind (Id, E_Variable); + end if; + -- There are three kinds of implicit types generated by an -- object declaration: @@ -4443,7 +4449,6 @@ package body Sem_Ch3 is T := Find_Type_Of_Object (Object_Definition (N), N); Set_Etype (Id, T); -Mutate_Ekind (Id, E_Variable); goto Leave; end if; @@ -4469,7 +4474,6 @@ package body Sem_Ch3 is if Error_Posted (Id) then Set_Etype (Id, T); -Mutate_Ekind (Id, E_Variable); goto Leave; end if; end if; @@ -4758,7 +4762,6 @@ package body Sem_Ch3 is and then In_Subrange_Of (Etype (Entity (E)), T) then Set_Is_Known_Valid (Id); -Mutate_Ekind (Id, E_Constant); Set_Actual_Subtype (Id, Etype (Entity (E))); end if; @@ -5007,12 +5010,6 @@ package body Sem_Ch3 is -- for discriminants and are thus not indefinite. elsif Is_Unchecked_Union (T) then - if Constant_Present (N) or else Nkind (E) = N_Function_Call then - Mutate_Ekind (Id, E_Constant); - else - Mutate_Ekind (Id, E_Variable); - end if; - -- If the expression is an aggregate it contains the required -- discriminant values but it has not been resolved yet, so do -- it now, and treat it as the initial expression of an object @@ -5073,10 +5070,8 @@ package body Sem_Ch3 is -- "X : Integer := X;". if Constant_Present (N) then - Mutate_Ekind (Id, E_Constant); Set_Is_True_Constant (Id); else - Mutate_Ekind (Id, E_Variable); if Present (E) then Set_Has_Initial_Value (Id); end if; @@ -5218,12 +5213,9 @@ package body Sem_Ch3 is end if; if Constant_Present (N) then - Mutate_Ekind (Id, E_Constant); Set_Is_True_Constant (Id); else - Mutate_Ekind (Id, E_Variable); - -- A variable is set as shared passive if it appears in a shared -- passive package, and is at the outer level. This is not done for -- entities generated during expansion, because those are always
