* [COMMITTED 02/30] ada: Refactor checks for Refined_Depends in generic instances
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 03/30] ada: Remove unnecessary guard against empty list Marc Poulhiès
` (27 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Piotr Trojanek
From: Piotr Trojanek <trojanek@adacore.com>
Code cleanup; semantics is unaffected.
gcc/ada/
* sem_prag.adb (Check_Dependency_Clause, Check_Output_States,
Report_Extra_Clauses): Remove multiple checks for being inside
an instance.
(Analyze_Refined_Depends_In_Decl_Part): Add single check for
being inside an instance.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_prag.adb | 30 +++++++++---------------------
1 file changed, 9 insertions(+), 21 deletions(-)
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 86a25dc7d0c..29f27652138 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -27650,13 +27650,6 @@ package body Sem_Prag is
-- Start of processing for Check_Dependency_Clause
begin
- -- Do not perform this check in an instance because it was already
- -- performed successfully in the generic template.
-
- if In_Instance then
- return;
- end if;
-
-- Examine all refinement clauses and compare them against the
-- dependence clause.
@@ -27910,16 +27903,10 @@ package body Sem_Prag is
-- Start of processing for Check_Output_States
begin
- -- Do not perform this check in an instance because it was already
- -- performed successfully in the generic template.
-
- if In_Instance then
- null;
-
-- Inspect the outputs of pragma Depends looking for a state with a
-- visible refinement.
- elsif Present (Spec_Outputs) then
+ if Present (Spec_Outputs) then
Item_Elmt := First_Elmt (Spec_Outputs);
while Present (Item_Elmt) loop
Item := Node (Item_Elmt);
@@ -28261,13 +28248,7 @@ package body Sem_Prag is
Clause : Node_Id;
begin
- -- Do not perform this check in an instance because it was already
- -- performed successfully in the generic template.
-
- if In_Instance then
- null;
-
- elsif Present (Clauses) then
+ if Present (Clauses) then
Clause := First (Clauses);
while Present (Clause) loop
SPARK_Msg_N
@@ -28369,6 +28350,13 @@ package body Sem_Prag is
Analyze_Depends_In_Decl_Part (N);
+ -- Do not perform these checks in an instance because they were already
+ -- performed successfully in the generic template.
+
+ if In_Instance then
+ goto Leave;
+ end if;
+
-- Do not match dependencies against refinements if Refined_Depends is
-- illegal to avoid emitting misleading error.
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 03/30] ada: Remove unnecessary guard against empty list
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 02/30] ada: Refactor checks for Refined_Depends " Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 04/30] ada: Fix handling of aspects CPU and Interrupt_Priority Marc Poulhiès
` (26 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Piotr Trojanek
From: Piotr Trojanek <trojanek@adacore.com>
Code cleanup; semantics is unaffected.
gcc/ada/
* sem_prag.adb (Report_Extra_Clauses): Remove redundant check
for empty list, because First works also for No_List.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_prag.adb | 15 ++++++---------
1 file changed, 6 insertions(+), 9 deletions(-)
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 29f27652138..9ccf1b9cf65 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -28248,16 +28248,13 @@ package body Sem_Prag is
Clause : Node_Id;
begin
- if Present (Clauses) then
- Clause := First (Clauses);
- while Present (Clause) loop
- SPARK_Msg_N
- ("unmatched or extra clause in dependence refinement",
- Clause);
+ Clause := First (Clauses);
+ while Present (Clause) loop
+ SPARK_Msg_N
+ ("unmatched or extra clause in dependence refinement", Clause);
- Next (Clause);
- end loop;
- end if;
+ Next (Clause);
+ end loop;
end Report_Extra_Clauses;
-- Local variables
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 04/30] ada: Fix handling of aspects CPU and Interrupt_Priority
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 02/30] ada: Refactor checks for Refined_Depends " Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 03/30] ada: Remove unnecessary guard against empty list Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 05/30] ada: Cleanup building of error messages for class-wide contracts Marc Poulhiès
` (25 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Piotr Trojanek
From: Piotr Trojanek <trojanek@adacore.com>
When resolving aspect expression, aspects CPU and Interrupt_Priority
should be handled like the aspect Priority; in particular, all these
expressions can reference discriminants of the annotated task type.
gcc/ada/
* sem_ch13.adb (Check_Aspect_At_End_Of_Declarations): Make
discriminants visible when analyzing aspect Interrupt_Priority.
(Freeze_Entity_Checks): Likewise.
(Resolve_Aspect_Expressions): Likewise for both aspects CPU and
Interrupt_Priority.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_ch13.adb | 7 ++++++-
1 file changed, 6 insertions(+), 1 deletion(-)
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 4cf6fc9a645..c0a5b6c2c37 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -11107,6 +11107,7 @@ package body Sem_Ch13 is
elsif A_Id in Aspect_CPU
| Aspect_Dynamic_Predicate
| Aspect_Ghost_Predicate
+ | Aspect_Interrupt_Priority
| Aspect_Predicate
| Aspect_Priority
| Aspect_Static_Predicate
@@ -13366,6 +13367,7 @@ package body Sem_Ch13 is
if Get_Aspect_Id (Ritem) in Aspect_CPU
| Aspect_Dynamic_Predicate
| Aspect_Ghost_Predicate
+ | Aspect_Interrupt_Priority
| Aspect_Predicate
| Aspect_Static_Predicate
| Aspect_Priority
@@ -15881,7 +15883,10 @@ package body Sem_Ch13 is
Set_Must_Not_Freeze (Expr);
Preanalyze_Spec_Expression (Expr, E);
- when Aspect_Priority =>
+ when Aspect_CPU
+ | Aspect_Interrupt_Priority
+ | Aspect_Priority
+ =>
Push_Type (E);
Preanalyze_Spec_Expression (Expr, Any_Integer);
Pop_Type (E);
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 05/30] ada: Cleanup building of error messages for class-wide contracts
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (2 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 04/30] ada: Fix handling of aspects CPU and Interrupt_Priority Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 06/30] ada: Refactor common code for dynamic and static class-wide preconditions Marc Poulhiès
` (24 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Piotr Trojanek
From: Piotr Trojanek <trojanek@adacore.com>
Code cleanup; semantics is unaffected.
gcc/ada/
* exp_ch6.adb (Build_Dynamic_Check_Helper_Call): Remove unused
iteration over formal parameters.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch6.adb | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index a8a70a5759d..e43389132ae 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -7635,7 +7635,6 @@ package body Exp_Ch6 is
Dynamic_Call_Helper (CW_Subp);
Actuals : constant List_Id := New_List;
A : Node_Id := First_Actual (Call_Node);
- F : Entity_Id := First_Formal (Helper_Id);
begin
while Present (A) loop
@@ -7646,7 +7645,7 @@ package body Exp_Ch6 is
Remove_Side_Effects (A);
Append_To (Actuals, New_Copy_Tree (A));
- Next_Formal (F);
+
Next_Actual (A);
end loop;
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 06/30] ada: Refactor common code for dynamic and static class-wide preconditions
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (3 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 05/30] ada: Cleanup building of error messages for class-wide contracts Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 07/30] ada: Add switch to disable expansion of assertions in CodePeer mode Marc Poulhiès
` (23 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Piotr Trojanek
From: Piotr Trojanek <trojanek@adacore.com>
Code cleanup; semantics is unaffected.
gcc/ada/
* exp_ch6.adb (Install_Class_Preconditions_Check): Refactor
common code for checking if precondition fails, since the
difference is only in raising an exception or calling the
Raise_Assert_Failure procedure.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch6.adb | 36 ++++++++++++++++++------------------
1 file changed, 18 insertions(+), 18 deletions(-)
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index e43389132ae..b5c5865242d 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -7868,6 +7868,7 @@ package body Exp_Ch6 is
Present (Controlling_Argument (Call_Node));
Class_Subp : Entity_Id;
Cond : Node_Id;
+ Fail : Node_Id;
Subp : Entity_Id;
-- Start of processing for Install_Class_Preconditions_Check
@@ -7913,30 +7914,29 @@ package body Exp_Ch6 is
end if;
if Exception_Locations_Suppressed then
- Insert_Action (Call_Node,
- Make_If_Statement (Loc,
- Condition => Make_Op_Not (Loc, Cond),
- Then_Statements => New_List (
- Make_Raise_Statement (Loc,
- Name =>
- New_Occurrence_Of
- (RTE (RE_Assert_Failure), Loc)))));
+ Fail :=
+ Make_Raise_Statement (Loc,
+ Name =>
+ New_Occurrence_Of
+ (RTE (RE_Assert_Failure), Loc));
-- Failed check with message indicating the failed precondition and the
-- call that caused it.
else
- Insert_Action (Call_Node,
- Make_If_Statement (Loc,
- Condition => Make_Op_Not (Loc, Cond),
- Then_Statements => New_List (
- Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of
- (RTE (RE_Raise_Assert_Failure), Loc),
- Parameter_Associations =>
- New_List (Build_Error_Message (Subp))))));
+ Fail :=
+ Make_Procedure_Call_Statement (Loc,
+ Name =>
+ New_Occurrence_Of
+ (RTE (RE_Raise_Assert_Failure), Loc),
+ Parameter_Associations =>
+ New_List (Build_Error_Message (Subp)));
end if;
+
+ Insert_Action (Call_Node,
+ Make_If_Statement (Loc,
+ Condition => Make_Op_Not (Loc, Cond),
+ Then_Statements => New_List (Fail)));
end Install_Class_Preconditions_Check;
------------------------------
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 07/30] ada: Add switch to disable expansion of assertions in CodePeer mode
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (4 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 06/30] ada: Refactor common code for dynamic and static class-wide preconditions Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 08/30] ada: Enable inlining for subprograms with multiple return statements Marc Poulhiès
` (22 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Piotr Trojanek
From: Piotr Trojanek <trojanek@adacore.com>
A new debug switch -gnatd_k is added, which has only effect in CodePeer
mode. When enabled, assertion expressions are no longer expanded (which
is the default in the CodePeer mode); instead, their expansion needs to
be explicitly enabled by pragma Assertion_Policy.
gcc/ada/
* debug.adb (d_k): Use first available debug switch.
* gnat1drv.adb (Adjust_Global_Switches): If new debug switch is
active then don't expand assertion expressions by default.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/debug.adb | 7 ++++++-
gcc/ada/gnat1drv.adb | 8 ++++++--
2 files changed, 12 insertions(+), 3 deletions(-)
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index 18b4a5480b6..540db2a9942 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -148,7 +148,7 @@ package body Debug is
-- d_h Disable the use of (perfect) hash functions for enumeration Value
-- d_i Ignore activations and calls to instances for elaboration
-- d_j Read JSON files and populate Repinfo tables (opposite of -gnatRjs)
- -- d_k
+ -- d_k In CodePeer mode disable expansion of assertion checks
-- d_l
-- d_m
-- d_n
@@ -990,6 +990,11 @@ package body Debug is
-- compilation session if -gnatRjs was passed, in order to populate
-- the internal tables of the Repinfo unit from them.
+ -- d_k In CodePeer mode assertion expressions are expanded by default
+ -- (regardless of the -gnata compiler switch); when this switch is
+ -- enabled, expansion of assertion expressions is controlled by
+ -- pragma Assertion_Policy.
+
-- d_p The compiler ignores calls to subprograms which verify the run-time
-- semantics of invariants and postconditions in both the static and
-- dynamic elaboration models.
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 55b5d565536..081d9435f4a 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -357,9 +357,13 @@ procedure Gnat1drv is
Generate_SCIL := True;
- -- Enable assertions, since they give CodePeer valuable extra info
+ -- Enable assertions, since they give CodePeer valuable extra info;
+ -- however, when switch -gnatd_k is active, then keep assertions
+ -- disabled by default and only enable them when explicitly
+ -- requested by pragma Assertion_Policy, just like in ordinary
+ -- compilation.
- Assertions_Enabled := True;
+ Assertions_Enabled := not Debug_Flag_Underscore_K;
-- Set normal RM validity checking and checking of copies (to catch
-- e.g. wrong values used in unchecked conversions).
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 08/30] ada: Enable inlining for subprograms with multiple return statements
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (5 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 07/30] ada: Add switch to disable expansion of assertions in CodePeer mode Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 09/30] ada: Simplify check for type without stream operations Marc Poulhiès
` (21 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Piotr Trojanek
From: Piotr Trojanek <trojanek@adacore.com>
With the support for forward GOTO statements in the GNATprove backend,
we can now inline subprograms with multiple return statements in the
frontend.
Also, fix inconsistent source locations in the inlined code, which were
now triggering assertion violations in the code for GNATprove
counterexamples.
gcc/ada/
* inline.adb (Has_Single_Return_In_GNATprove_Mode): Remove.
(Process_Formals): When rewriting an occurrence of a formal
parameter, use location of the occurrence, not of the inlined
call.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/inline.adb | 91 ++++------------------------------------------
1 file changed, 8 insertions(+), 83 deletions(-)
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index 17b3099e6a6..04cf1194009 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -1090,14 +1090,6 @@ package body Inline is
-- conflict with subsequent inlinings, so that it is unsafe to try to
-- inline in such a case.
- function Has_Single_Return_In_GNATprove_Mode return Boolean;
- -- This function is called only in GNATprove mode, and it returns
- -- True if the subprogram has no return statement or a single return
- -- statement as last statement. It returns False for subprogram with
- -- a single return as last statement inside one or more blocks, as
- -- inlining would generate gotos in that case as well (although the
- -- goto is useless in that case).
-
function Uses_Secondary_Stack (Bod : Node_Id) return Boolean;
-- If the body of the subprogram includes a call that returns an
-- unconstrained type, the secondary stack is involved, and it is
@@ -1173,64 +1165,6 @@ package body Inline is
return False;
end Has_Pending_Instantiation;
- -----------------------------------------
- -- Has_Single_Return_In_GNATprove_Mode --
- -----------------------------------------
-
- function Has_Single_Return_In_GNATprove_Mode return Boolean is
- Body_To_Inline : constant Node_Id := N;
- Last_Statement : Node_Id := Empty;
-
- function Check_Return (N : Node_Id) return Traverse_Result;
- -- Returns OK on node N if this is not a return statement different
- -- from the last statement in the subprogram.
-
- ------------------
- -- Check_Return --
- ------------------
-
- function Check_Return (N : Node_Id) return Traverse_Result is
- begin
- case Nkind (N) is
- when N_Extended_Return_Statement
- | N_Simple_Return_Statement
- =>
- if N = Last_Statement then
- return OK;
- else
- return Abandon;
- end if;
-
- -- Skip locally declared subprogram bodies inside the body to
- -- inline, as the return statements inside those do not count.
-
- when N_Subprogram_Body =>
- if N = Body_To_Inline then
- return OK;
- else
- return Skip;
- end if;
-
- when others =>
- return OK;
- end case;
- end Check_Return;
-
- function Check_All_Returns is new Traverse_Func (Check_Return);
-
- -- Start of processing for Has_Single_Return_In_GNATprove_Mode
-
- begin
- -- Retrieve the last statement
-
- Last_Statement := Last (Statements (Handled_Statement_Sequence (N)));
-
- -- Check that the last statement is the only possible return
- -- statement in the subprogram.
-
- return Check_All_Returns (N) = OK;
- end Has_Single_Return_In_GNATprove_Mode;
-
--------------------------
-- Uses_Secondary_Stack --
--------------------------
@@ -1275,16 +1209,6 @@ package body Inline is
then
return;
- -- Subprograms that have return statements in the middle of the body are
- -- inlined with gotos. GNATprove does not currently support gotos, so
- -- we prevent such inlining.
-
- elsif GNATprove_Mode
- and then not Has_Single_Return_In_GNATprove_Mode
- then
- Cannot_Inline ("cannot inline & (multiple returns)?", N, Spec_Id);
- return;
-
-- Functions that return controlled types cannot currently be inlined
-- because they require secondary stack handling; controlled actions
-- may also interfere in complex ways with inlining.
@@ -3518,6 +3442,7 @@ package body Inline is
---------------------
function Process_Formals (N : Node_Id) return Traverse_Result is
+ Loc : constant Source_Ptr := Sloc (N);
A : Entity_Id;
E : Entity_Id;
Ret : Node_Id;
@@ -3544,13 +3469,13 @@ package body Inline is
if Is_Entity_Name (A) then
Had_Private_View := Has_Private_View (N);
- Rewrite (N, New_Occurrence_Of (Entity (A), Sloc (N)));
+ Rewrite (N, New_Occurrence_Of (Entity (A), Loc));
Set_Has_Private_View (N, Had_Private_View);
Check_Private_View (N);
elsif Nkind (A) = N_Defining_Identifier then
Had_Private_View := Has_Private_View (N);
- Rewrite (N, New_Occurrence_Of (A, Sloc (N)));
+ Rewrite (N, New_Occurrence_Of (A, Loc));
Set_Has_Private_View (N, Had_Private_View);
Check_Private_View (N);
@@ -3618,8 +3543,8 @@ package body Inline is
or else Yields_Universal_Type (Expression (N))
then
Ret :=
- Make_Qualified_Expression (Sloc (N),
- Subtype_Mark => New_Occurrence_Of (Ret_Type, Sloc (N)),
+ Make_Qualified_Expression (Loc,
+ Subtype_Mark => New_Occurrence_Of (Ret_Type, Loc),
Expression => Relocate_Node (Expression (N)));
-- Use an unchecked type conversion between access types, for
@@ -3635,8 +3560,8 @@ package body Inline is
else
Ret :=
- Make_Type_Conversion (Sloc (N),
- Subtype_Mark => New_Occurrence_Of (Ret_Type, Sloc (N)),
+ Make_Type_Conversion (Loc,
+ Subtype_Mark => New_Occurrence_Of (Ret_Type, Loc),
Expression => Relocate_Node (Expression (N)));
end if;
@@ -3715,7 +3640,7 @@ package body Inline is
elsif Nkind (N) = N_Pragma
and then Pragma_Name (N) = Name_Unreferenced
then
- Rewrite (N, Make_Null_Statement (Sloc (N)));
+ Rewrite (N, Make_Null_Statement (Loc));
return OK;
else
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 09/30] ada: Simplify check for type without stream operations
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (6 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 08/30] ada: Enable inlining for subprograms with multiple return statements Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 10/30] ada: Skip processing of NUL character for attribute Type_Key Marc Poulhiès
` (20 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Piotr Trojanek
From: Piotr Trojanek <trojanek@adacore.com>
Recursive routine Type_Without_Stream_Operation was checking restriction
No_Default_Stream_Attributes at every call, which was confusing and
inefficient.
This routine is only called from the places: Check_Stream_Attribute,
which already checks if this restriction is active, and
Stream_Operation_OK, where we add such a check.
Cleanup related to extending the use of No_Streams restriction.
gcc/ada/
* exp_ch3.adb (Stream_Operation_OK): Check restriction
No_Default_Stream_Attributes before call to
Type_Without_Stream_Operation.
* sem_util.adb (Type_Without_Stream_Operation): Remove static
condition from recursive routine
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch3.adb | 4 +++-
gcc/ada/sem_util.adb | 4 ----
2 files changed, 3 insertions(+), 5 deletions(-)
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 8ddae1eb1be..f9dd0914111 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -12912,7 +12912,9 @@ package body Exp_Ch3 is
and then No (No_Tagged_Streams_Pragma (Typ))
and then not No_Run_Time_Mode
and then RTE_Available (RE_Tag)
- and then No (Type_Without_Stream_Operation (Typ))
+ and then
+ (not Restriction_Active (No_Default_Stream_Attributes)
+ or else No (Type_Without_Stream_Operation (Typ)))
and then RTE_Available (RE_Root_Stream_Type);
end Stream_Operation_OK;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 15994b4d1e9..241be3d2957 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -28557,10 +28557,6 @@ package body Sem_Util is
Op_Missing : Boolean;
begin
- if not Restriction_Active (No_Default_Stream_Attributes) then
- return Empty;
- end if;
-
if Is_Elementary_Type (T) then
if Op = TSS_Null then
Op_Missing :=
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 10/30] ada: Skip processing of NUL character for attribute Type_Key
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (7 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 09/30] ada: Simplify check for type without stream operations Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 11/30] ada: Adjust comments and doc about the new use of restriction No_Streams Marc Poulhiès
` (19 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Piotr Trojanek
From: Piotr Trojanek <trojanek@adacore.com>
Code cleanup; behavior is unaffected.
gcc/ada/
* sem_attr.adb (Analyze_Attribute): Use fully qualified name
without a NUL, so that it doesn't need to be skipped afterwards.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_attr.adb | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 403810c8b5e..4fd270aeae9 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -6863,8 +6863,8 @@ package body Sem_Attr is
--------------
when Attribute_Type_Key => Type_Key : declare
- Full_Name : constant String_Id :=
- Fully_Qualified_Name_String (Entity (P));
+ Full_Name : constant String_Id :=
+ Fully_Qualified_Name_String (Entity (P), Append_NUL => False);
CRC : CRC32;
-- The computed signature for the type
@@ -6997,9 +6997,9 @@ package body Sem_Attr is
Start_String;
Deref := False;
- -- Copy all characters in Full_Name but the trailing NUL
+ -- Copy all characters in Full_Name
- for J in 1 .. String_Length (Full_Name) - 1 loop
+ for J in 1 .. String_Length (Full_Name) loop
Store_String_Char (Get_String_Char (Full_Name, Pos (J)));
end loop;
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 11/30] ada: Adjust comments and doc about the new use of restriction No_Streams
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (8 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 10/30] ada: Skip processing of NUL character for attribute Type_Key Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 12/30] ada: Cleanup repeated code in expansion of stream attributes Marc Poulhiès
` (18 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Piotr Trojanek
From: Piotr Trojanek <trojanek@adacore.com>
Extend code comment; move recently added documentation from pragma
No_Tagged_Streams to restriction No_Streams.
gcc/ada/
* doc/gnat_rm/implementation_defined_pragmas.rst
(No_Tagged_Streams): Move documentation.
* doc/gnat_rm/standard_and_implementation_defined_restrictions.rst
(No_Streams): Likewise.
* exp_disp.adb (Make_DT): Extend comment.
* gnat_rm.texi: Regenerate.
* gnat_ugn.texi: Regenerate.
Tested on x86_64-pc-linux-gnu, committed on master.
---
.../doc/gnat_rm/implementation_defined_pragmas.rst | 6 ------
...ard_and_implementation_defined_restrictions.rst | 6 ++++++
gcc/ada/exp_disp.adb | 4 ++++
gcc/ada/gnat_rm.texi | 14 +++++++-------
gcc/ada/gnat_ugn.texi | 4 ++--
5 files changed, 19 insertions(+), 15 deletions(-)
diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
index 7e4dd935342..0661670e047 100644
--- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
+++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
@@ -4000,12 +4000,6 @@ applied to a tagged type its Expanded_Name and External_Tag are initialized
with empty strings. This is useful to avoid exposing entity names at binary
level but has a negative impact on the debuggability of tagged types.
-Alternatively, when pragmas ``Discard_Names`` and ``Restrictions (No_Streams)``
-simultanously apply to a tagged type, its Expanded_Name and External_Tag are
-also initialized with empty strings. In particular, both these pragmas can be
-applied as configuration pragmas to avoid exposing entity names at binary
-level for the entire parition.
-
Pragma Normalize_Scalars
========================
diff --git a/gcc/ada/doc/gnat_rm/standard_and_implementation_defined_restrictions.rst b/gcc/ada/doc/gnat_rm/standard_and_implementation_defined_restrictions.rst
index 5c023239163..cf4657b7050 100644
--- a/gcc/ada/doc/gnat_rm/standard_and_implementation_defined_restrictions.rst
+++ b/gcc/ada/doc/gnat_rm/standard_and_implementation_defined_restrictions.rst
@@ -675,6 +675,12 @@ To take maximum advantage of this space-saving optimization, any
unit declaring a tagged type should be compiled with the restriction,
though this is not required.
+When pragmas ``Discard_Names`` and ``Restrictions (No_Streams)`` simultaneously
+apply to a tagged type, its Expanded_Name and External_Tag are also initialized
+with empty strings. In particular, both these pragmas can be applied as
+configuration pragmas to avoid exposing entity names at binary level for the
+entire partition.
+
No_Tagged_Type_Registration
---------------------------
.. index:: No_Tagged_Type_Registration
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 66be77c9ffc..1a19c1e3303 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -4598,6 +4598,10 @@ package body Exp_Disp is
-- (2) External_Tag (combined with Internal_Tag) is used for object
-- streaming and No_Tagged_Streams inhibits the generation of
-- streams.
+ -- Instead of No_Tagged_Streams, which applies either to a single
+ -- type or to a declarative region, it is possible to use restriction
+ -- No_Streams, which prevents stream objects from being created in the
+ -- entire partition.
Discard_Names : constant Boolean :=
(Present (No_Tagged_Streams_Pragma (Typ))
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 776dd4a4afc..1e6fb093672 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -19,7 +19,7 @@
@copying
@quotation
-GNAT Reference Manual , Apr 16, 2024
+GNAT Reference Manual , May 28, 2024
AdaCore
@@ -5535,12 +5535,6 @@ applied to a tagged type its Expanded_Name and External_Tag are initialized
with empty strings. This is useful to avoid exposing entity names at binary
level but has a negative impact on the debuggability of tagged types.
-Alternatively, when pragmas @code{Discard_Names} and @code{Restrictions (No_Streams)}
-simultanously apply to a tagged type, its Expanded_Name and External_Tag are
-also initialized with empty strings. In particular, both these pragmas can be
-applied as configuration pragmas to avoid exposing entity names at binary
-level for the entire parition.
-
@node Pragma Normalize_Scalars,Pragma Obsolescent,Pragma No_Tagged_Streams,Implementation Defined Pragmas
@anchor{gnat_rm/implementation_defined_pragmas pragma-normalize-scalars}@anchor{b0}
@section Pragma Normalize_Scalars
@@ -13246,6 +13240,12 @@ To take maximum advantage of this space-saving optimization, any
unit declaring a tagged type should be compiled with the restriction,
though this is not required.
+When pragmas @code{Discard_Names} and @code{Restrictions (No_Streams)} simultaneously
+apply to a tagged type, its Expanded_Name and External_Tag are also initialized
+with empty strings. In particular, both these pragmas can be applied as
+configuration pragmas to avoid exposing entity names at binary level for the
+entire partition.
+
@node No_Tagged_Type_Registration,No_Task_Allocators,No_Streams,Partition-Wide Restrictions
@anchor{gnat_rm/standard_and_implementation_defined_restrictions no-tagged-type-registration}@anchor{205}
@subsection No_Tagged_Type_Registration
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 2df2a780ec7..73f496fcdab 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -19,7 +19,7 @@
@copying
@quotation
-GNAT User's Guide for Native Platforms , Apr 16, 2024
+GNAT User's Guide for Native Platforms , May 28, 2024
AdaCore
@@ -29645,8 +29645,8 @@ to permit their use in free software.
@printindex ge
-@anchor{d1}@w{ }
@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{ }
+@anchor{d1}@w{ }
@c %**end of body
@bye
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 12/30] ada: Cleanup repeated code in expansion of stream attributes
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (9 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 11/30] ada: Adjust comments and doc about the new use of restriction No_Streams Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 13/30] ada: Fix incorrect lower bound presumption in gnatlink Marc Poulhiès
` (17 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Piotr Trojanek
From: Piotr Trojanek <trojanek@adacore.com>
In expansion of various attributes, in particular for the Input/Output
and Read/Write attributes, we can use constants that are already used
for expansion of many other attributes.
gcc/ada/
* exp_attr.adb (Expand_N_Attribute_Reference): Use constants
declared at the beginning of subprogram; tune layout.
* exp_ch3.adb (Predefined_Primitive_Bodies): Tune layout.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_attr.adb | 36 +++++++++++++++---------------------
gcc/ada/exp_ch3.adb | 3 +--
2 files changed, 16 insertions(+), 23 deletions(-)
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 69428142839..0349db28a1a 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -179,7 +179,6 @@ package body Exp_Attr is
-- * Rec_Typ - the record type whose internals are to be validated
function Default_Streaming_Unavailable (Typ : Entity_Id) return Boolean;
- --
-- In most cases, references to unavailable streaming attributes
-- are rejected at compile time. In some obscure cases involving
-- generics and formal derived types, the problem is dealt with at runtime.
@@ -4091,10 +4090,8 @@ package body Exp_Attr is
----------------------
when Attribute_Has_Same_Storage => Has_Same_Storage : declare
- Loc : constant Source_Ptr := Sloc (N);
-
- X : constant Node_Id := Prefix (N);
- Y : constant Node_Id := First (Expressions (N));
+ X : constant Node_Id := Pref;
+ Y : constant Node_Id := First (Exprs);
-- The arguments
X_Addr : Node_Id;
@@ -4363,7 +4360,7 @@ package body Exp_Attr is
if Restriction_Active (No_Streams) then
Rewrite (N,
- Make_Raise_Program_Error (Sloc (N),
+ Make_Raise_Program_Error (Loc,
Reason => PE_Stream_Operation_Not_Allowed));
Set_Etype (N, B_Type);
return;
@@ -4415,7 +4412,7 @@ package body Exp_Attr is
-- case where a No_Streams restriction is active.
Rewrite (N,
- Make_Raise_Program_Error (Sloc (N),
+ Make_Raise_Program_Error (Loc,
Reason => PE_Stream_Operation_Not_Allowed));
Set_Etype (N, B_Type);
return;
@@ -5295,10 +5292,8 @@ package body Exp_Attr is
----------------------
when Attribute_Overlaps_Storage => Overlaps_Storage : declare
- Loc : constant Source_Ptr := Sloc (N);
- X : constant Node_Id := Prefix (N);
- Y : constant Node_Id := First (Expressions (N));
-
+ X : constant Node_Id := Pref;
+ Y : constant Node_Id := First (Exprs);
-- The arguments
X_Addr, Y_Addr : Node_Id;
@@ -5451,7 +5446,7 @@ package body Exp_Attr is
if Restriction_Active (No_Streams) then
Rewrite (N,
- Make_Raise_Program_Error (Sloc (N),
+ Make_Raise_Program_Error (Loc,
Reason => PE_Stream_Operation_Not_Allowed));
Set_Etype (N, Standard_Void_Type);
return;
@@ -5505,7 +5500,7 @@ package body Exp_Attr is
-- case where a No_Streams restriction is active.
Rewrite (N,
- Make_Raise_Program_Error (Sloc (N),
+ Make_Raise_Program_Error (Loc,
Reason => PE_Stream_Operation_Not_Allowed));
Set_Etype (N, Standard_Void_Type);
return;
@@ -6180,10 +6175,9 @@ package body Exp_Attr is
when Attribute_Reduce =>
declare
- Loc : constant Source_Ptr := Sloc (N);
- E1 : constant Node_Id := First (Expressions (N));
- E2 : constant Node_Id := Next (E1);
- Bnn : constant Entity_Id := Make_Temporary (Loc, 'B', N);
+ E1 : constant Node_Id := First (Exprs);
+ E2 : constant Node_Id := Next (E1);
+ Bnn : constant Entity_Id := Make_Temporary (Loc, 'B', N);
Accum_Typ : Entity_Id := Empty;
New_Loop : Node_Id;
@@ -6381,7 +6375,7 @@ package body Exp_Attr is
if Restriction_Active (No_Streams) then
Rewrite (N,
- Make_Raise_Program_Error (Sloc (N),
+ Make_Raise_Program_Error (Loc,
Reason => PE_Stream_Operation_Not_Allowed));
Set_Etype (N, B_Type);
return;
@@ -6453,7 +6447,7 @@ package body Exp_Attr is
-- case where a No_Streams restriction is active.
Rewrite (N,
- Make_Raise_Program_Error (Sloc (N),
+ Make_Raise_Program_Error (Loc,
Reason => PE_Stream_Operation_Not_Allowed));
Set_Etype (N, B_Type);
return;
@@ -8096,7 +8090,7 @@ package body Exp_Attr is
if Restriction_Active (No_Streams) then
Rewrite (N,
- Make_Raise_Program_Error (Sloc (N),
+ Make_Raise_Program_Error (Loc,
Reason => PE_Stream_Operation_Not_Allowed));
Set_Etype (N, U_Type);
return;
@@ -8150,7 +8144,7 @@ package body Exp_Attr is
-- case where a No_Streams restriction is active.
Rewrite (N,
- Make_Raise_Program_Error (Sloc (N),
+ Make_Raise_Program_Error (Loc,
Reason => PE_Stream_Operation_Not_Allowed));
Set_Etype (N, U_Type);
return;
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index f9dd0914111..f03cda62149 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -12655,8 +12655,7 @@ package body Exp_Ch3 is
and then Stream_Operation_OK (Tag_Typ, TSS_Stream_Input)
and then No (TSS (Tag_Typ, TSS_Stream_Input))
then
- Build_Record_Or_Elementary_Input_Function
- (Tag_Typ, Decl, Ent);
+ Build_Record_Or_Elementary_Input_Function (Tag_Typ, Decl, Ent);
Append_To (Res, Decl);
end if;
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 13/30] ada: Fix incorrect lower bound presumption in gnatlink
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (10 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 12/30] ada: Cleanup repeated code in expansion of stream attributes Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 14/30] ada: Remove incorrect assertion in run-time Marc Poulhiès
` (16 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Ronan Desplanques
From: Ronan Desplanques <desplanques@adacore.com>
This patch fixes a subprogram in gnatlink that incorrectly assumed
that the strings it is passed as arguments all have a lower bound of
1.
gcc/ada/
* gnatlink.adb (Check_File_Name): Fix incorrect assumption.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/gnatlink.adb | 17 ++++++++---------
1 file changed, 8 insertions(+), 9 deletions(-)
diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb
index d00fd9e5af7..1455412ef93 100644
--- a/gcc/ada/gnatlink.adb
+++ b/gcc/ada/gnatlink.adb
@@ -42,6 +42,7 @@ with Types;
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Exceptions; use Ada.Exceptions;
+with Ada.Strings.Fixed;
with System.OS_Lib; use System.OS_Lib;
with System.CRTL;
@@ -1697,15 +1698,13 @@ begin
procedure Check_File_Name (S : String) is
begin
- for J in 1 .. FN'Length - (S'Length - 1) loop
- if FN (J .. J + (S'Length - 1)) = S then
- Error_Msg
- ("warning: executable file name """ & Output_File_Name.all
- & """ contains substring """ & S & '"');
- Error_Msg
- ("admin privileges may be required to run this file");
- end if;
- end loop;
+ if Ada.Strings.Fixed.Index (FN, S) /= 0 then
+ Error_Msg
+ ("warning: executable file name """ & Output_File_Name.all
+ & """ contains substring """ & S & '"');
+ Error_Msg
+ ("admin privileges may be required to run this file");
+ end if;
end Check_File_Name;
-- Start of processing for Bad_File_Names_On_Windows
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 14/30] ada: Remove incorrect assertion in run-time
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (11 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 13/30] ada: Fix incorrect lower bound presumption in gnatlink Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 15/30] ada: Fix usage of SetThreadIdealProcessor Marc Poulhiès
` (15 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Ronan Desplanques
From: Ronan Desplanques <desplanques@adacore.com>
There is a special case of file paths on Windows that are absolute
but don't start with a drive letter: UNC paths. This patch removes
an assertion in System.OS_Lib.Normalize_Pathname that failed to take
this case into account. It also renames a local subprogram of
Normalize_Pathname to make its purpose clearer.
gcc/ada/
* libgnat/s-os_lib.adb (Normalize_Pathname): Remove incorrect
assert statement.
(Missed_Drive_Letter): Rename into...
(Drive_Letter_Omitted): This.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/libgnat/s-os_lib.adb | 22 +++++++++++-----------
1 file changed, 11 insertions(+), 11 deletions(-)
diff --git a/gcc/ada/libgnat/s-os_lib.adb b/gcc/ada/libgnat/s-os_lib.adb
index 20e109aaa0b..dd2156e1dcb 100644
--- a/gcc/ada/libgnat/s-os_lib.adb
+++ b/gcc/ada/libgnat/s-os_lib.adb
@@ -2089,8 +2089,10 @@ package body System.OS_Lib is
-- Returns True only if the Name is including a drive
-- letter at start.
- function Missed_Drive_Letter (Name : String) return Boolean;
- -- Missed drive letter at start of the normalized pathname
+ function Drive_Letter_Omitted (Name : String) return Boolean;
+ -- Name must be an absolute path. Returns True if and only if
+ -- Name doesn't start with a drive letter and Name is not a
+ -- UNC path.
-------------------
-- Is_With_Drive --
@@ -2104,11 +2106,11 @@ package body System.OS_Lib is
or else Name (Name'First) in 'A' .. 'Z');
end Is_With_Drive;
- -------------------------
- -- Missed_Drive_Letter --
- -------------------------
+ --------------------------
+ -- Drive_Letter_Omitted --
+ --------------------------
- function Missed_Drive_Letter (Name : String) return Boolean is
+ function Drive_Letter_Omitted (Name : String) return Boolean is
begin
return On_Windows
and then not Is_With_Drive (Name)
@@ -2117,7 +2119,7 @@ package body System.OS_Lib is
/= Directory_Separator
or else Name (Name'First + 1)
/= Directory_Separator);
- end Missed_Drive_Letter;
+ end Drive_Letter_Omitted;
-----------------
-- Final_Value --
@@ -2174,7 +2176,7 @@ package body System.OS_Lib is
elsif Directory = ""
or else not Is_Absolute_Path (Directory)
- or else Missed_Drive_Letter (Directory)
+ or else Drive_Letter_Omitted (Directory)
then
-- Directory name not given or it is not absolute or without drive
-- letter on Windows, get current directory.
@@ -2251,7 +2253,7 @@ package body System.OS_Lib is
end if;
if Is_Absolute_Path (Name) then
- if Missed_Drive_Letter (Name) then
+ if Drive_Letter_Omitted (Name) then
Fill_Directory (Drive_Only => True);
-- Take only drive letter part with colon
@@ -2286,8 +2288,6 @@ package body System.OS_Lib is
-- Ensure drive letter is upper-case
- pragma Assert (Path_Buffer (2) = ':');
-
if Path_Buffer (1) in 'a' .. 'z' then
System.Case_Util.To_Upper (Path_Buffer (1 .. 1));
end if;
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 15/30] ada: Fix usage of SetThreadIdealProcessor
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (12 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 14/30] ada: Remove incorrect assertion in run-time Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 16/30] ada: Fix usage of SetThreadAffinityMask Marc Poulhiès
` (14 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Ronan Desplanques
From: Ronan Desplanques <desplanques@adacore.com>
This patches fixes the way the run-time library checks the return
value of SetThreadIdealProcessor.
gcc/ada/
* libgnarl/s-taprop__mingw.adb (Set_Task_Affinity): Fix usage
of SetThreadIdealProcessor.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/libgnarl/s-taprop__mingw.adb | 13 +++++++++++--
1 file changed, 11 insertions(+), 2 deletions(-)
diff --git a/gcc/ada/libgnarl/s-taprop__mingw.adb b/gcc/ada/libgnarl/s-taprop__mingw.adb
index 3a124ba78d0..38e281cb721 100644
--- a/gcc/ada/libgnarl/s-taprop__mingw.adb
+++ b/gcc/ada/libgnarl/s-taprop__mingw.adb
@@ -1308,7 +1308,13 @@ package body System.Task_Primitives.Operations is
Result :=
SetThreadIdealProcessor
(T.Common.LL.Thread, ProcessorId (T.Common.Base_CPU) - 1);
- pragma Assert (Result = 1);
+
+ -- The documentation for SetThreadIdealProcessor states:
+ --
+ -- If the function fails, the return value is (DWORD) - 1.
+ --
+ -- That should map to DWORD'Last in Ada.
+ pragma Assert (Result /= DWORD'Last);
-- Task_Info
@@ -1317,7 +1323,10 @@ package body System.Task_Primitives.Operations is
Result :=
SetThreadIdealProcessor
(T.Common.LL.Thread, T.Common.Task_Info.CPU);
- pragma Assert (Result = 1);
+
+ -- See the comment above about the return value of
+ -- SetThreadIdealProcessor.
+ pragma Assert (Result /= DWORD'Last);
end if;
-- Dispatching domains
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 16/30] ada: Fix usage of SetThreadAffinityMask
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (13 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 15/30] ada: Fix usage of SetThreadIdealProcessor Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 17/30] ada: Remove streaming facilities from generics for formal containers Marc Poulhiès
` (13 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Ronan Desplanques
From: Ronan Desplanques <desplanques@adacore.com>
This patches fixes the signature of the binding to SetThreadAffinityMask
in the run-time library. It also fixes the error checking after calls
to SetThreadAffinityMask. The previous code behaved as if
SetThreadAffinityMask returned 1 on success, but it in fact returns a
pointer value on success and 0 on failure.
gcc/ada/
* libgnarl/s-taprop__mingw.adb (Set_Task_Affinity): Fix usage of
SetThreadAffinityMask.
* libgnat/s-winext.ads (SetThreadAffinityMask): Fix binding
signature.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/libgnarl/s-taprop__mingw.adb | 6 +++---
gcc/ada/libgnat/s-winext.ads | 2 +-
2 files changed, 4 insertions(+), 4 deletions(-)
diff --git a/gcc/ada/libgnarl/s-taprop__mingw.adb b/gcc/ada/libgnarl/s-taprop__mingw.adb
index 38e281cb721..f77d71970b8 100644
--- a/gcc/ada/libgnarl/s-taprop__mingw.adb
+++ b/gcc/ada/libgnarl/s-taprop__mingw.adb
@@ -1340,7 +1340,7 @@ package body System.Task_Primitives.Operations is
then
declare
CPU_Set : DWORD := 0;
-
+ Mask_Result : DWORD_PTR;
begin
for Proc in T.Common.Domain'Range loop
if T.Common.Domain (Proc) then
@@ -1352,8 +1352,8 @@ package body System.Task_Primitives.Operations is
end if;
end loop;
- Result := SetThreadAffinityMask (T.Common.LL.Thread, CPU_Set);
- pragma Assert (Result = 1);
+ Mask_Result := SetThreadAffinityMask (T.Common.LL.Thread, CPU_Set);
+ pragma Assert (Mask_Result /= 0);
end;
end if;
end Set_Task_Affinity;
diff --git a/gcc/ada/libgnat/s-winext.ads b/gcc/ada/libgnat/s-winext.ads
index 3f14fc04e60..b402a5615c9 100644
--- a/gcc/ada/libgnat/s-winext.ads
+++ b/gcc/ada/libgnat/s-winext.ads
@@ -55,7 +55,7 @@ package System.Win32.Ext is
function SetThreadAffinityMask
(hThread : HANDLE;
- dwThreadAffinityMask : DWORD) return DWORD;
+ dwThreadAffinityMask : DWORD) return DWORD_PTR;
pragma Import (Stdcall, SetThreadAffinityMask, "SetThreadAffinityMask");
--------------
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 17/30] ada: Remove streaming facilities from generics for formal containers
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (14 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 16/30] ada: Fix usage of SetThreadAffinityMask Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 18/30] ada: Tune code related to potentially unevaluated expressions Marc Poulhiès
` (12 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Yannick Moy
From: Yannick Moy <moy@adacore.com>
The dependency on Ada.Streams is problematic for light runtimes.
As these streaming facilities are in fact not used in formal containers,
remove the corresponding dead code.
gcc/ada/
* libgnat/a-chtgfo.adb (Generic_Read, Generic_Write): Remove.
* libgnat/a-chtgfo.ads: Same. Remove dependency on Ada.Streams.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/libgnat/a-chtgfo.adb | 68 ------------------------------------
gcc/ada/libgnat/a-chtgfo.ads | 24 -------------
2 files changed, 92 deletions(-)
diff --git a/gcc/ada/libgnat/a-chtgfo.adb b/gcc/ada/libgnat/a-chtgfo.adb
index c3fff336e9d..df7b554c050 100644
--- a/gcc/ada/libgnat/a-chtgfo.adb
+++ b/gcc/ada/libgnat/a-chtgfo.adb
@@ -359,74 +359,6 @@ package body Ada.Containers.Hash_Tables.Generic_Formal_Operations is
end loop;
end Generic_Iteration;
- ------------------
- -- Generic_Read --
- ------------------
-
- procedure Generic_Read
- (Stream : not null access Root_Stream_Type'Class;
- HT : out Hash_Table_Type)
- is
- N : Count_Type'Base;
-
- begin
- Clear (HT);
-
- Count_Type'Base'Read (Stream, N);
-
- if Checks and then N < 0 then
- raise Program_Error with "stream appears to be corrupt";
- end if;
-
- if N = 0 then
- return;
- end if;
-
- if Checks and then N > HT.Capacity then
- raise Capacity_Error with "too many elements in stream";
- end if;
-
- for J in 1 .. N loop
- declare
- Node : constant Count_Type := New_Node (Stream);
- Indx : constant Hash_Type := Index (HT, HT.Nodes (Node));
- B : Count_Type renames HT.Buckets (Indx);
- begin
- Set_Next (HT.Nodes (Node), Next => B);
- B := Node;
- end;
-
- HT.Length := HT.Length + 1;
- end loop;
- end Generic_Read;
-
- -------------------
- -- Generic_Write --
- -------------------
-
- procedure Generic_Write
- (Stream : not null access Root_Stream_Type'Class;
- HT : Hash_Table_Type)
- is
- procedure Write (Node : Count_Type);
- pragma Inline (Write);
-
- procedure Write is new Generic_Iteration (Write);
-
- -----------
- -- Write --
- -----------
-
- procedure Write (Node : Count_Type) is
- begin
- Write (Stream, HT.Nodes (Node));
- end Write;
-
- begin
- Count_Type'Base'Write (Stream, HT.Length);
- Write (HT);
- end Generic_Write;
-
-----------
-- Index --
-----------
diff --git a/gcc/ada/libgnat/a-chtgfo.ads b/gcc/ada/libgnat/a-chtgfo.ads
index 76633d8da05..f4471bec3d2 100644
--- a/gcc/ada/libgnat/a-chtgfo.ads
+++ b/gcc/ada/libgnat/a-chtgfo.ads
@@ -30,8 +30,6 @@
-- Hash_Table_Type is used to implement hashed containers. This package
-- declares hash-table operations that do not depend on keys.
-with Ada.Streams;
-
generic
with package HT_Types is
new Generic_Formal_Hash_Table_Types (<>);
@@ -113,26 +111,4 @@ package Ada.Containers.Hash_Tables.Generic_Formal_Operations is
procedure Generic_Iteration (HT : Hash_Table_Type);
-- Calls Process for each node in hash table HT
- generic
- use Ada.Streams;
- with procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Node : Node_Type);
- procedure Generic_Write
- (Stream : not null access Root_Stream_Type'Class;
- HT : Hash_Table_Type);
- -- Used to implement the streaming attribute for hashed containers. It
- -- calls Write for each node to write its value into Stream.
-
- generic
- use Ada.Streams;
- with function New_Node (Stream : not null access Root_Stream_Type'Class)
- return Count_Type;
- procedure Generic_Read
- (Stream : not null access Root_Stream_Type'Class;
- HT : out Hash_Table_Type);
- -- Used to implement the streaming attribute for hashed containers. It
- -- first clears hash table HT, then populates the hash table by calling
- -- New_Node for each item in Stream.
-
end Ada.Containers.Hash_Tables.Generic_Formal_Operations;
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 18/30] ada: Tune code related to potentially unevaluated expressions
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (15 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 17/30] ada: Remove streaming facilities from generics for formal containers Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 19/30] ada: Fix references to Ada RM in comments Marc Poulhiès
` (11 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Piotr Trojanek
From: Piotr Trojanek <trojanek@adacore.com>
Code cleanup; semantics is unaffected.
gcc/ada/
* sem_util.adb
(Immediate_Context_Implies_Is_Potentially_Unevaluated): Use
collective subtypes in membership tests.
(Is_Known_On_Entry): Require all alternatives in a case statement
to return; this change could prevent a recently fixed glitch,
where one of the alternatives relied on the return statement
afterwards (also, the new code is shorter).
* sem_util.ads (Is_Potentially_Unevaluated): Clarify that this
routine applies to Ada 2012.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_util.adb | 8 +++-----
gcc/ada/sem_util.ads | 2 +-
2 files changed, 4 insertions(+), 6 deletions(-)
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 241be3d2957..5bea088c44e 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -19485,10 +19485,10 @@ package body Sem_Util is
elsif Nkind (Par) = N_Case_Expression then
return Expr /= Expression (Par);
- elsif Nkind (Par) in N_And_Then | N_Or_Else then
+ elsif Nkind (Par) in N_Short_Circuit then
return Expr = Right_Opnd (Par);
- elsif Nkind (Par) in N_In | N_Not_In then
+ elsif Nkind (Par) in N_Membership_Test then
-- If the membership includes several alternatives, only the first
-- is definitely evaluated.
@@ -30880,10 +30880,8 @@ package body Sem_Util is
return True;
when others =>
- null;
+ return False;
end case;
-
- return False;
end Is_Known_On_Entry;
end Conditional_Evaluation;
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 4fef8966380..f282d1fad99 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -2219,7 +2219,7 @@ package Sem_Util is
-- type be partially initialized.
function Is_Potentially_Unevaluated (N : Node_Id) return Boolean;
- -- Predicate to implement definition given in RM 6.1.1 (20/3)
+ -- Predicate to implement definition given in RM 2012 6.1.1 (20/3)
function Is_Potentially_Persistent_Type (T : Entity_Id) return Boolean;
-- Determines if type T is a potentially persistent type. A potentially
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 19/30] ada: Fix references to Ada RM in comments
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (16 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 18/30] ada: Tune code related to potentially unevaluated expressions Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 20/30] ada: Further refine 'Super attribute Marc Poulhiès
` (10 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Piotr Trojanek
From: Piotr Trojanek <trojanek@adacore.com>
We seem to have a convention of using "RM" in the GNAT comments, not
"Ada RM". Also, the paragraph references by convention should appear
in parentheses, e.g. "8.3(12.3/2)", not "8.3 12.3/2".
gcc/ada/
* einfo.ads, exp_attr.adb, exp_ch4.adb, exp_ch7.adb,
lib-writ.adb, libgnat/a-stbuut.ads, sem_ch13.adb, sem_ch3.adb,
sem_ch7.adb: Use "RM" in comments.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/einfo.ads | 2 +-
gcc/ada/exp_attr.adb | 4 ++--
gcc/ada/exp_ch4.adb | 2 +-
gcc/ada/exp_ch7.adb | 2 +-
gcc/ada/lib-writ.adb | 3 +--
gcc/ada/libgnat/a-stbuut.ads | 2 +-
gcc/ada/sem_ch13.adb | 4 ++--
gcc/ada/sem_ch3.adb | 2 +-
gcc/ada/sem_ch7.adb | 2 +-
9 files changed, 11 insertions(+), 12 deletions(-)
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index e5110f51670..0b0529a39cf 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2728,7 +2728,7 @@ package Einfo is
-- Defined in all entities. Set for implicitly declared subprograms
-- that require overriding or are null procedures, and are hidden by
-- a non-fully conformant homograph with the same characteristics
--- (Ada RM 8.3 12.3/2).
+-- (RM 8.3(12.3/2)).
-- Is_Hidden_Open_Scope
-- Defined in all entities. Set for a scope that contains the
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 0349db28a1a..1396007a2d1 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -2173,8 +2173,8 @@ package body Exp_Attr is
-- for the arguments of a 'Read attribute reference (since the
-- scalar argument is an OUT scalar) and for the arguments of a
-- 'Has_Same_Storage or 'Overlaps_Storage attribute reference (which not
- -- considered to be reads of their prefixes and expressions, see Ada RM
- -- 13.3(73.10/3)).
+ -- considered to be reads of their prefixes and expressions, see
+ -- RM 13.3(73.10/3)).
if Validity_Checks_On and then Validity_Check_Operands
and then Id /= Attribute_Asm_Output
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 6ceffdf8302..95b7765b173 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -8512,7 +8512,7 @@ package body Exp_Ch4 is
-- For small negative exponents, we return the reciprocal of
-- the folding of the exponentiation for the opposite (positive)
- -- exponent, as required by Ada RM 4.5.6(11/3).
+ -- exponent, as required by RM 4.5.6(11/3).
if abs Expv <= 4 then
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 993c13c7318..fd1d9db0654 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -7419,7 +7419,7 @@ package body Exp_Ch7 is
-- non-POC components are finalized before the
-- non-POC extension components. This violates the
-- usual "finalize in reverse declaration order"
- -- principle, but that's ok (see Ada RM 7.6.1(9)).
+ -- principle, but that's ok (see RM 7.6.1(9)).
--
-- Last_POC_Call should be non-empty if the extension
-- has at least one POC. Interactions with variant
diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb
index 697b2f2b797..0755b92e4db 100644
--- a/gcc/ada/lib-writ.adb
+++ b/gcc/ada/lib-writ.adb
@@ -298,8 +298,7 @@ package body Lib.Writ is
function Is_Implicit_With_Clause (Clause : Node_Id) return Boolean is
begin
-- With clauses created for ancestor units are marked as internal,
- -- however, they emulate the semantics in Ada RM 10.1.2 (6/2),
- -- where
+ -- however, they emulate the semantics in RM 10.1.2 (6/2), where
--
-- with A.B;
--
diff --git a/gcc/ada/libgnat/a-stbuut.ads b/gcc/ada/libgnat/a-stbuut.ads
index dadfe5f0010..2a8b08bca57 100644
--- a/gcc/ada/libgnat/a-stbuut.ads
+++ b/gcc/ada/libgnat/a-stbuut.ads
@@ -33,7 +33,7 @@ with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
package Ada.Strings.Text_Buffers.Utils with Pure is
- -- Ada.Strings.Text_Buffers is a predefined unit (see Ada RM A.4.12).
+ -- Ada.Strings.Text_Buffers is a predefined unit (see RM A.4.12).
-- This is a GNAT-defined child unit of that parent.
subtype Character_7 is
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index c0a5b6c2c37..f84ca2c75d7 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -12860,7 +12860,7 @@ package body Sem_Ch13 is
procedure Hide_Non_Overridden_Subprograms (Typ : Entity_Id);
-- Inspect the primitive operations of type Typ and hide all pairs of
-- implicitly declared non-overridden non-fully conformant homographs
- -- (Ada RM 8.3 12.3/2).
+ -- (RM 8.3(12.3/2)).
-------------------------------------
-- Hide_Non_Overridden_Subprograms --
@@ -13028,7 +13028,7 @@ package body Sem_Ch13 is
-- overriding. If this set contains fully conformant homographs, then
-- one is chosen arbitrarily (already done during resolution), otherwise
-- all remaining non-fully conformant homographs are hidden from
- -- visibility (Ada RM 8.3 12.3/2).
+ -- visibility (RM 8.3(12.3/2)).
if Is_Tagged_Type (E) then
Hide_Non_Overridden_Subprograms (E);
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 263be607ec1..0403babff13 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -16553,7 +16553,7 @@ package body Sem_Ch3 is
New_Overloaded_Entity (New_Subp, Derived_Type);
- -- Ada RM 6.1.1 (15): If a subprogram inherits nonconforming class-wide
+ -- RM 6.1.1(15): If a subprogram inherits nonconforming class-wide
-- preconditions and the derived type is abstract, the derived operation
-- is abstract as well if parent subprogram is not abstract or null.
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index a70d72c94c1..09d85bea335 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -2400,7 +2400,7 @@ package body Sem_Ch7 is
-- Do not enter implicitly inherited non-overridden subprograms of
-- a tagged type back into visibility if they have non-conformant
- -- homographs (Ada RM 8.3 12.3/2).
+ -- homographs (RM 8.3(12.3/2)).
elsif Is_Hidden_Non_Overridden_Subpgm (Id) then
null;
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 20/30] ada: Further refine 'Super attribute
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (17 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 19/30] ada: Fix references to Ada RM in comments Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 21/30] ada: Unreferenced warning on abstract subprogram Marc Poulhiès
` (9 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Justin Squirek
From: Justin Squirek <squirek@adacore.com>
This patch adds the restriction on 'Super such that it cannot apply to objects
whose parent type is an interface.
gcc/ada/
* sem_attr.adb (Analyze_Attribute): Add check for interface parent
types.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_attr.adb | 6 ++++++
1 file changed, 6 insertions(+)
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 4fd270aeae9..2fd95f36d65 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -6683,6 +6683,12 @@ package body Sem_Attr is
elsif Depends_On_Private (P_Type) then
Error_Attr_P ("prefix type of % is a private extension");
+ -- Disallow view conversions to interfaces in order to avoid
+ -- depending on whether an interface type is used as a parent
+ -- or progenitor type.
+
+ elsif Is_Interface (Node (First_Elmt (Parents))) then
+ Error_Attr_P ("type of % cannot be an interface");
end if;
-- Generate a view conversion and analyze it
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 21/30] ada: Unreferenced warning on abstract subprogram
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (18 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 20/30] ada: Further refine 'Super attribute Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 22/30] ada: Crash checking accessibility level on private type Marc Poulhiès
` (8 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Justin Squirek
From: Justin Squirek <squirek@adacore.com>
This patch modifies the unreferenced entity warning in the compiler to avoid
noisily warning about unreferenced abstract subprogram.
gcc/ada/
* sem_warn.adb (Warn_On_Unreferenced_Entity): Add a condition to
ignore warnings on unreferenced abstract subprogram.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_warn.adb | 12 ++++++++----
1 file changed, 8 insertions(+), 4 deletions(-)
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 2de3f8668b0..91a57d521d1 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -4452,12 +4452,16 @@ package body Sem_Warn is
("?u?literal & is not referenced!", E);
when E_Function =>
- Error_Msg_N -- CODEFIX
- ("?u?function & is not referenced!", E);
+ if not Is_Abstract_Subprogram (E) then
+ Error_Msg_N -- CODEFIX
+ ("?u?function & is not referenced!", E);
+ end if;
when E_Procedure =>
- Error_Msg_N -- CODEFIX
- ("?u?procedure & is not referenced!", E);
+ if not Is_Abstract_Subprogram (E) then
+ Error_Msg_N -- CODEFIX
+ ("?u?procedure & is not referenced!", E);
+ end if;
when E_Package =>
Error_Msg_N -- CODEFIX
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 22/30] ada: Crash checking accessibility level on private type
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (19 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 21/30] ada: Unreferenced warning on abstract subprogram Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 23/30] ada: Iterator filter ignored on formal loop Marc Poulhiès
` (7 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Justin Squirek
From: Justin Squirek <squirek@adacore.com>
This patch fixes an issue in the compiler whereby calculating a static
accessibility level on a private type with an access discriminant resulted
in a compile time crash when No_Dynamic_Accessibility_Checks is enabled.
gcc/ada/
* accessibility.adb (Accessibility_Level): Use Get_Full_View to
avoid crashes when calculating scope.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/accessibility.adb | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb
index 33ce001718a..47b3a7af10a 100644
--- a/gcc/ada/accessibility.adb
+++ b/gcc/ada/accessibility.adb
@@ -2227,7 +2227,7 @@ package body Accessibility is
-- that of the type.
elsif Ekind (Def_Ent) = E_Discriminant then
- return Scope_Depth (Scope (Def_Ent));
+ return Scope_Depth (Get_Full_View (Scope (Def_Ent)));
end if;
end if;
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 23/30] ada: Iterator filter ignored on formal loop
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (20 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 22/30] ada: Crash checking accessibility level on private type Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 24/30] ada: Missing style check for extra parentheses in operators Marc Poulhiès
` (6 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Justin Squirek
From: Justin Squirek <squirek@adacore.com>
This patch fixs an issue where iterator filters for formal container and
formal container element loops got silently ignored and remained unexpanded.
gcc/ada/
* exp_ch5.adb (Expand_Formal_Container_Element_Loop): Add
expansion of filter condition.
(Expand_Formal_Container_Loop): Add expansion of filter condition.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch5.adb | 45 +++++++++++++++++++++++++++++++++++++--------
1 file changed, 37 insertions(+), 8 deletions(-)
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 2973658ce98..f397086d73a 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -4394,6 +4394,18 @@ package body Exp_Ch5 is
Reinit_Field_To_Zero (Init_Name, F_SPARK_Pragma_Inherited);
Mutate_Ekind (Init_Name, E_Loop_Parameter);
+ -- Wrap the block statements with the condition specified in the
+ -- iterator filter when one is present.
+
+ if Present (Iterator_Filter (I_Spec)) then
+ pragma Assert (Ada_Version >= Ada_2022);
+ Set_Statements (Handled_Statement_Sequence (N),
+ New_List (Make_If_Statement (Loc,
+ Condition => Iterator_Filter (I_Spec),
+ Then_Statements =>
+ Statements (Handled_Statement_Sequence (N)))));
+ end if;
+
-- The cursor was marked as a loop parameter to prevent user assignments
-- to it, however this renders the advancement step illegal as it is not
-- possible to change the value of a constant. Flag the advancement step
@@ -4436,6 +4448,7 @@ package body Exp_Ch5 is
Advance : Node_Id;
Init : Node_Id;
New_Loop : Node_Id;
+ Block : Node_Id;
begin
-- For an element iterator, the Element aspect must be present,
@@ -4456,7 +4469,6 @@ package body Exp_Ch5 is
Build_Formal_Container_Iteration
(N, Container, Cursor, Init, Advance, New_Loop);
- Append_To (Stats, Advance);
Mutate_Ekind (Cursor, E_Variable);
Insert_Action (N, Init);
@@ -4481,13 +4493,30 @@ package body Exp_Ch5 is
Convert_To_Iterable_Type (Container, Loc),
New_Occurrence_Of (Cursor, Loc))));
- Set_Statements (New_Loop,
- New_List
- (Make_Block_Statement (Loc,
- Declarations => New_List (Elmt_Decl),
- Handled_Statement_Sequence =>
- Make_Handled_Sequence_Of_Statements (Loc,
- Statements => Stats))));
+ Block :=
+ Make_Block_Statement (Loc,
+ Declarations => New_List (Elmt_Decl),
+ Handled_Statement_Sequence =>
+ Make_Handled_Sequence_Of_Statements (Loc,
+ Statements => Stats));
+
+ -- Wrap the block statements with the condition specified in the
+ -- iterator filter when one is present.
+
+ if Present (Iterator_Filter (I_Spec)) then
+ pragma Assert (Ada_Version >= Ada_2022);
+ Set_Statements (Handled_Statement_Sequence (Block),
+ New_List (
+ Make_If_Statement (Loc,
+ Condition => Iterator_Filter (I_Spec),
+ Then_Statements =>
+ Statements (Handled_Statement_Sequence (Block))),
+ Advance));
+ else
+ Append_To (Stats, Advance);
+ end if;
+
+ Set_Statements (New_Loop, New_List (Block));
-- The element is only modified in expanded code, so it appears as
-- unassigned to the warning machinery. We must suppress this spurious
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 24/30] ada: Missing style check for extra parentheses in operators
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (21 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 23/30] ada: Iterator filter ignored on formal loop Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 25/30] ada: Resolve compilation issues with container aggregates in draft ACATS B tests Marc Poulhiès
` (5 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Justin Squirek
From: Justin Squirek <squirek@adacore.com>
This patch fixes an issue in the compiler whereby wrapping an operand
of a boolean operator resulted in a failure to detect whether or not
they were unnecessary for the -gnatyx style checks.
gcc/ada/
* ali.adb (Get_Nat): Remove unnecessary parentheses.
* exp_ch11.adb (Expand_Local_Exception_Handlers): Remove
unnecessary parentheses.
* freeze.adb (Freeze_Entity): Remove unnecessary parentheses.
* lib-list.adb (List): Remove unnecessary parentheses.
* par-ch5.adb (P_Condition): Add extra parentheses checks on
condition operands.
* sem_ch3.adb (Add_Interface_Tag_Components): Remove unnecessary
parentheses.
(Check_Delta_Expression): Remove unnecessary parenthesis.
(Check_Digits_Expression): Remove unnecessary parentheses.
* sem_ch12.adb (Validate_Array_Type_Instance): Remove unnecessary
parentheses.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/ali.adb | 2 +-
gcc/ada/exp_ch11.adb | 2 +-
gcc/ada/freeze.adb | 2 +-
gcc/ada/lib-list.adb | 4 ++--
gcc/ada/par-ch5.adb | 25 +++++++++++++++++++++++++
gcc/ada/sem_ch12.adb | 2 +-
gcc/ada/sem_ch3.adb | 6 +++---
7 files changed, 34 insertions(+), 9 deletions(-)
diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb
index 69a91bce5ab..7c7f790325b 100644
--- a/gcc/ada/ali.adb
+++ b/gcc/ada/ali.adb
@@ -1351,7 +1351,7 @@ package body ALI is
-- Check if we are on a number. In the case of bad ALI files, this
-- may not be true.
- if not (Nextc in '0' .. '9') then
+ if Nextc not in '0' .. '9' then
Fatal_Error;
end if;
diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb
index 9a0f66ff440..678d76cf3eb 100644
--- a/gcc/ada/exp_ch11.adb
+++ b/gcc/ada/exp_ch11.adb
@@ -552,7 +552,7 @@ package body Exp_Ch11 is
-- Nothing to do if no handlers requiring the goto transformation
- if not (Local_Expansion_Required) then
+ if not Local_Expansion_Required then
return;
end if;
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index ea6106e6455..ea18f87a4ab 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -6963,7 +6963,7 @@ package body Freeze is
if Is_Type (Comp) then
Freeze_And_Append (Comp, N, Result);
- elsif (Ekind (Comp)) /= E_Function then
+ elsif Ekind (Comp) /= E_Function then
-- The guard on the presence of the Etype seems to be needed
-- for some CodePeer (-gnatcC) cases, but not clear why???
diff --git a/gcc/ada/lib-list.adb b/gcc/ada/lib-list.adb
index ecc29258e13..210827abf8e 100644
--- a/gcc/ada/lib-list.adb
+++ b/gcc/ada/lib-list.adb
@@ -80,7 +80,7 @@ begin
else
Write_Unit_Name (Unit_Name (Sorted_Units (R)));
- if Name_Len > (Unit_Length - 1) then
+ if Name_Len > Unit_Length - 1 then
Write_Eol;
Write_Str (Unit_Bln);
else
@@ -91,7 +91,7 @@ begin
Write_Name (Full_File_Name (Source_Index (Sorted_Units (R))));
- if Name_Len > (File_Length - 1) then
+ if Name_Len > File_Length - 1 then
Write_Eol;
Write_Str (Unit_Bln);
Write_Str (File_Bln);
diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb
index d72ddffdece..68c3025e3a0 100644
--- a/gcc/ada/par-ch5.adb
+++ b/gcc/ada/par-ch5.adb
@@ -1360,6 +1360,31 @@ package body Ch5 is
else
if Style_Check then
Style.Check_Xtra_Parens (Cond);
+
+ -- When the condition is an operator then examine parentheses
+ -- surrounding the condition's operands - taking care to avoid
+ -- flagging operands which themselves are operators since they
+ -- may be required for resolution or precedence.
+
+ if Nkind (Cond) in N_Op
+ | N_Membership_Test
+ | N_Short_Circuit
+ and then Nkind (Right_Opnd (Cond)) not in N_Op
+ | N_Membership_Test
+ | N_Short_Circuit
+ then
+ Style.Check_Xtra_Parens (Right_Opnd (Cond));
+ end if;
+
+ if Nkind (Cond) in N_Binary_Op
+ | N_Membership_Test
+ | N_Short_Circuit
+ and then Nkind (Left_Opnd (Cond)) not in N_Op
+ | N_Membership_Test
+ | N_Short_Circuit
+ then
+ Style.Check_Xtra_Parens (Left_Opnd (Cond));
+ end if;
end if;
-- And return the result
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 9919cda6340..7daa35f7fe1 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -13228,7 +13228,7 @@ package body Sem_Ch12 is
Abandon_Instantiation (Actual);
elsif Nkind (Def) = N_Constrained_Array_Definition then
- if not (Is_Constrained (Act_T)) then
+ if not Is_Constrained (Act_T) then
Error_Msg_NE
("expect constrained array in instantiation of &",
Actual, Gen_T);
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 0403babff13..cbe2ef8be54 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -1616,7 +1616,7 @@ package body Sem_Ch3 is
Last_Tag := Empty;
- if not (Present (Component_List (Ext))) then
+ if not Present (Component_List (Ext)) then
Set_Null_Present (Ext, False);
L := New_List;
Set_Component_List (Ext,
@@ -12454,7 +12454,7 @@ package body Sem_Ch3 is
procedure Check_Delta_Expression (E : Node_Id) is
begin
- if not (Is_Real_Type (Etype (E))) then
+ if not Is_Real_Type (Etype (E)) then
Wrong_Type (E, Any_Real);
elsif not Is_OK_Static_Expression (E) then
@@ -12482,7 +12482,7 @@ package body Sem_Ch3 is
procedure Check_Digits_Expression (E : Node_Id) is
begin
- if not (Is_Integer_Type (Etype (E))) then
+ if not Is_Integer_Type (Etype (E)) then
Wrong_Type (E, Any_Integer);
elsif not Is_OK_Static_Expression (E) then
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 25/30] ada: Resolve compilation issues with container aggregates in draft ACATS B tests
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (22 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 24/30] ada: Missing style check for extra parentheses in operators Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 26/30] ada: For freezing, treat an extension or delta aggregate like a regular aggregate Marc Poulhiès
` (4 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Gary Dismukes
From: Gary Dismukes <dismukes@adacore.com>
This change set addresses compilation problems encountered in the draft
versions of the following ACATS B tests for container aggregates:
B435001 (container aggregates with Assign_Indexed)
B435002 (container aggregates with Add_Unnamed)
B435003 (container aggregates with Add_Named)
B435004 (container aggregates with Assign_Indexed and Add_Unnamed)
gcc/ada/
* sem_aggr.adb (Resolve_Iterated_Association): In the case of
N_Iterated_Element_Associations that have a key expression, issue
an error if the aggregate type does not have an Add_Named
operation, and include a reference to RM22 4.3.5(24) in the error
message. In the case of an N_Component_Association with a
Defining_Identifer where the "choice" is given by a function call,
in the creation of the iterator_specification associate a copy of
Choice as its Name, and remove the call to
Analyze_Iterator_Specification, which was causing problems with
the reanalysis of function calls originally given in prefixed form
that were transformed into function calls in normal (infix) form.
The iterator_specification will be analyzed later in any case, so
that call should not be done here. Remove the with and use of
Sem_Ch5.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_aggr.adb | 26 ++++++++++++++++++++------
1 file changed, 20 insertions(+), 6 deletions(-)
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 60738550ec1..51b88ab831f 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -49,7 +49,6 @@ with Sem_Aux; use Sem_Aux;
with Sem_Case; use Sem_Case;
with Sem_Cat; use Sem_Cat;
with Sem_Ch3; use Sem_Ch3;
-with Sem_Ch5; use Sem_Ch5;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch13; use Sem_Ch13;
with Sem_Dim; use Sem_Dim;
@@ -3381,7 +3380,15 @@ package body Sem_Aggr is
Key_Expr := Key_Expression (Comp);
if Present (Key_Expr) then
- Preanalyze_And_Resolve (New_Copy_Tree (Key_Expr), Key_Type);
+ if not Present (Add_Named_Subp) then
+ Error_Msg_N
+ ("iterated_element_association with key_expression only "
+ & "allowed for container type with Add_Named operation "
+ & "(RM22 4.3.5(24))",
+ Comp);
+ else
+ Preanalyze_And_Resolve (New_Copy_Tree (Key_Expr), Key_Type);
+ end if;
end if;
End_Scope;
@@ -3414,6 +3421,16 @@ package body Sem_Aggr is
else
Choice := First (Discrete_Choices (Comp));
+ -- A copy of Choice is made before it's analyzed, to preserve
+ -- prefixed calls in their original form, because otherwise the
+ -- analysis of Choice can transform such calls to normal form,
+ -- and the later analysis of an iterator_specification created
+ -- below in the case of a function-call choice may trigger an
+ -- error on the call (in the case where the function is not
+ -- directly visible).
+
+ Copy := Copy_Separate_Tree (Choice);
+
-- This is an N_Component_Association with a Defining_Identifier
-- and Discrete_Choice_List, but the latter can only have a single
-- choice, as it's a stand-in for a Loop_Parameter_Specification
@@ -3437,7 +3454,7 @@ package body Sem_Aggr is
Make_Iterator_Specification (Sloc (N),
Defining_Identifier =>
Relocate_Node (Defining_Identifier (Comp)),
- Name => New_Copy_Tree (Choice),
+ Name => Copy,
Reverse_Present => False,
Iterator_Filter => Empty,
Subtype_Indication => Empty);
@@ -3445,9 +3462,6 @@ package body Sem_Aggr is
Set_Iterator_Specification (Comp, I_Spec);
Set_Defining_Identifier (Comp, Empty);
- Analyze_Iterator_Specification
- (Iterator_Specification (Comp));
-
Resolve_Iterated_Association (Comp, Key_Type, Elmt_Type);
-- Recursive call to expand association as iterator_spec
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 26/30] ada: For freezing, treat an extension or delta aggregate like a regular aggregate.
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (23 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 25/30] ada: Resolve compilation issues with container aggregates in draft ACATS B tests Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 27/30] ada: Minor code adjustment to "not Present" test Marc Poulhiès
` (3 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Steve Baird
From: Steve Baird <baird@adacore.com>
Extend existing special freezing rules for regular aggregates to also apply to
extension and delta aggregates.
gcc/ada/
* freeze.adb
(Should_Freeze_Type.Is_Dispatching_Call_Or_Aggregate): Treat an extension
aggregate or a delta aggregate like a regular aggregate.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/freeze.adb | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index ea18f87a4ab..c872050dd35 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -222,7 +222,9 @@ package body Freeze is
= Scope (Typ)
then
return Abandon;
- elsif Nkind (N) = N_Aggregate
+ elsif Nkind (N) in N_Aggregate
+ | N_Extension_Aggregate
+ | N_Delta_Aggregate
and then Base_Type (Etype (N)) = Base_Type (Typ)
then
return Abandon;
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 27/30] ada: Minor code adjustment to "not Present" test
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (24 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 26/30] ada: For freezing, treat an extension or delta aggregate like a regular aggregate Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 28/30] ada: Derived type with convention C must override convention C_Pass_By_Copy Marc Poulhiès
` (2 subsequent siblings)
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Gary Dismukes
From: Gary Dismukes <dismukes@adacore.com>
This is just changing a "not Present (...)" test to "No (...)"
to address a CB complaint from gnatcheck.
gcc/ada/
* sem_aggr.adb (Resolve_Iterated_Association): Change "not Present"
to "No" in test of Add_Named_Subp.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_aggr.adb | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 51b88ab831f..249350d21de 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -3380,7 +3380,7 @@ package body Sem_Aggr is
Key_Expr := Key_Expression (Comp);
if Present (Key_Expr) then
- if not Present (Add_Named_Subp) then
+ if No (Add_Named_Subp) then
Error_Msg_N
("iterated_element_association with key_expression only "
& "allowed for container type with Add_Named operation "
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 28/30] ada: Derived type with convention C must override convention C_Pass_By_Copy
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (25 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 27/30] ada: Minor code adjustment to "not Present" test Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 29/30] ada: Storage_Error in indirect call to function returning limited type Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 30/30] ada: Add support for No_Implicit_Conditionals to nonbinary modular types Marc Poulhiès
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Gary Dismukes
From: Gary Dismukes <dismukes@adacore.com>
If a type DT is derived from a record type T with convention C_Pass_By_Copy
and explicitly specifies convention C (via aspect or pragma), then type DT
should not be treated as a type with convention C_Pass_By_Copy. Any parameters
of the derived type should be passed by reference rather than by copy. The
compiler was incorrectly inheriting convention C_Pass_By_Copy, by inheriting
the flag set on the parent type, but that flag needs to be unset in the case
where the convention is overridden.
gcc/ada/
* sem_prag.adb (Set_Convention_From_Pragma): If the specified convention on
a record type is not C_Pass_By_Copy, then force the C_Pass_By_Copy flag to
False, to ensure that it's overridden.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_prag.adb | 9 +++++++++
1 file changed, 9 insertions(+)
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 9ccf1b9cf65..671b2a542ea 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -8498,6 +8498,15 @@ package body Sem_Prag is
end if;
end if;
+ -- If the convention of a record type is changed (such as to C),
+ -- this must override C_Pass_By_Copy if that flag was inherited
+ -- from a parent type where the latter convention was specified,
+ -- so we force the flag to False.
+
+ if Cname /= Name_C_Pass_By_Copy and then Is_Record_Type (E) then
+ Set_C_Pass_By_Copy (Base_Type (E), False);
+ end if;
+
-- If the entity is a derived boolean type, check for the special
-- case of convention C, C++, or Fortran, where we consider any
-- nonzero value to represent true.
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 29/30] ada: Storage_Error in indirect call to function returning limited type
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (26 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 28/30] ada: Derived type with convention C must override convention C_Pass_By_Copy Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
2024-06-10 9:07 ` [COMMITTED 30/30] ada: Add support for No_Implicit_Conditionals to nonbinary modular types Marc Poulhiès
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Javier Miranda
From: Javier Miranda <miranda@adacore.com>
At runtime the code generated by the compiler reports the
exception Storage_Error in an indirect call through an
access-to-subprogram variable that references a function
returning a limited tagged type object.
gcc/ada/
* sem_ch6.adb (Might_Need_BIP_Task_Actuals): Add support
for access-to-subprogram parameter types.
* exp_ch6.adb (Add_Task_Actuals_To_Build_In_Place_Call):
Add dummy BIP parameters to access-to-subprogram types
that may reference a function that has BIP parameters.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch6.adb | 11 ++++++++---
gcc/ada/sem_ch6.adb | 12 +++++++-----
2 files changed, 15 insertions(+), 8 deletions(-)
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index b5c5865242d..005210ce6bd 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -642,15 +642,20 @@ package body Exp_Ch6 is
Master_Formal : Node_Id;
begin
+ pragma Assert (Ekind (Function_Id) in E_Function
+ | E_Subprogram_Type);
+
-- No such extra parameters are needed if there are no tasks
if not Needs_BIP_Task_Actuals (Function_Id) then
-- However we must add dummy extra actuals if the function is
- -- a dispatching operation that inherited these extra formals.
+ -- a dispatching operation that inherited these extra formals
+ -- or an access-to-subprogram type that requires these extra
+ -- actuals.
- if Is_Dispatching_Operation (Function_Id)
- and then Has_BIP_Extra_Formal (Function_Id, BIP_Task_Master)
+ if Has_BIP_Extra_Formal (Function_Id, BIP_Task_Master,
+ Must_Be_Frozen => False)
then
Master_Formal :=
Build_In_Place_Formal (Function_Id, BIP_Task_Master);
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index ca40b5479e0..50dac5c4a51 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -8663,9 +8663,12 @@ package body Sem_Ch6 is
-- Determines if E has its extra formals
function Might_Need_BIP_Task_Actuals (E : Entity_Id) return Boolean;
- -- Determines if E is a dispatching primitive returning a limited tagged
- -- type object since some descendant might return an object with tasks
- -- (and therefore need the BIP task extra actuals).
+ -- Determines if E is a function or an access to a function returning a
+ -- limited tagged type object. On dispatching primitives this predicate
+ -- is used to determine if some descendant of the function might return
+ -- an object with tasks (and therefore need the BIP task extra actuals).
+ -- On access-to-subprogram types it is used to determine if the target
+ -- function might return an object with tasks.
function Needs_Accessibility_Check_Extra
(E : Entity_Id;
@@ -8786,9 +8789,8 @@ package body Sem_Ch6 is
Func_Typ := Root_Type (Underlying_Type (Etype (Subp_Id)));
- return Ekind (Subp_Id) = E_Function
+ return Ekind (Subp_Id) in E_Function | E_Subprogram_Type
and then not Has_Foreign_Convention (Func_Typ)
- and then Is_Dispatching_Operation (Subp_Id)
and then Is_Tagged_Type (Func_Typ)
and then Is_Limited_Type (Func_Typ)
and then not Has_Aspect (Func_Typ, Aspect_No_Task_Parts);
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread* [COMMITTED 30/30] ada: Add support for No_Implicit_Conditionals to nonbinary modular types
2024-06-10 9:07 [COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances Marc Poulhiès
` (27 preceding siblings ...)
2024-06-10 9:07 ` [COMMITTED 29/30] ada: Storage_Error in indirect call to function returning limited type Marc Poulhiès
@ 2024-06-10 9:07 ` Marc Poulhiès
28 siblings, 0 replies; 30+ messages in thread
From: Marc Poulhiès @ 2024-06-10 9:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Eric Botcazou
From: Eric Botcazou <ebotcazou@adacore.com>
The expansion of additive operations for nonbinary modular types implemented
in the front-end and its counterpart in code generators may create branches,
which is not allowed when restriction No_Implicit_Conditionals is in effect.
This changes it to use an explicit Mod operation when the restriction is in
effect, which is assumed not to create such branches.
gcc/ada/
* exp_ch4.adb (Expand_Nonbinary_Modular_Op): Create an explicit Mod
for additive operations if No_Implicit_Conditionals is in effect.
(Expand_Modular_Addition): Likewise.
(Expand_Modular_Subtraction): Likewise.
(Expand_Modular_Op): Always use an unsigned type obtained by calling
Small_Integer_Type_For on the required size.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch4.adb | 132 ++++++++++++++++++++++++++------------------
1 file changed, 77 insertions(+), 55 deletions(-)
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 95b7765b173..bf90b46249a 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -139,9 +139,10 @@ package body Exp_Ch4 is
-- case of array type arguments.
procedure Expand_Nonbinary_Modular_Op (N : Node_Id);
- -- When generating C code, convert nonbinary modular arithmetic operations
- -- into code that relies on the front-end expansion of operator Mod. No
- -- expansion is performed if N is not a nonbinary modular operand.
+ -- When generating C code or if restriction No_Implicit_Conditionals is in
+ -- effect, convert most nonbinary modular arithmetic operations into code
+ -- that relies on the expansion of an explicit Mod operator. No expansion
+ -- is performed if N is not a nonbinary modular operation.
procedure Expand_Short_Circuit_Operator (N : Node_Id);
-- Common expansion processing for short-circuit boolean operators
@@ -3899,10 +3900,13 @@ package body Exp_Ch4 is
procedure Expand_Modular_Addition is
begin
- -- If this is not the addition of a constant then compute it using
- -- the general rule: (lhs + rhs) mod Modulus
+ -- If this is not the addition of a constant or else restriction
+ -- No_Implicit_Conditionals is in effect, then compute it using
+ -- the general rule: (lhs + rhs) mod Modulus.
- if Nkind (Right_Opnd (N)) /= N_Integer_Literal then
+ if Nkind (Right_Opnd (N)) /= N_Integer_Literal
+ or else Restriction_Active (No_Implicit_Conditionals)
+ then
Expand_Modular_Op;
-- If this is an addition of a constant, convert it to a subtraction
@@ -3921,6 +3925,7 @@ package body Exp_Ch4 is
Cond_Expr : Node_Id;
Then_Expr : Node_Id;
Else_Expr : Node_Id;
+
begin
-- To prevent spurious visibility issues, convert all
-- operands to Standard.Unsigned.
@@ -3966,12 +3971,12 @@ package body Exp_Ch4 is
-- We will convert to another type (not a nonbinary-modulus modular
-- type), evaluate the op in that representation, reduce the result,
-- and convert back to the original type. This means that the
- -- backend does not have to deal with nonbinary-modulus ops.
-
- Op_Expr : constant Node_Id := New_Op_Node (Nkind (N), Loc);
- Mod_Expr : Node_Id;
+ -- back end does not have to deal with nonbinary-modulus ops.
+ Mod_Expr : Node_Id;
+ Op_Expr : Node_Id;
Target_Type : Entity_Id;
+
begin
-- Select a target type that is large enough to avoid spurious
-- intermediate overflow on pre-reduction computation (for
@@ -3979,22 +3984,15 @@ package body Exp_Ch4 is
declare
Required_Size : Uint := RM_Size (Etype (N));
- Use_Unsigned : Boolean := True;
+
begin
case Nkind (N) is
- when N_Op_Add =>
+ when N_Op_Add | N_Op_Subtract =>
-- For example, if modulus is 255 then RM_Size will be 8
-- and the range of possible values (before reduction) will
-- be 0 .. 508; that range requires 9 bits.
Required_Size := Required_Size + 1;
- when N_Op_Subtract =>
- -- For example, if modulus is 255 then RM_Size will be 8
- -- and the range of possible values (before reduction) will
- -- be -254 .. 254; that range requires 9 bits, signed.
- Use_Unsigned := False;
- Required_Size := Required_Size + 1;
-
when N_Op_Multiply =>
-- For example, if modulus is 255 then RM_Size will be 8
-- and the range of possible values (before reduction) will
@@ -4005,37 +4003,15 @@ package body Exp_Ch4 is
null;
end case;
- if Use_Unsigned then
- if Required_Size <= Standard_Short_Short_Integer_Size then
- Target_Type := Standard_Short_Short_Unsigned;
- elsif Required_Size <= Standard_Short_Integer_Size then
- Target_Type := Standard_Short_Unsigned;
- elsif Required_Size <= Standard_Integer_Size then
- Target_Type := Standard_Unsigned;
- else
- pragma Assert (Required_Size <= 64);
- Target_Type := Standard_Unsigned_64;
- end if;
- elsif Required_Size <= 8 then
- Target_Type := Standard_Integer_8;
- elsif Required_Size <= 16 then
- Target_Type := Standard_Integer_16;
- elsif Required_Size <= 32 then
- Target_Type := Standard_Integer_32;
- else
- pragma Assert (Required_Size <= 64);
- Target_Type := Standard_Integer_64;
- end if;
-
+ Target_Type := Small_Integer_Type_For (Required_Size, Uns => True);
pragma Assert (Present (Target_Type));
end;
+ Op_Expr := New_Op_Node (Nkind (N), Loc);
Set_Left_Opnd (Op_Expr,
- Unchecked_Convert_To (Target_Type,
- New_Copy_Tree (Left_Opnd (N))));
+ Unchecked_Convert_To (Target_Type, New_Copy_Tree (Left_Opnd (N))));
Set_Right_Opnd (Op_Expr,
- Unchecked_Convert_To (Target_Type,
- New_Copy_Tree (Right_Opnd (N))));
+ Unchecked_Convert_To (Target_Type, New_Copy_Tree (Right_Opnd (N))));
-- ??? Why do this stuff for some ops and not others?
if Nkind (N) not in N_Op_And | N_Op_Or | N_Op_Xor then
@@ -4064,13 +4040,24 @@ package body Exp_Ch4 is
Force_Evaluation (Op_Expr, Mode => Strict);
end if;
+ -- Unconditionally add the modulus to the result for a subtraction,
+ -- this gets rid of all its peculiarities by cancelling out the
+ -- addition of the binary modulus in the case where the subtraction
+ -- wraps around in Target_Type.
+
+ if Nkind (N) = N_Op_Subtract then
+ Op_Expr :=
+ Make_Op_Add (Loc,
+ Left_Opnd => Op_Expr,
+ Right_Opnd => Make_Integer_Literal (Loc, Modulus (Typ)));
+ end if;
+
Mod_Expr :=
Make_Op_Mod (Loc,
Left_Opnd => Op_Expr,
Right_Opnd => Make_Integer_Literal (Loc, Modulus (Typ)));
- Rewrite (N,
- Unchecked_Convert_To (Typ, Mod_Expr));
+ Rewrite (N, Unchecked_Convert_To (Typ, Mod_Expr));
end Expand_Modular_Op;
--------------------------------
@@ -4079,10 +4066,13 @@ package body Exp_Ch4 is
procedure Expand_Modular_Subtraction is
begin
- -- If this is not the addition of a constant then compute it using
- -- the general rule: (lhs + rhs) mod Modulus
+ -- If this is not the addition of a constant or else restriction
+ -- No_Implicit_Conditionals is in effect, then compute it using
+ -- the general rule: (lhs - rhs) mod Modulus.
- if Nkind (Right_Opnd (N)) /= N_Integer_Literal then
+ if Nkind (Right_Opnd (N)) /= N_Integer_Literal
+ or else Restriction_Active (No_Implicit_Conditionals)
+ then
Expand_Modular_Op;
-- If this is an addition of a constant, convert it to a subtraction
@@ -4101,6 +4091,7 @@ package body Exp_Ch4 is
Cond_Expr : Node_Id;
Then_Expr : Node_Id;
Else_Expr : Node_Id;
+
begin
Cond_Expr :=
Make_Op_Lt (Loc,
@@ -4139,23 +4130,46 @@ package body Exp_Ch4 is
-- Start of processing for Expand_Nonbinary_Modular_Op
begin
- -- No action needed if front-end expansion is not required or if we
- -- have a binary modular operand.
+ -- No action needed if we have a binary modular operand
- if not Expand_Nonbinary_Modular_Ops
- or else not Non_Binary_Modulus (Typ)
- then
+ if not Non_Binary_Modulus (Typ) then
return;
end if;
case Nkind (N) is
when N_Op_Add =>
+ -- No action needed if front-end expansion is not required and
+ -- restriction No_Implicit_Conditionals is not in effect.
+
+ if not Expand_Nonbinary_Modular_Ops
+ and then not Restriction_Active (No_Implicit_Conditionals)
+ then
+ return;
+ end if;
+
Expand_Modular_Addition;
when N_Op_Subtract =>
+ -- No action needed if front-end expansion is not required and
+ -- restriction No_Implicit_Conditionals is not in effect.
+
+ if not Expand_Nonbinary_Modular_Ops
+ and then not Restriction_Active (No_Implicit_Conditionals)
+ then
+ return;
+ end if;
+
Expand_Modular_Subtraction;
when N_Op_Minus =>
+ -- No action needed if front-end expansion is not required and
+ -- restriction No_Implicit_Conditionals is not in effect.
+
+ if not Expand_Nonbinary_Modular_Ops
+ and then not Restriction_Active (No_Implicit_Conditionals)
+ then
+ return;
+ end if;
-- Expand -expr into (0 - expr)
@@ -4166,6 +4180,14 @@ package body Exp_Ch4 is
Analyze_And_Resolve (N, Typ);
when others =>
+ -- No action needed only if front-end expansion is not required
+ -- because we assume that logical and multiplicative operations
+ -- do not involve implicit conditionals.
+
+ if not Expand_Nonbinary_Modular_Ops then
+ return;
+ end if;
+
Expand_Modular_Op;
end case;
--
2.45.1
^ permalink raw reply [flat|nested] 30+ messages in thread