From 8408120fecc56385b316dafec1bdfe3aac61fc05 Mon Sep 17 00:00:00 2001 From: Kewen Lin Date: Mon, 7 Nov 2022 02:07:27 -0600 Subject: vect: Fold LEN_{LOAD,STORE} if it's for the whole vector [PR107412] As the test case in PR107412 shows, we can fold IFN .LEN_{LOAD, STORE} into normal vector load/store if the given length is known to be equal to the length of the whole vector. It would help to improve overall cycles as normally the latency of vector access with length in bytes is bigger than normal vector access, and it also saves the preparation for length if constant length can not be encoded into instruction (such as on power). PR tree-optimization/107412 gcc/ChangeLog: * gimple-fold.cc (gimple_fold_mask_load_store_mem_ref): Rename to ... (gimple_fold_partial_load_store_mem_ref): ... this, add one parameter mask_p indicating it's for mask or length, and add some handlings for IFN LEN_{LOAD,STORE}. (gimple_fold_mask_load): Rename to ... (gimple_fold_partial_load): ... this, add one parameter mask_p. (gimple_fold_mask_store): Rename to ... (gimple_fold_partial_store): ... this, add one parameter mask_p. (gimple_fold_call): Add the handlings for IFN LEN_{LOAD,STORE}, and adjust calls on gimple_fold_mask_load_store_mem_ref to gimple_fold_partial_load_store_mem_ref. gcc/testsuite/ChangeLog: * gcc.target/powerpc/pr107412.c: New test. * gcc.target/powerpc/p9-vec-length-epil-8.c: Adjust scan times for folded LEN_LOAD. --- gcc/gimple-fold.cc | 57 +++++++++++++++++----- .../gcc.target/powerpc/p9-vec-length-epil-8.c | 2 +- gcc/testsuite/gcc.target/powerpc/pr107412.c | 19 ++++++++ 3 files changed, 64 insertions(+), 14 deletions(-) create mode 100644 gcc/testsuite/gcc.target/powerpc/pr107412.c (limited to 'gcc') diff --git a/gcc/gimple-fold.cc b/gcc/gimple-fold.cc index 9055cd8..410544c 100644 --- a/gcc/gimple-fold.cc +++ b/gcc/gimple-fold.cc @@ -5370,19 +5370,39 @@ arith_overflowed_p (enum tree_code code, const_tree type, return wi::min_precision (wres, sign) > TYPE_PRECISION (type); } -/* If IFN_MASK_LOAD/STORE call CALL is unconditional, return a MEM_REF +/* If IFN_{MASK,LEN}_LOAD/STORE call CALL is unconditional, return a MEM_REF for the memory it references, otherwise return null. VECTYPE is the - type of the memory vector. */ + type of the memory vector. MASK_P indicates it's for MASK if true, + otherwise it's for LEN. */ static tree -gimple_fold_mask_load_store_mem_ref (gcall *call, tree vectype) +gimple_fold_partial_load_store_mem_ref (gcall *call, tree vectype, bool mask_p) { tree ptr = gimple_call_arg (call, 0); tree alias_align = gimple_call_arg (call, 1); - tree mask = gimple_call_arg (call, 2); - if (!tree_fits_uhwi_p (alias_align) || !integer_all_onesp (mask)) + if (!tree_fits_uhwi_p (alias_align)) return NULL_TREE; + if (mask_p) + { + tree mask = gimple_call_arg (call, 2); + if (!integer_all_onesp (mask)) + return NULL_TREE; + } else { + tree basic_len = gimple_call_arg (call, 2); + if (!tree_fits_uhwi_p (basic_len)) + return NULL_TREE; + unsigned int nargs = gimple_call_num_args (call); + tree bias = gimple_call_arg (call, nargs - 1); + gcc_assert (tree_fits_uhwi_p (bias)); + tree biased_len = int_const_binop (MINUS_EXPR, basic_len, bias); + unsigned int len = tree_to_uhwi (biased_len); + unsigned int vect_len + = GET_MODE_SIZE (TYPE_MODE (vectype)).to_constant (); + if (vect_len != len) + return NULL_TREE; + } + unsigned HOST_WIDE_INT align = tree_to_uhwi (alias_align); if (TYPE_ALIGN (vectype) != align) vectype = build_aligned_type (vectype, align); @@ -5390,16 +5410,18 @@ gimple_fold_mask_load_store_mem_ref (gcall *call, tree vectype) return fold_build2 (MEM_REF, vectype, ptr, offset); } -/* Try to fold IFN_MASK_LOAD call CALL. Return true on success. */ +/* Try to fold IFN_{MASK,LEN}_LOAD call CALL. Return true on success. + MASK_P indicates it's for MASK if true, otherwise it's for LEN. */ static bool -gimple_fold_mask_load (gimple_stmt_iterator *gsi, gcall *call) +gimple_fold_partial_load (gimple_stmt_iterator *gsi, gcall *call, bool mask_p) { tree lhs = gimple_call_lhs (call); if (!lhs) return false; - if (tree rhs = gimple_fold_mask_load_store_mem_ref (call, TREE_TYPE (lhs))) + if (tree rhs + = gimple_fold_partial_load_store_mem_ref (call, TREE_TYPE (lhs), mask_p)) { gassign *new_stmt = gimple_build_assign (lhs, rhs); gimple_set_location (new_stmt, gimple_location (call)); @@ -5410,13 +5432,16 @@ gimple_fold_mask_load (gimple_stmt_iterator *gsi, gcall *call) return false; } -/* Try to fold IFN_MASK_STORE call CALL. Return true on success. */ +/* Try to fold IFN_{MASK,LEN}_STORE call CALL. Return true on success. + MASK_P indicates it's for MASK if true, otherwise it's for LEN. */ static bool -gimple_fold_mask_store (gimple_stmt_iterator *gsi, gcall *call) +gimple_fold_partial_store (gimple_stmt_iterator *gsi, gcall *call, + bool mask_p) { tree rhs = gimple_call_arg (call, 3); - if (tree lhs = gimple_fold_mask_load_store_mem_ref (call, TREE_TYPE (rhs))) + if (tree lhs + = gimple_fold_partial_load_store_mem_ref (call, TREE_TYPE (rhs), mask_p)) { gassign *new_stmt = gimple_build_assign (lhs, rhs); gimple_set_location (new_stmt, gimple_location (call)); @@ -5635,10 +5660,16 @@ gimple_fold_call (gimple_stmt_iterator *gsi, bool inplace) cplx_result = true; break; case IFN_MASK_LOAD: - changed |= gimple_fold_mask_load (gsi, stmt); + changed |= gimple_fold_partial_load (gsi, stmt, true); break; case IFN_MASK_STORE: - changed |= gimple_fold_mask_store (gsi, stmt); + changed |= gimple_fold_partial_store (gsi, stmt, true); + break; + case IFN_LEN_LOAD: + changed |= gimple_fold_partial_load (gsi, stmt, false); + break; + case IFN_LEN_STORE: + changed |= gimple_fold_partial_store (gsi, stmt, false); break; default: break; diff --git a/gcc/testsuite/gcc.target/powerpc/p9-vec-length-epil-8.c b/gcc/testsuite/gcc.target/powerpc/p9-vec-length-epil-8.c index 961df0d..8b9c910 100644 --- a/gcc/testsuite/gcc.target/powerpc/p9-vec-length-epil-8.c +++ b/gcc/testsuite/gcc.target/powerpc/p9-vec-length-epil-8.c @@ -8,5 +8,5 @@ #include "p9-vec-length-8.h" -/* { dg-final { scan-assembler-times {\mlxvl\M} 21 } } */ +/* { dg-final { scan-assembler-times {\mlxvl\M} 16 } } */ /* { dg-final { scan-assembler-times {\mstxvl\M} 7 } } */ diff --git a/gcc/testsuite/gcc.target/powerpc/pr107412.c b/gcc/testsuite/gcc.target/powerpc/pr107412.c new file mode 100644 index 0000000..4526ea8 --- /dev/null +++ b/gcc/testsuite/gcc.target/powerpc/pr107412.c @@ -0,0 +1,19 @@ +/* { dg-require-effective-target powerpc_p9vector_ok } */ +/* { dg-require-effective-target lp64 } */ +/* { dg-options "-mdejagnu-cpu=power9 -O2 -ftree-vectorize -fno-vect-cost-model -funroll-loops -fno-tree-loop-distribute-patterns --param vect-partial-vector-usage=2 -fdump-tree-optimized" } */ + +/* Verify there is only one IFN call LEN_LOAD and IFN_STORE separately. */ + +#define N 16 +int src[N]; +int dest[N]; + +void +foo () +{ + for (int i = 0; i < (N - 1); i++) + dest[i] = src[i]; +} + +/* { dg-final { scan-tree-dump-times {\mLEN_LOAD\M} 1 "optimized" } } */ +/* { dg-final { scan-tree-dump-times {\mLEN_STORE\M} 1 "optimized" } } */ -- cgit v1.1 From f74a049a5371d421c5f4637dfae1ce0afc8a01ff Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Wed, 12 Oct 2022 12:17:34 +0200 Subject: ada: Remove useless validity suppression for attribute Input Attributes 'Input and 'Read are similar, but only the 'Read denotes a subprogram with parameter of mode OUT where operand validity checks need to be suppressed. Cleanup related to fix for attributes 'Has_Same_Storage and 'Overlaps_Storage. gcc/ada/ * exp_attr.adb (Expand_N_Attribute_Reference): Remove useless skipping for attribute Input. --- gcc/ada/exp_attr.adb | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 1ef3065..25f1627 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -2002,8 +2002,8 @@ package body Exp_Attr is -- -- Skip check for output parameters of an Asm instruction (since their -- valuesare not set till after the attribute has been elaborated), - -- for the arguments of a 'Read or 'Input attribute reference (since - -- the scalar argument is an OUT scalar) and for the arguments of a + -- 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)). @@ -2011,7 +2011,6 @@ package body Exp_Attr is if Validity_Checks_On and then Validity_Check_Operands and then Id /= Attribute_Asm_Output and then Id /= Attribute_Read - and then Id /= Attribute_Input and then Id /= Attribute_Has_Same_Storage and then Id /= Attribute_Overlaps_Storage then -- cgit v1.1 From c7dc111e9d8e2eb83e45870a98c193f2fd681313 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Wed, 7 Sep 2022 15:01:16 +0200 Subject: ada: Fix missing tag for with of an obsolescent function Fix minor inconsistency in tags of warnings about obsolescent entities. Part of cleaning up the warnings machinery to better handle references to unset objects. gcc/ada/ * sem_warn.adb (Output_Obsolescent_Entity_Warnings): Tag warnings about obsolescent functions just like we tag similar warnings for packages and procedures. --- gcc/ada/sem_warn.adb | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 77d5821..83b9b20 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -3146,7 +3146,7 @@ package body Sem_Warn is ("?j?with of obsolescent procedure& declared#", N, E); else Error_Msg_NE - ("??with of obsolescent function& declared#", N, E); + ("?j?with of obsolescent function& declared#", N, E); end if; -- If we do not have a with clause, then ignore any reference to an -- cgit v1.1 From 74056e9411e0457c33ff5546a3563edb9ed09c99 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Wed, 7 Sep 2022 15:02:04 +0200 Subject: ada: Reject misplaced pragma Obsolescent Pragma Obsolescent appearing before declaration was putting the Obsolescent flag on the Standard package, which is certainly wrong. The problem was that we relied on the Find_Lib_Unit_Name routine without sanitizing the pragma placement with Check_Valid_Library_Unit_Pragma. Part of cleaning up the warnings machinery to better handle references to unset objects. gcc/ada/ * sem_prag.adb (Analyze_Pragma [Pragma_Obsolescent]): Reject misplaced pragma. --- gcc/ada/sem_prag.adb | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 60ea681..471ef87 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -20502,10 +20502,16 @@ package body Sem_Prag is if No (Decl) then - -- First case: library level compilation unit declaration with + -- Case 0: library level compilation unit declaration with + -- the pragma preceding the declaration. + + if Nkind (Parent (N)) = N_Compilation_Unit then + Pragma_Misplaced; + + -- Case 1: library level compilation unit declaration with -- the pragma immediately following the declaration. - if Nkind (Parent (N)) = N_Compilation_Unit_Aux then + elsif Nkind (Parent (N)) = N_Compilation_Unit_Aux then Set_Obsolescent (Defining_Entity (Unit (Parent (Parent (N))))); return; -- cgit v1.1 From ffe889d7ffcc7e8150413d4de38e066940fb7881 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Wed, 7 Sep 2022 16:02:42 +0200 Subject: ada: Simplify detection of pragmas in the context items Code cleanup; semantics is unaffected. gcc/ada/ * sem_prag.adb (Is_In_Context_Clause): Rewrite without negations and inequalities. --- gcc/ada/sem_prag.adb | 16 +++++----------- 1 file changed, 5 insertions(+), 11 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 471ef87..f33d858 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -7315,22 +7315,16 @@ package body Sem_Prag is Parent_Node : Node_Id; begin - if not Is_List_Member (N) then - return False; - - else + if Is_List_Member (N) then Plist := List_Containing (N); Parent_Node := Parent (Plist); - if Parent_Node = Empty - or else Nkind (Parent_Node) /= N_Compilation_Unit - or else Context_Items (Parent_Node) /= Plist - then - return False; - end if; + return Present (Parent_Node) + and then Nkind (Parent_Node) = N_Compilation_Unit + and then Context_Items (Parent_Node) = Plist; end if; - return True; + return False; end Is_In_Context_Clause; --------------------------------- -- cgit v1.1 From 03b4e4ae3b0d647a44c3dac09e27ab4151a84e85 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Fri, 2 Sep 2022 22:42:57 +0200 Subject: ada: Don't reuse operator nodes in expansion This patch removes handling of references to unset objects that relied on Original_Node. This handling was only needed because of rewriting that reused operator nodes, for example, when an array inequality like: A < B was rewritten into: System.Compare_Array_Unsigned_8.Compare_Array_U8 (A'Address, B'Address, A'Length, B'Length) < 0 by keeping the node for operator "<" and only substituting its operands. It seems safer to simply create an new operator node when rewriting and not rely on Original_Node afterwards. Cleanup related to improved detection uninitialized objects. gcc/ada/ * checks.adb (Apply_Arithmetic_Overflow_Strict): Rewrite using a newly created operator node. * exp_ch4.adb (Expand_Array_Comparison): Likewise. * exp_ch6.adb (Add_Call_By_Copy_Code): Rewriting actual parameter using its own location and not the location of the subprogram call. * sem_warn.adb (Check_References): Looping with Original_Node is no longer needed. --- gcc/ada/checks.adb | 27 +++++++++++++--------- gcc/ada/exp_ch4.adb | 63 ++++++++++++++++++++++++++++++++++------------------ gcc/ada/exp_ch6.adb | 2 +- gcc/ada/sem_warn.adb | 25 --------------------- 4 files changed, 58 insertions(+), 59 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 4741294..a91c1cd 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -999,21 +999,26 @@ package body Checks is Determine_Range (N, VOK, Vlo, Vhi, Assume_Valid => True); if VOK and then Tlo <= Vlo and then Vhi <= Thi then - Rewrite (Left_Opnd (N), - Make_Type_Conversion (Loc, - Subtype_Mark => New_Occurrence_Of (Target_Type, Loc), - Expression => Relocate_Node (Left_Opnd (N)))); - - Rewrite (Right_Opnd (N), - Make_Type_Conversion (Loc, - Subtype_Mark => New_Occurrence_Of (Target_Type, Loc), - Expression => Relocate_Node (Right_Opnd (N)))); - -- Rewrite the conversion operand so that the original -- node is retained, in order to avoid the warning for -- redundant conversions in Resolve_Type_Conversion. - Rewrite (N, Relocate_Node (N)); + declare + Op : constant Node_Id := New_Op_Node (Nkind (N), Loc); + begin + Set_Left_Opnd (Op, + Make_Type_Conversion (Loc, + Subtype_Mark => + New_Occurrence_Of (Target_Type, Loc), + Expression => Relocate_Node (Left_Opnd (N)))); + Set_Right_Opnd (Op, + Make_Type_Conversion (Loc, + Subtype_Mark => + New_Occurrence_Of (Target_Type, Loc), + Expression => Relocate_Node (Right_Opnd (N)))); + + Rewrite (N, Op); + end; Set_Etype (N, Target_Type); diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 7a3a414..bbbcf4f 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -1424,33 +1424,52 @@ package body Exp_Ch4 is Remove_Side_Effects (Op1, Name_Req => True); Remove_Side_Effects (Op2, Name_Req => True); - Rewrite (Op1, - Make_Function_Call (Sloc (Op1), - Name => New_Occurrence_Of (RTE (Comp), Loc), + declare + Comp_Call : constant Node_Id := + Make_Function_Call (Loc, + Name => New_Occurrence_Of (RTE (Comp), Loc), - Parameter_Associations => New_List ( - Make_Attribute_Reference (Loc, - Prefix => Relocate_Node (Op1), - Attribute_Name => Name_Address), + Parameter_Associations => New_List ( + Make_Attribute_Reference (Loc, + Prefix => Relocate_Node (Op1), + Attribute_Name => Name_Address), - Make_Attribute_Reference (Loc, - Prefix => Relocate_Node (Op2), - Attribute_Name => Name_Address), + Make_Attribute_Reference (Loc, + Prefix => Relocate_Node (Op2), + Attribute_Name => Name_Address), - Make_Attribute_Reference (Loc, - Prefix => Relocate_Node (Op1), - Attribute_Name => Name_Length), + Make_Attribute_Reference (Loc, + Prefix => Relocate_Node (Op1), + Attribute_Name => Name_Length), - Make_Attribute_Reference (Loc, - Prefix => Relocate_Node (Op2), - Attribute_Name => Name_Length)))); + Make_Attribute_Reference (Loc, + Prefix => Relocate_Node (Op2), + Attribute_Name => Name_Length))); + + Zero : constant Node_Id := + Make_Integer_Literal (Loc, + Intval => Uint_0); - Rewrite (Op2, - Make_Integer_Literal (Sloc (Op2), - Intval => Uint_0)); + Comp_Op : Node_Id; - Analyze_And_Resolve (Op1, Standard_Integer); - Analyze_And_Resolve (Op2, Standard_Integer); + begin + case Nkind (N) is + when N_Op_Lt => + Comp_Op := Make_Op_Lt (Loc, Comp_Call, Zero); + when N_Op_Le => + Comp_Op := Make_Op_Le (Loc, Comp_Call, Zero); + when N_Op_Gt => + Comp_Op := Make_Op_Gt (Loc, Comp_Call, Zero); + when N_Op_Ge => + Comp_Op := Make_Op_Ge (Loc, Comp_Call, Zero); + when others => + raise Program_Error; + end case; + + Rewrite (N, Comp_Op); + end; + + Analyze_And_Resolve (N, Standard_Boolean); return; end if; end if; @@ -9819,7 +9838,7 @@ package body Exp_Ch4 is -- avoids anomalies when the replacement is done in an instance and -- is epsilon more efficient. - Set_Entity (N, Standard_Entity (S_Op_Rem)); + pragma Assert (Entity (N) = Standard_Op_Rem); Set_Etype (N, Typ); Set_Do_Division_Check (N, DDC); Expand_N_Op_Rem (N); diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index cf64e82..9380f3d 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -1806,7 +1806,7 @@ package body Exp_Ch6 is Expr := New_Occurrence_Of (Temp, Loc); end if; - Rewrite (Actual, New_Occurrence_Of (Temp, Loc)); + Rewrite (Actual, New_Occurrence_Of (Temp, Sloc (Actual))); Analyze (Actual); -- If the actual is a conversion of a packed reference, it may diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 83b9b20..4552d90 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -1460,31 +1460,6 @@ package body Sem_Warn is and then not Known_To_Have_Preelab_Init (Etype (E1)) then - -- For other than access type, go back to original node to - -- deal with case where original unset reference has been - -- rewritten during expansion. - - -- In some cases, the original node may be a type - -- conversion, a qualification or an attribute reference and - -- in this case we want the object entity inside. Same for - -- an expression with actions. - - UR := Original_Node (UR); - loop - if Nkind (UR) in N_Expression_With_Actions - | N_Qualified_Expression - | N_Type_Conversion - then - UR := Expression (UR); - - elsif Nkind (UR) = N_Attribute_Reference then - UR := Prefix (UR); - - else - exit; - end if; - end loop; - -- Don't issue warning if appearing inside Initial_Condition -- pragma or aspect, since that expression is not evaluated -- at the point where it occurs in the source. -- cgit v1.1 From c7e9b5e2d5c7b0e57b127d5c6bb57d3b5bfb6ce1 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Fri, 2 Sep 2022 13:32:27 +0200 Subject: ada: Create operator nodes in functional style A recent patch removed two rewritings, where we kept the operator node but replaced its operands. This patch removes explicit setting of the operands; instead, the operator is already created together with its operands, which seems a bit safer and more consistent with how we typically create operator nodes. It is a cleanup only; semantics is unaffected. gcc/ada/ * exp_ch4.adb (Expand_Modular_Addition): Rewrite using Make_XXX calls. (Expand_Modular_Op): Likewise. (Expand_Modular_Subtraction): Likewise. * exp_imgv.adb (Expand_User_Defined_Enumeration_Image): Likewise. --- gcc/ada/exp_ch4.adb | 122 +++++++++++++++++++++++++++------------------------ gcc/ada/exp_imgv.adb | 24 +++++----- 2 files changed, 76 insertions(+), 70 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index bbbcf4f..b9433c3 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -4154,39 +4154,42 @@ package body Exp_Ch4 is Mod_Minus_Right : constant Uint := Modulus (Typ) - Intval (Right_Opnd (N)); - Exprs : constant List_Id := New_List; - Cond_Expr : constant Node_Id := New_Op_Node (N_Op_Lt, Loc); - Then_Expr : constant Node_Id := New_Op_Node (N_Op_Add, Loc); - Else_Expr : constant Node_Id := New_Op_Node (N_Op_Subtract, - Loc); + Cond_Expr : Node_Id; + Then_Expr : Node_Id; + Else_Expr : Node_Id; begin -- To prevent spurious visibility issues, convert all -- operands to Standard.Unsigned. - Set_Left_Opnd (Cond_Expr, - Unchecked_Convert_To (Standard_Unsigned, - New_Copy_Tree (Left_Opnd (N)))); - Set_Right_Opnd (Cond_Expr, - Make_Integer_Literal (Loc, Mod_Minus_Right)); - Append_To (Exprs, Cond_Expr); - - Set_Left_Opnd (Then_Expr, - Unchecked_Convert_To (Standard_Unsigned, - New_Copy_Tree (Left_Opnd (N)))); - Set_Right_Opnd (Then_Expr, - Make_Integer_Literal (Loc, Intval (Right_Opnd (N)))); - Append_To (Exprs, Then_Expr); - - Set_Left_Opnd (Else_Expr, - Unchecked_Convert_To (Standard_Unsigned, - New_Copy_Tree (Left_Opnd (N)))); - Set_Right_Opnd (Else_Expr, - Make_Integer_Literal (Loc, Mod_Minus_Right)); - Append_To (Exprs, Else_Expr); + Cond_Expr := + Make_Op_Lt (Loc, + Left_Opnd => + Unchecked_Convert_To (Standard_Unsigned, + New_Copy_Tree (Left_Opnd (N))), + Right_Opnd => + Make_Integer_Literal (Loc, Mod_Minus_Right)); + + Then_Expr := + Make_Op_Add (Loc, + Left_Opnd => + Unchecked_Convert_To (Standard_Unsigned, + New_Copy_Tree (Left_Opnd (N))), + Right_Opnd => + Make_Integer_Literal (Loc, Intval (Right_Opnd (N)))); + + Else_Expr := + Make_Op_Subtract (Loc, + Left_Opnd => + Unchecked_Convert_To (Standard_Unsigned, + New_Copy_Tree (Left_Opnd (N))), + Right_Opnd => + Make_Integer_Literal (Loc, Mod_Minus_Right)); Rewrite (N, Unchecked_Convert_To (Typ, - Make_If_Expression (Loc, Expressions => Exprs))); + Make_If_Expression (Loc, + Expressions => + New_List (Cond_Expr, Then_Expr, Else_Expr)))); end; end if; end Expand_Modular_Addition; @@ -4202,7 +4205,7 @@ package body Exp_Ch4 is -- backend does not have to deal with nonbinary-modulus ops. Op_Expr : constant Node_Id := New_Op_Node (Nkind (N), Loc); - Mod_Expr : constant Node_Id := New_Op_Node (N_Op_Mod, Loc); + Mod_Expr : Node_Id; Target_Type : Entity_Id; begin @@ -4297,10 +4300,10 @@ package body Exp_Ch4 is Force_Evaluation (Op_Expr, Mode => Strict); end if; - Set_Left_Opnd (Mod_Expr, Op_Expr); - - Set_Right_Opnd (Mod_Expr, - Make_Integer_Literal (Loc, Modulus (Typ))); + 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)); @@ -4331,37 +4334,40 @@ package body Exp_Ch4 is Mod_Minus_Right : constant Uint := Modulus (Typ) - Intval (Right_Opnd (N)); - Exprs : constant List_Id := New_List; - Cond_Expr : constant Node_Id := New_Op_Node (N_Op_Lt, Loc); - Then_Expr : constant Node_Id := New_Op_Node (N_Op_Add, Loc); - Else_Expr : constant Node_Id := New_Op_Node (N_Op_Subtract, - Loc); + Cond_Expr : Node_Id; + Then_Expr : Node_Id; + Else_Expr : Node_Id; begin - Set_Left_Opnd (Cond_Expr, - Unchecked_Convert_To (Standard_Unsigned, - New_Copy_Tree (Left_Opnd (N)))); - Set_Right_Opnd (Cond_Expr, - Make_Integer_Literal (Loc, Intval (Right_Opnd (N)))); - Append_To (Exprs, Cond_Expr); - - Set_Left_Opnd (Then_Expr, - Unchecked_Convert_To (Standard_Unsigned, - New_Copy_Tree (Left_Opnd (N)))); - Set_Right_Opnd (Then_Expr, - Make_Integer_Literal (Loc, Mod_Minus_Right)); - Append_To (Exprs, Then_Expr); - - Set_Left_Opnd (Else_Expr, - Unchecked_Convert_To (Standard_Unsigned, - New_Copy_Tree (Left_Opnd (N)))); - Set_Right_Opnd (Else_Expr, - Unchecked_Convert_To (Standard_Unsigned, - New_Copy_Tree (Right_Opnd (N)))); - Append_To (Exprs, Else_Expr); + Cond_Expr := + Make_Op_Lt (Loc, + Left_Opnd => + Unchecked_Convert_To (Standard_Unsigned, + New_Copy_Tree (Left_Opnd (N))), + Right_Opnd => + Make_Integer_Literal (Loc, Intval (Right_Opnd (N)))); + + Then_Expr := + Make_Op_Add (Loc, + Left_Opnd => + Unchecked_Convert_To (Standard_Unsigned, + New_Copy_Tree (Left_Opnd (N))), + Right_Opnd => + Make_Integer_Literal (Loc, Mod_Minus_Right)); + + Else_Expr := + Make_Op_Subtract (Loc, + Left_Opnd => + Unchecked_Convert_To (Standard_Unsigned, + New_Copy_Tree (Left_Opnd (N))), + Right_Opnd => + Unchecked_Convert_To (Standard_Unsigned, + New_Copy_Tree (Right_Opnd (N)))); Rewrite (N, Unchecked_Convert_To (Typ, - Make_If_Expression (Loc, Expressions => Exprs))); + Make_If_Expression (Loc, + Expressions => + New_List (Cond_Expr, Then_Expr, Else_Expr)))); end; end if; end Expand_Modular_Subtraction; diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb index 51f1195..f2043f5 100644 --- a/gcc/ada/exp_imgv.adb +++ b/gcc/ada/exp_imgv.adb @@ -938,12 +938,12 @@ package body Exp_Imgv is -- P3 : constant Natural := call_put_enumN (P1 + 1); declare - Add_Node : constant Node_Id := New_Op_Node (N_Op_Add, Loc); + Add_Node : constant Node_Id := + Make_Op_Add (Loc, + Left_Opnd => New_Occurrence_Of (P1_Id, Loc), + Right_Opnd => Make_Integer_Literal (Loc, Uint_1)); begin - Set_Left_Opnd (Add_Node, New_Occurrence_Of (P1_Id, Loc)); - Set_Right_Opnd (Add_Node, Make_Integer_Literal (Loc, 1)); - Append_To (Ins_List, Make_Object_Declaration (Loc, Defining_Identifier => P3_Id, @@ -963,12 +963,12 @@ package body Exp_Imgv is -- P4 : String renames call_put_enumS (P2 .. P3 - 1); declare - Sub_Node : constant Node_Id := New_Op_Node (N_Op_Subtract, Loc); + Sub_Node : constant Node_Id := + Make_Op_Subtract (Loc, + Left_Opnd => New_Occurrence_Of (P3_Id, Loc), + Right_Opnd => Make_Integer_Literal (Loc, Uint_1)); begin - Set_Left_Opnd (Sub_Node, New_Occurrence_Of (P3_Id, Loc)); - Set_Right_Opnd (Sub_Node, Make_Integer_Literal (Loc, 1)); - Append_To (Ins_List, Make_Object_Renaming_Declaration (Loc, Defining_Identifier => P4_Id, @@ -988,12 +988,12 @@ package body Exp_Imgv is -- subtype S1 is String (1 .. P3 - P2); declare - HB : constant Node_Id := New_Op_Node (N_Op_Subtract, Loc); + HB : constant Node_Id := + Make_Op_Subtract (Loc, + Left_Opnd => New_Occurrence_Of (P3_Id, Loc), + Right_Opnd => New_Occurrence_Of (P2_Id, Loc)); begin - Set_Left_Opnd (HB, New_Occurrence_Of (P3_Id, Loc)); - Set_Right_Opnd (HB, New_Occurrence_Of (P2_Id, Loc)); - Append_To (Ins_List, Make_Subtype_Declaration (Loc, Defining_Identifier => S1_Id, -- cgit v1.1 From f8b69d43875557a42feef5f595ec9f3a31e09317 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Fri, 9 Sep 2022 17:46:22 +0200 Subject: ada: Cleanup WITH clauses after switching from obsolescent Ada 83 unit Cleanup after replacing Unchecked_Conversion with Ada.Unchecked_Conversion. gcc/ada/ * libgnarl/s-interr.adb: Reorder context items and pragmas. --- gcc/ada/libgnarl/s-interr.adb | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/libgnarl/s-interr.adb b/gcc/ada/libgnarl/s-interr.adb index a3d28d6..94e572d 100644 --- a/gcc/ada/libgnarl/s-interr.adb +++ b/gcc/ada/libgnarl/s-interr.adb @@ -54,27 +54,22 @@ with Ada.Exceptions; with Ada.Task_Identification; +with Ada.Unchecked_Conversion; -with System.Task_Primitives; with System.Interrupt_Management; - with System.Interrupt_Management.Operations; -pragma Elaborate_All (System.Interrupt_Management.Operations); - with System.IO; - +with System.Parameters; +with System.Task_Primitives; with System.Task_Primitives.Operations; with System.Task_Primitives.Interrupt_Operations; with System.Storage_Elements; +with System.Tasking.Initialization; with System.Tasking.Utilities; - with System.Tasking.Rendezvous; -pragma Elaborate_All (System.Tasking.Rendezvous); - -with System.Tasking.Initialization; -with System.Parameters; -with Ada.Unchecked_Conversion; +pragma Elaborate_All (System.Interrupt_Management.Operations); +pragma Elaborate_All (System.Tasking.Rendezvous); package body System.Interrupts is -- cgit v1.1 From ae3952715ce92cb6baac6d2b883c9a29a70cb1d9 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Fri, 9 Sep 2022 17:48:45 +0200 Subject: ada: Tune layout after switching to Ada 2022 aggregate syntax Whitespace cleanup only. gcc/ada/ * libgnarl/s-interr.adb: Tune whitespace. --- gcc/ada/libgnarl/s-interr.adb | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/libgnarl/s-interr.adb b/gcc/ada/libgnarl/s-interr.adb index 94e572d..2fbb140 100644 --- a/gcc/ada/libgnarl/s-interr.adb +++ b/gcc/ada/libgnarl/s-interr.adb @@ -109,8 +109,8 @@ package body System.Interrupts is Static : Boolean); entry Detach_Handler - (Interrupt : Interrupt_ID; - Static : Boolean); + (Interrupt : Interrupt_ID; + Static : Boolean); entry Bind_Interrupt_To_Entry (T : Task_Id; @@ -174,15 +174,14 @@ package body System.Interrupts is pragma Atomic_Components (Ignored); -- True iff the corresponding interrupt is blocked in the process level - Last_Unblocker : - array (Interrupt_ID'Range) of Task_Id := [others => Null_Task]; + Last_Unblocker : array (Interrupt_ID'Range) of Task_Id := + [others => Null_Task]; pragma Atomic_Components (Last_Unblocker); -- Holds the ID of the last Task which Unblocked this Interrupt. It -- contains Null_Task if no tasks have ever requested the Unblocking -- operation or the Interrupt is currently Blocked. - Server_ID : array (Interrupt_ID'Range) of Task_Id := - [others => Null_Task]; + Server_ID : array (Interrupt_ID'Range) of Task_Id := [others => Null_Task]; pragma Atomic_Components (Server_ID); -- Holds the Task_Id of the Server_Task for each interrupt. Task_Id is -- needed to accomplish locking per Interrupt base. Also is needed to -- cgit v1.1 From 748976cfc867cb387f0f8180c48233e883223f93 Mon Sep 17 00:00:00 2001 From: Steve Baird Date: Tue, 11 Oct 2022 15:21:39 -0700 Subject: ada: Put_Image aspect spec incorrectly not inherited In some cases, a Put_Image aspect specification for a scalar type was not correctly inherited by a descendant of that type. gcc/ada/ * exp_put_image.adb (Image_Should_Call_Put_Image): Correctly handle the case of an inherited Put_Image aspect specification for a scalar type. --- gcc/ada/exp_put_image.adb | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb index 50e0569..c489ad4 100644 --- a/gcc/ada/exp_put_image.adb +++ b/gcc/ada/exp_put_image.adb @@ -1039,13 +1039,13 @@ package body Exp_Put_Image is end if; -- In Ada 2022, T'Image calls T'Put_Image if there is an explicit - -- aspect_specification for Put_Image, or if U_Type'Image is illegal - -- in pre-2022 versions of Ada. + -- (or inherited) aspect_specification for Put_Image, or if + -- U_Type'Image is illegal in pre-2022 versions of Ada. declare U_Type : constant Entity_Id := Underlying_Type (Entity (Prefix (N))); begin - if Present (TSS (U_Type, TSS_Put_Image)) then + if Present (Find_Aspect (U_Type, Aspect_Put_Image)) then return True; end if; -- cgit v1.1 From 76b35e7227f34e2ce18e50ca637c86d7a1c3ef49 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Fri, 12 Aug 2022 11:51:30 +0200 Subject: ada: Cleanup comment about mapping parameters when inlining Improve location of the comment about a special case for GNATprove mode. gcc/ada/ * inline.adb (Establish_Actual_Mapping_For_Inlined_Call): Move comment next to a condition that it describes. --- gcc/ada/inline.adb | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index e3f35da..a1ead98 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -3013,14 +3013,10 @@ package body Inline is Temp_Typ := Etype (A); end if; - -- If the actual is a simple name or a literal, no need to - -- create a temporary, object can be used directly. - - -- If the actual is a literal and the formal has its address taken, - -- we cannot pass the literal itself as an argument, so its value - -- must be captured in a temporary. Skip this optimization in - -- GNATprove mode, to make sure any check on a type conversion - -- will be issued. + -- If the actual is a simple name or a literal, no need to create a + -- temporary, object can be used directly. Skip this optimization in + -- GNATprove mode, to make sure any check on a type conversion will + -- be issued. if (Is_Entity_Name (A) and then @@ -3039,6 +3035,10 @@ package body Inline is and then Formal_Is_Used_Once (F) and then not GNATprove_Mode) + -- If the actual is a literal and the formal has its address taken, + -- we cannot pass the literal itself as an argument, so its value + -- must be captured in a temporary. + or else (Nkind (A) in N_Real_Literal | N_Integer_Literal | N_Character_Literal -- cgit v1.1 From 4e92ad48dcfdb726f72f35039c5c102a99bf7759 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Fri, 12 Aug 2022 11:55:35 +0200 Subject: ada: Clean up code for visibility of generic actuals Code cleanup related to fixing visibility of actual parameters in inlining-for-proof in GNATprove mode; semantics is unaffected. gcc/ada/ * sem_ch12.adb (Check_Generic_Actuals): Remove redundant parens; refactor an excessive if-statement; remove repeated call to Node. --- gcc/ada/sem_ch12.adb | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 0b7b7c9..2b7833d 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -7023,7 +7023,7 @@ package body Sem_Ch12 is Astype := First_Subtype (E); end if; - Set_Size_Info (E, (Astype)); + Set_Size_Info (E, Astype); Copy_RM_Size (To => E, From => Astype); Set_First_Rep_Item (E, First_Rep_Item (Astype)); @@ -7054,12 +7054,10 @@ package body Sem_Ch12 is elsif Present (Associated_Formal_Package (E)) and then not Is_Generic_Formal (E) then - if Box_Present (Parent (Associated_Formal_Package (E))) then - Check_Generic_Actuals (Renamed_Entity (E), True); - - else - Check_Generic_Actuals (Renamed_Entity (E), False); - end if; + Check_Generic_Actuals + (Renamed_Entity (E), + Is_Formal_Box => + Box_Present (Parent (Associated_Formal_Package (E)))); Set_Is_Hidden (E, False); end if; @@ -15457,7 +15455,7 @@ package body Sem_Ch12 is end loop; end if; - Exchange_Declarations (Node (M)); + Exchange_Declarations (Typ); Next_Elmt (M); end loop; -- cgit v1.1 From f073f3355643587073ce224563f509332043c381 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Fri, 12 Aug 2022 12:04:35 +0200 Subject: ada: Clean up unnecesary call in resolution of overloaded expressions When experimentally enabling frontend inlining by default, the unnecessary call to Comes_From_Predefined_Lib_Unit in Resolve appears to be a performance bottleneck (most likely this call is expensive because it involves a loop over the currently inlined subprograms). Code cleanup; semantics is unaffected. gcc/ada/ * sem_res.adb (Resolve): Only call Comes_From_Predefined_Lib_Unit when its result might be needed. --- gcc/ada/sem_res.adb | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 7675070..ea9a03b 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -2370,8 +2370,6 @@ package body Sem_Res is ("prefix must statically denote a non-remote subprogram", N); end if; - From_Lib := Comes_From_Predefined_Lib_Unit (N); - -- If the context is a Remote_Access_To_Subprogram, access attributes -- must be resolved with the corresponding fat pointer. There is no need -- to check for the attribute name since the return type of an @@ -2505,6 +2503,8 @@ package body Sem_Res is -- is compatible with the context (i.e. the type passed to Resolve) else + From_Lib := Comes_From_Predefined_Lib_Unit (N); + -- Loop through possible interpretations Get_First_Interp (N, I, It); -- cgit v1.1 From 8f077c4d05876bf952c86131e477d21dc5d4492b Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Fri, 25 Sep 2020 10:43:27 +0200 Subject: ada: Allow reuse of Enclosing_Declaration_Or_Statement by GNATprove Move routine Enclosing_Declaration_Or_Statement from body of Sem_Res to spec of Sem_Util, so it can be reused. In particular, GNATprove needs this functionality to climb from an arbitrary subexpression with target_name (@) to the enclosing assignment statement. Behaviour of the compiler is unaffected. gcc/ada/ * sem_res.adb (Enclosing_Declaration_Or_Statement): Moved to Sem_Util. * sem_util.ads (Enclosing_Declaration_Or_Statement): Moved from Sem_Res. * sem_util.adb (Enclosing_Declaration_Or_Statement): Likewise. --- gcc/ada/sem_res.adb | 31 ------------------------------- gcc/ada/sem_util.adb | 27 +++++++++++++++++++++++++++ gcc/ada/sem_util.ads | 4 ++++ 3 files changed, 31 insertions(+), 31 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index ea9a03b..402da43 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -895,10 +895,6 @@ package body Sem_Res is ------------------------------ function Check_Infinite_Recursion (Call : Node_Id) return Boolean is - function Enclosing_Declaration_Or_Statement (N : Node_Id) return Node_Id; - -- Return the nearest enclosing declaration or statement that houses - -- arbitrary node N. - function Invoked_With_Different_Arguments (N : Node_Id) return Boolean; -- Determine whether call N invokes the related enclosing subprogram -- with actuals that differ from the subprogram's formals. @@ -934,33 +930,6 @@ package body Sem_Res is -- Determine whether arbitrary node N appears within a conditional -- construct. - ---------------------------------------- - -- Enclosing_Declaration_Or_Statement -- - ---------------------------------------- - - function Enclosing_Declaration_Or_Statement - (N : Node_Id) return Node_Id - is - Par : Node_Id; - - begin - Par := N; - while Present (Par) loop - if Is_Declaration (Par) or else Is_Statement (Par) then - return Par; - - -- Prevent the search from going too far - - elsif Is_Body_Or_Package_Declaration (Par) then - exit; - end if; - - Par := Parent (Par); - end loop; - - return N; - end Enclosing_Declaration_Or_Statement; - -------------------------------------- -- Invoked_With_Different_Arguments -- -------------------------------------- diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 5c49576..5965fa1 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -8271,6 +8271,33 @@ package body Sem_Util is return Decl; end Enclosing_Declaration; + ---------------------------------------- + -- Enclosing_Declaration_Or_Statement -- + ---------------------------------------- + + function Enclosing_Declaration_Or_Statement + (N : Node_Id) return Node_Id + is + Par : Node_Id; + + begin + Par := N; + while Present (Par) loop + if Is_Declaration (Par) or else Is_Statement (Par) then + return Par; + + -- Prevent the search from going too far + + elsif Is_Body_Or_Package_Declaration (Par) then + exit; + end if; + + Par := Parent (Par); + end loop; + + return N; + end Enclosing_Declaration_Or_Statement; + ---------------------------- -- Enclosing_Generic_Body -- ---------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 88bfbfc..5c08cb8 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -809,6 +809,10 @@ package Sem_Util is -- Returns the declaration node enclosing N (including possibly N itself), -- if any, or Empty otherwise. + function Enclosing_Declaration_Or_Statement (N : Node_Id) return Node_Id; + -- Return the nearest enclosing declaration or statement that houses + -- arbitrary node N. + function Enclosing_Generic_Body (N : Node_Id) return Node_Id; -- Returns the Node_Id associated with the innermost enclosing generic -- body, if any. If none, then returns Empty. -- cgit v1.1 From 2caaa4bf336bce2a7d649aa05f2851d576a26e5e Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Thu, 14 Oct 2021 17:50:43 +0200 Subject: ada: Reject boxes in delta array aggregates Implement Ada 2022 4.3.4(11/5), which rejects box compound delimiter <> in delta record aggregates, just like another rule rejects it in delta array aggregates. gcc/ada/ * sem_aggr.adb (Resolve_Delta_Array_Aggregate): Reject boxes in delta array aggregates. --- gcc/ada/sem_aggr.adb | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 87a8c1a..31ce9ca 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -3531,7 +3531,18 @@ package body Sem_Aggr is Next (Choice); end loop; - Analyze_And_Resolve (Expression (Assoc), Component_Type (Typ)); + -- For an array_delta_aggregate, the array_component_association + -- shall not use the box symbol <>; RM 4.3.4(11/5). + + pragma Assert + (Box_Present (Assoc) xor Present (Expression (Assoc))); + + if Box_Present (Assoc) then + Error_Msg_N + ("'<'> in array delta aggregate is not allowed", Assoc); + else + Analyze_And_Resolve (Expression (Assoc), Component_Type (Typ)); + end if; end if; Next (Assoc); -- cgit v1.1 From dcc02d3168b4457746f6ab1d8e73cf9d15c6d4e8 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Tue, 6 Sep 2022 00:24:17 +0200 Subject: ada: Remove redundant suppression for non-modified IN OUT parameters Non-modified IN OUT parameters are first collected and then filtered by examining uses of their enclosing subprograms. In this filtering we don't need to look again at properties of the formal parameters themselves. Cleanup related to improved detection of references to uninitialized objects; semantics is unaffected. gcc/ada/ * sem_warn.adb (No_Warn_On_In_Out): For subprograms we can simply call Warnings_Off. (Output_Non_Modified_In_Out_Warnings): Remove repeated suppression. --- gcc/ada/sem_warn.adb | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 4552d90..1bfa844 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -3006,9 +3006,9 @@ package body Sem_Warn is then return True; - -- Else test warnings off + -- Else test warnings off on the subprogram - elsif Warnings_Off_Check_Spec (S) then + elsif Warnings_Off (S) then return True; -- All tests for suppressing warning failed @@ -3029,11 +3029,9 @@ package body Sem_Warn is begin -- Suppress warning in specific cases (see details in comments for - -- No_Warn_On_In_Out), or if there is a pragma Unmodified. + -- No_Warn_On_In_Out). - if Has_Pragma_Unmodified_Check_Spec (E1) - or else No_Warn_On_In_Out (E1) - then + if No_Warn_On_In_Out (E1) then null; -- Here we generate the warning -- cgit v1.1 From 72ae51d581dc8bcf8dcec9b5e0e1560d9e4099d1 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Wed, 7 Sep 2022 17:24:40 +0200 Subject: ada: Cleanup detection of code within generic instances To check if a node is located in a generic instance we can either look at Instantiation_Location or at the Instantiation_Depth, but just looking at the location is simpler and more efficient. Cleanup related to improved detection of references to uninitialized objects; semantics is unaffected. gcc/ada/ * sem_ch13.adb (Add_Call): Just look at Instantiation_Depth. * sem_ch3.adb (Derive_Subprograms): Likewise. * sem_warn.adb (Check_References): Remove redundant filtering with Instantiation_Depth that follows filtering with Instantiation_Location. * sinput.adb (Instantiation_Depth): Reuse Instantiation_Location. --- gcc/ada/sem_ch13.adb | 2 +- gcc/ada/sem_ch3.adb | 6 +++--- gcc/ada/sem_warn.adb | 1 - gcc/ada/sinput.adb | 4 +--- 4 files changed, 5 insertions(+), 8 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 2eb1a69..5507353 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -9930,7 +9930,7 @@ package body Sem_Ch13 is if Opt.List_Inherited_Aspects and then not Is_Generic_Actual_Type (Typ) - and then Instantiation_Depth (Sloc (Typ)) = 0 + and then Instantiation_Location (Sloc (Typ)) = No_Location and then not Is_Internal_Name (Chars (T)) and then not Is_Internal_Name (Chars (Typ)) then diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 90af320..76dc632 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -16720,9 +16720,9 @@ package body Sem_Ch3 is (Is_Generic_Unit (Scope (Find_Dispatching_Type (Alias_Subp))) or else - Instantiation_Depth - (Sloc (Find_Dispatching_Type (Alias_Subp))) > 0); - + Instantiation_Location + (Sloc (Find_Dispatching_Type (Alias_Subp))) + /= No_Location); declare Iface_Prim_Loc : constant Source_Ptr := Original_Location (Sloc (Alias_Subp)); diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 1bfa844..a1a59a8 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -1720,7 +1720,6 @@ package body Sem_Warn is elsif Is_Generic_Subprogram (E1) and then not Is_Instantiated (E1) and then not Publicly_Referenceable (E1) - and then Instantiation_Depth (Sloc (E1)) = 0 and then Warn_On_Redundant_Constructs then if not Warnings_Off_E1 and then not Has_Junk_Name (E1) then diff --git a/gcc/ada/sinput.adb b/gcc/ada/sinput.adb index 8e80213..c96049b 100644 --- a/gcc/ada/sinput.adb +++ b/gcc/ada/sinput.adb @@ -620,7 +620,6 @@ package body Sinput is ------------------------- function Instantiation_Depth (S : Source_Ptr) return Nat is - Sind : Source_File_Index; Sval : Source_Ptr; Depth : Nat; @@ -629,8 +628,7 @@ package body Sinput is Depth := 0; loop - Sind := Get_Source_File_Index (Sval); - Sval := Instantiation (Sind); + Sval := Instantiation_Location (Sval); exit when Sval = No_Location; Depth := Depth + 1; end loop; -- cgit v1.1 From bb513a0d0f5e88b65abbab304692622f40641694 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Wed, 7 Sep 2022 17:22:47 +0200 Subject: ada: Flip warning suppression routine to positive meaning Subprogram names starting with No_ seem unnecessarily confusing. Cleanup related to improved detection of references to uninitialized objects; semantics is unaffected. gcc/ada/ * sem_warn.adb (Warn_On_In_Out): Remove No_ prefix; flip return values between True and False; adapt caller. --- gcc/ada/sem_warn.adb | 27 +++++++++++---------------- 1 file changed, 11 insertions(+), 16 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index a1a59a8..9dccf0d 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -2971,7 +2971,7 @@ package body Sem_Warn is procedure Output_Non_Modified_In_Out_Warnings is - function No_Warn_On_In_Out (E : Entity_Id) return Boolean; + function Warn_On_In_Out (E : Entity_Id) return Boolean; -- Given a formal parameter entity E, determines if there is a reason to -- suppress IN OUT warnings (not modified, could be IN) for formals of -- the subprogram. We suppress these warnings if Warnings Off is set, or @@ -2980,11 +2980,11 @@ package body Sem_Warn is -- context may force use of IN OUT, even if the parameter is not -- modified for this particular case). - ----------------------- - -- No_Warn_On_In_Out -- - ----------------------- + -------------------- + -- Warn_On_In_Out -- + -------------------- - function No_Warn_On_In_Out (E : Entity_Id) return Boolean is + function Warn_On_In_Out (E : Entity_Id) return Boolean is S : constant Entity_Id := Scope (E); SE : constant Entity_Id := Spec_Entity (E); @@ -2995,7 +2995,7 @@ package body Sem_Warn is if Address_Taken (S) or else (Present (SE) and then Address_Taken (Scope (SE))) then - return True; + return False; -- Do not warn if used as a generic actual, since the generic may be -- what is forcing the use of an "unnecessary" IN OUT. @@ -3003,19 +3003,19 @@ package body Sem_Warn is elsif Used_As_Generic_Actual (S) or else (Present (SE) and then Used_As_Generic_Actual (Scope (SE))) then - return True; + return False; -- Else test warnings off on the subprogram elsif Warnings_Off (S) then - return True; + return False; -- All tests for suppressing warning failed else - return False; + return True; end if; - end No_Warn_On_In_Out; + end Warn_On_In_Out; -- Start of processing for Output_Non_Modified_In_Out_Warnings @@ -3030,12 +3030,7 @@ package body Sem_Warn is -- Suppress warning in specific cases (see details in comments for -- No_Warn_On_In_Out). - if No_Warn_On_In_Out (E1) then - null; - - -- Here we generate the warning - - else + if Warn_On_In_Out (E1) then -- If -gnatwk is set then output message that it could be IN if not Is_Trivial_Subprogram (Scope (E1)) then -- cgit v1.1 From 214b1cb8a829568c7ef675b7c3e6a2d8b9a96875 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Tue, 19 May 2020 21:07:07 +0200 Subject: ada: Deconstruct Safe_To_Capture_In_Parameter_Value Recently routine Safe_To_Capture_Value was adapted, so that various data properties like validity/nullness/values are tracked also for in-parameters. Now a similar routine Safe_To_Capture_In_Parameter_Value, which was only used to track data nullness, is redundant, so this patch deconstructs it. Also the removed routine had at least few problems and limitations, for example: 1) it only worked for functions and procedures, but not for protected entries and task types (whose discriminants work very much like in-parameters) 2) it only worked for subprogram bodies with no spec, because of this dubious check (here simplified): if Nkind (Parent (Parent (Current_Scope))) /= N_Subprogram_Body then return False; 3) it only recognized references within short-circuit operators as certainly evaluated if they were directly their left hand expression, e.g.: X.all and then ... but not when they were certainly evaluated as part of a bigger expression on the left hand side, e.g.: (X.all > 0) and then ... 4) it categorizes parameters with 'Unrestricted_Access attribute as safe to capture, which is not necessarily wrong, but risky (because the object becomes aliased). Routine Safe_To_Capture_Value, which is kept by this patch, seems to behave better in all those situations, though it has its own problems as well and ideally should be further scrutinized. gcc/ada/ * checks.adb (Safe_To_Capture_In_Parameter_Value): Remove. * sem_util.adb (Safe_To_Capture_Value): Stop search at the current body. --- gcc/ada/checks.adb | 120 ++------------------------------------------------- gcc/ada/sem_util.adb | 5 ++- 2 files changed, 7 insertions(+), 118 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index a91c1cd..9687667 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -8408,115 +8408,10 @@ package body Checks is Loc : constant Source_Ptr := Sloc (Parent (N)); Typ : constant Entity_Id := Etype (N); - function Safe_To_Capture_In_Parameter_Value return Boolean; - -- Determines if it is safe to capture Known_Non_Null status for an - -- the entity referenced by node N. The caller ensures that N is indeed - -- an entity name. It is safe to capture the non-null status for an IN - -- parameter when the reference occurs within a declaration that is sure - -- to be executed as part of the declarative region. - procedure Mark_Non_Null; -- After installation of check, if the node in question is an entity -- name, then mark this entity as non-null if possible. - function Safe_To_Capture_In_Parameter_Value return Boolean is - E : constant Entity_Id := Entity (N); - S : constant Entity_Id := Current_Scope; - S_Par : Node_Id; - - begin - if Ekind (E) /= E_In_Parameter then - return False; - end if; - - -- Two initial context checks. We must be inside a subprogram body - -- with declarations and reference must not appear in nested scopes. - - if (Ekind (S) /= E_Function and then Ekind (S) /= E_Procedure) - or else Scope (E) /= S - then - return False; - end if; - - S_Par := Parent (Parent (S)); - - if Nkind (S_Par) /= N_Subprogram_Body - or else No (Declarations (S_Par)) - then - return False; - end if; - - declare - N_Decl : Node_Id; - P : Node_Id; - - begin - -- Retrieve the declaration node of N (if any). Note that N - -- may be a part of a complex initialization expression. - - P := Parent (N); - N_Decl := Empty; - while Present (P) loop - - -- If we have a short circuit form, and we are within the right - -- hand expression, we return false, since the right hand side - -- is not guaranteed to be elaborated. - - if Nkind (P) in N_Short_Circuit - and then N = Right_Opnd (P) - then - return False; - end if; - - -- Similarly, if we are in an if expression and not part of the - -- condition, then we return False, since neither the THEN or - -- ELSE dependent expressions will always be elaborated. - - if Nkind (P) = N_If_Expression - and then N /= First (Expressions (P)) - then - return False; - end if; - - -- If within a case expression, and not part of the expression, - -- then return False, since a particular dependent expression - -- may not always be elaborated - - if Nkind (P) = N_Case_Expression - and then N /= Expression (P) - then - return False; - end if; - - -- While traversing the parent chain, if node N belongs to a - -- statement, then it may never appear in a declarative region. - - if Nkind (P) in N_Statement_Other_Than_Procedure_Call - or else Nkind (P) = N_Procedure_Call_Statement - then - return False; - end if; - - -- If we are at a declaration, record it and exit - - if Nkind (P) in N_Declaration - and then Nkind (P) not in N_Subprogram_Specification - then - N_Decl := P; - exit; - end if; - - P := Parent (P); - end loop; - - if No (N_Decl) then - return False; - end if; - - return List_Containing (N_Decl) = Declarations (S_Par); - end; - end Safe_To_Capture_In_Parameter_Value; - ------------------- -- Mark_Non_Null -- ------------------- @@ -8532,19 +8427,10 @@ package body Checks is Set_Is_Known_Null (Entity (N), False); - -- We can mark the entity as known to be non-null if either it is - -- safe to capture the value, or in the case of an IN parameter, - -- which is a constant, if the check we just installed is in the - -- declarative region of the subprogram body. In this latter case, - -- a check is decisive for the rest of the body if the expression - -- is sure to be elaborated, since we know we have to elaborate - -- all declarations before executing the body. - - -- Couldn't this always be part of Safe_To_Capture_Value ??? + -- We can mark the entity as known to be non-null if it is safe to + -- capture the value. - if Safe_To_Capture_Value (N, Entity (N)) - or else Safe_To_Capture_In_Parameter_Value - then + if Safe_To_Capture_Value (N, Entity (N)) then Set_Is_Known_Non_Null (Entity (N)); end if; end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 5965fa1..c00490c 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -27912,7 +27912,10 @@ package body Sem_Util is P := Parent (N); while Present (P) loop - if Nkind (P) = N_If_Statement + if Is_Body (P) then + return True; + + elsif Nkind (P) = N_If_Statement or else Nkind (P) = N_Case_Statement or else (Nkind (P) in N_Short_Circuit and then Desc = Right_Opnd (P)) -- cgit v1.1 From 981848b598c8a35a76c7fc226ac07852d9061f43 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Thu, 13 Oct 2022 16:51:08 -0400 Subject: ada: Suppress warnings on derived True/False GNAT normally warns on "return ...;" if the "..." is known to be True or False, but not when it is a Boolean literal True or False. This patch also suppresses the warning when the type is derived from Boolean, and has convention C or Fortran (and therefore True is represented as "nonzero"). Without this fix, GNAT would give warnings like "False is always False". gcc/ada/ * sem_warn.adb (Check_For_Warnings): Remove unnecessary exception handler. (Warn_On_Known_Condition): Suppress warning when we detect a True or False that has been turned into a more complex expression because True is represented as "nonzero". (Note that the complex expression will subsequently be constant-folded to a Boolean True or False). Also simplify to always print "condition is always ..." instead of special-casing object names. The special case was unhelpful, and indeed wrong when the expression is a literal. --- gcc/ada/sem_warn.adb | 119 +++++++++++++++++++++------------------------------ 1 file changed, 49 insertions(+), 70 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 9dccf0d..0a46c66 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -2948,21 +2948,6 @@ package body Sem_Warn is begin return Traverse (N) = Abandon; - - -- If any exception occurs, then something has gone wrong, and this is - -- only a minor aesthetic issue anyway, so just say we did not find what - -- we are looking for, rather than blow up. - - exception - when others => - -- With debug flag K we will get an exception unless an error has - -- already occurred (useful for debugging). - - if Debug_Flag_K then - Check_Error_Detected; - end if; - - return False; end Operand_Has_Warnings_Suppressed; ----------------------------------------- @@ -3379,11 +3364,10 @@ package body Sem_Warn is -- determined, and Test_Result is set True/False accordingly. Otherwise -- False is returned, and Test_Result is unchanged. - procedure Track (N : Node_Id; Loc : Node_Id); + procedure Track (N : Node_Id); -- Adds continuation warning(s) pointing to reason (assignment or test) -- for the operand of the conditional having a known value (or at least - -- enough is known about the value to issue the warning). N is the node - -- which is judged to have a known value. Loc is the warning location. + -- enough is known about the value to issue the warning). --------------------- -- Is_Known_Branch -- @@ -3417,36 +3401,45 @@ package body Sem_Warn is -- Track -- ----------- - procedure Track (N : Node_Id; Loc : Node_Id) is - Nod : constant Node_Id := Original_Node (N); + procedure Track (N : Node_Id) is - begin - if Nkind (Nod) in N_Op_Compare then - Track (Left_Opnd (Nod), Loc); - Track (Right_Opnd (Nod), Loc); + procedure Rec (Sub_N : Node_Id); + -- Recursive helper to do the work of Track, so we can refer to N's + -- Sloc in error messages. Sub_N is initially N, and a proper subnode + -- when recursively walking comparison operations. - elsif Is_Entity_Name (Nod) and then Is_Object (Entity (Nod)) then - declare - CV : constant Node_Id := Current_Value (Entity (Nod)); + procedure Rec (Sub_N : Node_Id) is + Orig : constant Node_Id := Original_Node (Sub_N); + begin + if Nkind (Orig) in N_Op_Compare then + Rec (Left_Opnd (Orig)); + Rec (Right_Opnd (Orig)); - begin - if Present (CV) then - Error_Msg_Sloc := Sloc (CV); + elsif Is_Entity_Name (Orig) and then Is_Object (Entity (Orig)) then + declare + CV : constant Node_Id := Current_Value (Entity (Orig)); + begin + if Present (CV) then + Error_Msg_Sloc := Sloc (CV); - if Nkind (CV) not in N_Subexpr then - Error_Msg_N ("\\??(see test #)", Loc); + if Nkind (CV) not in N_Subexpr then + Error_Msg_N ("\\??(see test #)", N); - elsif Nkind (Parent (CV)) = - N_Case_Statement_Alternative - then - Error_Msg_N ("\\??(see case alternative #)", Loc); + elsif Nkind (Parent (CV)) = + N_Case_Statement_Alternative + then + Error_Msg_N ("\\??(see case alternative #)", N); - else - Error_Msg_N ("\\??(see assignment #)", Loc); + else + Error_Msg_N ("\\??(see assignment #)", N); + end if; end if; - end if; - end; - end if; + end; + end if; + end Rec; + + begin + Rec (N); end Track; -- Local variables @@ -3464,11 +3457,8 @@ package body Sem_Warn is and then Is_Known_Branch then declare - Atrue : Boolean; - + Atrue : Boolean := Test_Result; begin - Atrue := Test_Result; - if Present (Parent (C)) and then Nkind (Parent (C)) = N_Op_Not then Atrue := not Atrue; end if; @@ -3550,7 +3540,6 @@ package body Sem_Warn is declare True_Branch : Boolean := Test_Result; Cond : Node_Id := C; - begin if Present (Parent (C)) and then Nkind (Parent (C)) = N_Op_Not @@ -3559,37 +3548,27 @@ package body Sem_Warn is Cond := Parent (C); end if; - -- Condition always True - - if True_Branch then - if Is_Entity_Name (Original_Node (C)) - and then Nkind (Cond) /= N_Op_Not - then - Error_Msg_NE - ("object & is always True at this point?c?", - Cond, Original_Node (C)); - Track (Original_Node (C), Cond); + -- Suppress warning if this is True/False of a derived boolean + -- type with Nonzero_Is_True, which gets rewritten as Boolean + -- True/False. - else - Error_Msg_N ("condition is always True?c?", Cond); - Track (Cond, Cond); - end if; + if Is_Entity_Name (Original_Node (C)) + and then Ekind (Entity (Original_Node (C))) + = E_Enumeration_Literal + and then Nonzero_Is_True (Etype (Original_Node (C))) + then + null; - -- Condition always False + -- Give warning for nontrivial always True/False case else - if Is_Entity_Name (Original_Node (C)) - and then Nkind (Cond) /= N_Op_Not - then - Error_Msg_NE - ("object & is always False at this point?c?", - Cond, Original_Node (C)); - Track (Original_Node (C), Cond); - + if True_Branch then + Error_Msg_N ("condition is always True?c?", Cond); else Error_Msg_N ("condition is always False?c?", Cond); - Track (Cond, Cond); end if; + + Track (Cond); end if; end; end if; -- cgit v1.1 From 90908af3f8648567f1027260d38e5979e45066a3 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Fri, 14 Oct 2022 12:17:30 +0200 Subject: ada: Clean up unnecessary nesting in code for DLL libraries Code cleanup; issue spotted while examining routines with No_ prefix. gcc/ada/ * mdll.ads (Build_Import_Library): Fix grammar in comment. * mdll.adb (Build_Import_Library): Directly execute code of a nested routine; rename No_Lib_Prefix to Strip_Lib_Prefix. --- gcc/ada/mdll.adb | 68 ++++++++++++++++++++++---------------------------------- gcc/ada/mdll.ads | 4 ++-- 2 files changed, 28 insertions(+), 44 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/mdll.adb b/gcc/ada/mdll.adb index 2107994..88f8f96 100644 --- a/gcc/ada/mdll.adb +++ b/gcc/ada/mdll.adb @@ -448,57 +448,41 @@ package body MDLL is (Lib_Filename : String; Def_Filename : String) is - procedure Build_Import_Library (Lib_Filename : String); - -- Build an import library. This is to build only a .a library to link - -- against a DLL. + function Strip_Lib_Prefix (Filename : String) return String; + -- Return Filename without the lib prefix if present - -------------------------- - -- Build_Import_Library -- - -------------------------- - - procedure Build_Import_Library (Lib_Filename : String) is - - function No_Lib_Prefix (Filename : String) return String; - -- Return Filename without the lib prefix if present - - ------------------- - -- No_Lib_Prefix -- - ------------------- - - function No_Lib_Prefix (Filename : String) return String is - begin - if Filename (Filename'First .. Filename'First + 2) = "lib" then - return Filename (Filename'First + 3 .. Filename'Last); - else - return Filename; - end if; - end No_Lib_Prefix; - - -- Local variables - - Def_File : String renames Def_Filename; - Dll_File : constant String := Get_Dll_Name (Lib_Filename); - Base_Filename : constant String := - MDLL.Fil.Ext_To (No_Lib_Prefix (Lib_Filename)); - Lib_File : constant String := "lib" & Base_Filename & ".dll.a"; - - -- Start of processing for Build_Import_Library + ---------------------- + -- Strip_Lib_Prefix -- + ---------------------- + function Strip_Lib_Prefix (Filename : String) return String is begin - if not Quiet then - Text_IO.Put_Line ("Building import library..."); - Text_IO.Put_Line - ("make " & Lib_File & " to use dynamic library " & Dll_File); + if Filename (Filename'First .. Filename'First + 2) = "lib" then + return Filename (Filename'First + 3 .. Filename'Last); + else + return Filename; end if; + end Strip_Lib_Prefix; - Utl.Dlltool - (Def_File, Dll_File, Lib_File, Build_Import => True); - end Build_Import_Library; + -- Local variables + + Def_File : String renames Def_Filename; + Dll_File : constant String := Get_Dll_Name (Lib_Filename); + Base_Filename : constant String := + MDLL.Fil.Ext_To (Strip_Lib_Prefix (Lib_Filename)); + Lib_File : constant String := "lib" & Base_Filename & ".dll.a"; -- Start of processing for Build_Import_Library begin - Build_Import_Library (Lib_Filename); + if not Quiet then + Text_IO.Put_Line ("Building import library..."); + Text_IO.Put_Line + ("make " & Lib_File & " to use dynamic library " & Dll_File); + end if; + + Utl.Dlltool + (Def_File, Dll_File, Lib_File, Build_Import => True); end Build_Import_Library; ------------------ diff --git a/gcc/ada/mdll.ads b/gcc/ada/mdll.ads index 110eb31..9f080c0 100644 --- a/gcc/ada/mdll.ads +++ b/gcc/ada/mdll.ads @@ -74,7 +74,7 @@ package MDLL is procedure Build_Import_Library (Lib_Filename : String; Def_Filename : String); - -- Build an import library (.a) from a definition files. An import library - -- is needed to link against a DLL. + -- Build an import library (.a) from definition files. An import library is + -- needed to link against a DLL. end MDLL; -- cgit v1.1 From 7dee088c9db6a420b60379dd576493d12c055ffd Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Fri, 14 Oct 2022 20:22:34 +0200 Subject: ada: Fix detection of external calls to protected objects in instances Detection of external-vs-internal calls to protected objects relied on the scope stack. This didn't work when the call appeared in an instance of generic unit, because instances are analyzed in different context to where they appear. gcc/ada/ * exp_ch6.adb (Expand_Protected_Subprogram_Call): Examine scope tree and not the scope stack. --- gcc/ada/exp_ch6.adb | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 9380f3d..0fa9768 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -6240,7 +6240,7 @@ package body Exp_Ch6 is -- The object may be a component of some other data structure, in which -- case this must be handled as an inter-object call. - if not In_Open_Scopes (Scop) + if not Scope_Within_Or_Same (Inner => Current_Scope, Outer => Scop) or else Is_Entry_Wrapper (Current_Scope) or else not Is_Entity_Name (Name (N)) then -- cgit v1.1 From aa0e7d31a803f948504f8692c4ae48e3ba1b677b Mon Sep 17 00:00:00 2001 From: Steve Baird Date: Thu, 13 Oct 2022 17:07:31 -0700 Subject: ada: Rework CUDA host-side invocation of device-side elaboration code When the binder is invoked with a "-d_c" switch, add an argument to that switch which is the library name on the device side; so "-d_c" becomes "-d_c=some_library_name". This does not effect the case where "-d_c" is specified as a switch for compilation (as opposed to binding). Use this new piece of information in the code generated by the binder to invoke elaboration code on the device side from the host side. gcc/ada/ * opt.ads: Declare new string pointer variable, CUDA_Device_Library_Name. Modify comments for existing Boolean variable Enable_CUDA_Device_Expansion. * switch-b.adb: When "-d_c" switch is encountered, check that the next character is an "'='; use the remaining characters to initialize Opt.CUDA_Device_Library_Name. * bindgen.adb: Remove (for now) most support for host-side invocation of device-side finalization. Make use of the new CUDA_Device_Library_Name in determining the string used to refer (on the host side) to the device-side initialization procedure. Declare the placeholder routine that is named in the CUDA_Execute pragma (and the CUDA_Register_Function call) as an exported null procedure, rather than as an imported procedure. It is not clear whether it is really necessary to specify the link-name for this should-never-be-called subprogram on the host side, but for now it shouldn't hurt to do so. --- gcc/ada/bindgen.adb | 53 ++++++++++++++++++++-------------------------------- gcc/ada/opt.ads | 8 +++++--- gcc/ada/switch-b.adb | 9 +++++++++ 3 files changed, 34 insertions(+), 36 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 4e89918..b942985 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -114,27 +114,25 @@ package body Bindgen is -- For CodePeer, introduce a wrapper subprogram which calls the -- user-defined main subprogram. - -- Names for local C-String variables + -- Name for local C-String variable Adainit_String_Obj_Name : constant String := "Adainit_Name_C_String"; - Adafinal_String_Obj_Name : constant String := "Adafinal_Name_C_String"; - -- Names and link_names for CUDA device adainit/adafinal procs. + -- Name and link_name for CUDA device initialization procedure - Device_Subp_Name_Prefix : constant String := "imported_device_"; + Device_Ada_Init_Subp_Name : constant String := "Device_Initialization"; Device_Link_Name_Prefix : constant String := "__device_"; - function Device_Ada_Final_Link_Name return String is - (Device_Link_Name_Prefix & Ada_Final_Name.all); + function Device_Link_Name (Suffix : String) return String is + (Device_Link_Name_Prefix & + (if CUDA_Device_Library_Name = null + then "ada" -- is this an error path? + else CUDA_Device_Library_Name.all) & Suffix); - function Device_Ada_Final_Subp_Name return String is - (Device_Subp_Name_Prefix & Ada_Final_Name.all); - - function Device_Ada_Init_Link_Name return String is - (Device_Link_Name_Prefix & Ada_Init_Name.all); - - function Device_Ada_Init_Subp_Name return String is - (Device_Subp_Name_Prefix & Ada_Init_Name.all); + function Device_Ada_Init_Link_Name return String + is (Device_Link_Name (Suffix => "init")); + function Device_Ada_Final_Link_Name return String + is (Device_Link_Name (Suffix => "final")); ---------------------------------- -- Interface_State Pragma Table -- @@ -523,12 +521,6 @@ package body Bindgen is WBI (" System.Standard_Library.Adafinal;"); end if; - -- perform device (as opposed to host) finalization - if Enable_CUDA_Expansion then - WBI (" pragma CUDA_Execute (" & - Device_Ada_Final_Subp_Name & ", 1, 1);"); - end if; - WBI (" end " & Ada_Final_Name.all & ";"); WBI (""); end Gen_Adafinal; @@ -1362,17 +1354,17 @@ package body Bindgen is end loop; WBI (" procedure " & Device_Ada_Init_Subp_Name & ";"); - WBI (" pragma Import (C, " & Device_Ada_Init_Subp_Name & + WBI (" pragma Export (C, " & Device_Ada_Init_Subp_Name & ", Link_Name => """ & Device_Ada_Init_Link_Name & """);"); - WBI (" procedure " & Device_Ada_Final_Subp_Name & ";"); - WBI (" pragma Import (C, " & Device_Ada_Final_Subp_Name & - ", Link_Name => """ & Device_Ada_Final_Link_Name & """);"); - -- C-string declarations for adainit and adafinal + -- It would be nice to declare a real body that raises P_E, but + -- generating a subprogram body at the right point is harder + -- than generating a null procedure here. + WBI (" procedure " & Device_Ada_Init_Subp_Name & " is null;"); + + -- C-string declaration for adainit WBI (" " & Adainit_String_Obj_Name & " : Interfaces.C.Strings.Chars_Ptr;"); - WBI (" " & Adafinal_String_Obj_Name - & " : Interfaces.C.Strings.Chars_Ptr;"); WBI (""); WBI (""); @@ -1455,15 +1447,11 @@ package body Bindgen is end; end loop; - -- Register device-side Adainit and Adafinal + -- Register device-side Adainit Gen_CUDA_Register_Function_Call (Kernel_Name => Device_Ada_Init_Link_Name, Kernel_String => Adainit_String_Obj_Name, Kernel_Proc => Device_Ada_Init_Subp_Name); - Gen_CUDA_Register_Function_Call - (Kernel_Name => Device_Ada_Final_Link_Name, - Kernel_String => Adafinal_String_Obj_Name, - Kernel_Proc => Device_Ada_Final_Subp_Name); WBI (" CUDA_Register_Fat_Binary_End (Fat_Binary_Handle);"); @@ -2702,7 +2690,6 @@ package body Bindgen is if not Cumulative_Restrictions.Set (No_Finalization) then WBI (""); WBI (" procedure " & Ada_Final_Name.all & ";"); - if Enable_CUDA_Device_Expansion then WBI (" pragma Export (C, " & Ada_Final_Name.all & ", Link_Name => """ & Device_Ada_Final_Link_Name & """);"); diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 9eb792e..6f3ced2 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -395,6 +395,10 @@ package Opt is -- Set to True (-C switch) to indicate that the compiler will be invoked -- with a mapping file (-gnatem compiler switch). + CUDA_Device_Library_Name : String_Ptr := null; + -- GNATBIND + -- Non-null only if Enable_CUDA_Expansion is True. + subtype Debug_Level_Value is Nat range 0 .. 3; Debugger_Level : Debug_Level_Value := 0; -- GNAT, GNATBIND @@ -549,9 +553,7 @@ package Opt is Enable_CUDA_Device_Expansion : Boolean := False; -- GNATBIND - -- Set to True to enable CUDA device (as opposed to host) expansion: - -- - Binder generates elaboration/finalization code that can be - -- invoked from corresponding binder-generated host-side code. + -- Set to True to enable CUDA device (as opposed to host) expansion. Error_Msg_Line_Length : Nat := 0; -- GNAT diff --git a/gcc/ada/switch-b.adb b/gcc/ada/switch-b.adb index c40cb97..7a732ae 100644 --- a/gcc/ada/switch-b.adb +++ b/gcc/ada/switch-b.adb @@ -168,6 +168,15 @@ package body Switch.B is if Enable_CUDA_Expansion and Enable_CUDA_Device_Expansion then Bad_Switch (Switch_Chars); + elsif C = 'c' then + -- specify device library name + if Ptr >= Max or else Switch_Chars (Ptr + 1) /= '=' then + Bad_Switch (Switch_Chars); + else + CUDA_Device_Library_Name := + new String'(Switch_Chars (Ptr + 2 .. Max)); + Ptr := Max; + end if; end if; Underscore := False; -- cgit v1.1 From b86ff061234ff42934bc08c5dc1ba041724eba22 Mon Sep 17 00:00:00 2001 From: Quentin Ochem Date: Fri, 14 Oct 2022 06:30:04 -0400 Subject: ada: Fixed elaboration of CUDA programs. The names of imported / exported symbols were not consistent between the device and the host when compiling for CUDA. Remove the function Device_Ada_Final_Link_Name as it is no longer referenced. gcc/ada/ * bindgen.adb: fixed the way the device init and final symbols are computed, re-using the normal way these symbols would be computed with a __device_ prefix. Also fixed the "is null;" procedure on the host side which are not Ada 95, replaced with a procedure raising an exception as it should never be called. Remove the unused function Device_Ada_Final_Link_Name. Co-authored-by: Steve Baird --- gcc/ada/bindgen.adb | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index b942985..e72cdf8 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -131,8 +131,6 @@ package body Bindgen is function Device_Ada_Init_Link_Name return String is (Device_Link_Name (Suffix => "init")); - function Device_Ada_Final_Link_Name return String - is (Device_Link_Name (Suffix => "final")); ---------------------------------- -- Interface_State Pragma Table -- @@ -1357,11 +1355,6 @@ package body Bindgen is WBI (" pragma Export (C, " & Device_Ada_Init_Subp_Name & ", Link_Name => """ & Device_Ada_Init_Link_Name & """);"); - -- It would be nice to declare a real body that raises P_E, but - -- generating a subprogram body at the right point is harder - -- than generating a null procedure here. - WBI (" procedure " & Device_Ada_Init_Subp_Name & " is null;"); - -- C-string declaration for adainit WBI (" " & Adainit_String_Obj_Name & " : Interfaces.C.Strings.Chars_Ptr;"); @@ -2673,7 +2666,8 @@ package body Bindgen is WBI (" procedure " & Ada_Init_Name.all & ";"); if Enable_CUDA_Device_Expansion then WBI (" pragma Export (C, " & Ada_Init_Name.all & - ", Link_Name => """ & Device_Ada_Init_Link_Name & """);"); + ", Link_Name => """ & Device_Link_Name_Prefix + & Ada_Init_Name.all & """);"); WBI (" pragma CUDA_Global (" & Ada_Init_Name.all & ");"); else WBI (" pragma Export (C, " & Ada_Init_Name.all & ", """ & @@ -2692,7 +2686,8 @@ package body Bindgen is WBI (" procedure " & Ada_Final_Name.all & ";"); if Enable_CUDA_Device_Expansion then WBI (" pragma Export (C, " & Ada_Final_Name.all & - ", Link_Name => """ & Device_Ada_Final_Link_Name & """);"); + ", Link_Name => """ & Device_Link_Name_Prefix & + Ada_Final_Name.all & """);"); WBI (" pragma CUDA_Global (" & Ada_Final_Name.all & ");"); else WBI (" pragma Export (C, " & Ada_Final_Name.all & ", """ & @@ -2922,6 +2917,13 @@ package body Bindgen is Gen_Adainit (Elab_Order); + if Enable_CUDA_Expansion then + WBI (" procedure " & Device_Ada_Init_Subp_Name & " is"); + WBI (" begin"); + WBI (" raise Program_Error;"); + WBI (" end " & Device_Ada_Init_Subp_Name & ";"); + end if; + if Bind_Main_Program then Gen_Main; end if; -- cgit v1.1 From 27345558cce16e849884f5d1d4dd7d88974bb724 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Thu, 13 Oct 2022 17:12:18 -0400 Subject: ada: Fix inherited postconditions in inlined subprograms Protect the building of postcondition pragmas in case the postcondition is not present due to inlining. gcc/ada/ * freeze.adb (Build_Inherited_Condition_Pragmas): Do nothing if A_Post is empty. --- gcc/ada/freeze.adb | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 888e2ec..1fdc9d0 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1718,11 +1718,16 @@ package body Freeze is end; end if; - New_Prag := New_Copy_Tree (A_Post); - Rewrite - (Expression (First (Pragma_Argument_Associations (New_Prag))), - Class_Post); - Append (New_Prag, Decls); + -- A_Post can be null here if the postcondition was inlined in the + -- called subprogram. + + if Present (A_Post) then + New_Prag := New_Copy_Tree (A_Post); + Rewrite + (Expression (First (Pragma_Argument_Associations (New_Prag))), + Class_Post); + Append (New_Prag, Decls); + end if; end if; end Build_Inherited_Condition_Pragmas; -- cgit v1.1 From 9b07c1752b9bf49143a41c810e2db86f633fdb1c Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Mon, 17 Oct 2022 16:28:20 +0200 Subject: ada: Inline composite node kind AST queries Queries that ultimately examine the same field of an AST node (e.g. Nkind) are visibly more efficient when inlined. In particular, routines Is_Body_Or_Package_Declaration and Is_Body can apparently be inlined into a single Nkind membership test. This patch fixes some of the performance lost with the recent changes, which increased the number of calls to Is_Body_Or_Package_Declaration (as it is typically used to prevent AST search from climbing too far). However, it should be generally beneficial to inline routines like this. gcc/ada/ * sem_aux.ads (Is_Body): Annotate with Inline. * sem_util.ads (Is_Body_Or_Package_Declaration): Likewise. --- gcc/ada/sem_aux.ads | 2 +- gcc/ada/sem_util.ads | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/sem_aux.ads b/gcc/ada/sem_aux.ads index 66cbcfb..004aadb 100644 --- a/gcc/ada/sem_aux.ads +++ b/gcc/ada/sem_aux.ads @@ -279,7 +279,7 @@ package Sem_Aux is -- or subtype. This is true if Suppress_Initialization is set either for -- the subtype itself, or for the corresponding base type. - function Is_Body (N : Node_Id) return Boolean; + function Is_Body (N : Node_Id) return Boolean with Inline; -- Determine whether an arbitrary node denotes a body function Is_By_Copy_Type (Ent : Entity_Id) return Boolean; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 5c08cb8..2126bed 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1881,7 +1881,8 @@ package Sem_Util is function Is_Attribute_Update (N : Node_Id) return Boolean; -- Determine whether node N denotes attribute 'Update - function Is_Body_Or_Package_Declaration (N : Node_Id) return Boolean; + function Is_Body_Or_Package_Declaration (N : Node_Id) return Boolean + with Inline; -- Determine whether node N denotes a body or a package declaration function Is_Bounded_String (T : Entity_Id) return Boolean; -- cgit v1.1 From 2702882fdbd14ad647ea2a88c7f9ea2cd62fa23e Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Mon, 17 Oct 2022 11:56:27 -0400 Subject: ada: New warning about noncomposing user-defined "=" Print warning for a user-defined "=" that does not compose as might be expected (i.e. is ignored for predefined "=" of a containing record or array type). This warning is enabled by -gnatw_q; we don't enable it by default because it generates too many false positives. We also don't enable it via -gnatwa. gcc/ada/ * exp_ch4.adb (Expand_Array_Equality): Do not test Ltyp = Rtyp here, because that is necessarily true. Move assertion thereof to more general place. (Expand_Composite_Equality): Pass in Outer_Type, for use in warnings. Rename Typ to be Comp_Type, to more clearly distinguish it from Outer_Type. Print warning when appropriate. * exp_ch4.ads: Minor comment fix. * errout.ads: There is no such pragma as Warning_As_Pragma -- Warning_As_Error must have been intended. Improve comment for ?x?. * exp_ch3.adb (Build_Untagged_Equality): Update comment to be accurate for more recent versions of Ada. * sem_case.adb (Choice_Analysis): Declare user-defined "=" functions as abstract. * sem_util.ads (Is_Bounded_String): Give RM reference in comment. * warnsw.ads, warnsw.adb (Warn_On_Ignored_Equality): Implement new warning switch -gnatw_q. * doc/gnat_ugn/building_executable_programs_with_gnat.rst: Document new warning switch. * gnat_ugn.texi: Regenerate. --- .../building_executable_programs_with_gnat.rst | 21 ++++++ gcc/ada/errout.ads | 9 ++- gcc/ada/exp_ch3.adb | 3 +- gcc/ada/exp_ch4.adb | 85 +++++++++++++++------- gcc/ada/exp_ch4.ads | 2 +- gcc/ada/gnat_ugn.texi | 31 ++++++++ gcc/ada/sem_case.adb | 6 ++ gcc/ada/sem_util.ads | 2 +- gcc/ada/warnsw.adb | 11 +++ gcc/ada/warnsw.ads | 9 ++- 10 files changed, 145 insertions(+), 34 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst index 83bc50f..31e2e31 100644 --- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst +++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst @@ -2795,6 +2795,8 @@ of the pragma in the :title:`GNAT_Reference_manual`). * :switch:`-gnatw.q` (questionable layout of record types) + * :switch:`-gnatw_q` (ignored equality) + * :switch:`-gnatw_r` (out-of-order record representation clauses) * :switch:`-gnatw.s` (overridden size clause) @@ -3687,6 +3689,25 @@ of the pragma in the :title:`GNAT_Reference_manual`). a record type would very likely cause inefficiencies. +.. index:: -gnatw_q (gcc) + +:switch:`-gnatw_q` + *Activate warnings for ignored equality operators.* + + This switch activates warnings for a user-defined "=" function that does + not compose (i.e. is ignored for a predefined "=" for a composite type + containing a component whose type has the user-defined "=" as + primitive). Note that the user-defined "=" must be a primitive operator + in order to trigger the warning. + + The default is that these warnings are not given. + +.. index:: -gnatw_Q (gcc) + +:switch:`-gnatw_Q` + *Suppress warnings for ignored equality operators.* + + .. index:: -gnatwr (gcc) :switch:`-gnatwr` diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 78fe514..846a4a6 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -64,7 +64,7 @@ package Errout is -- sequences in error messages generate appropriate tags for the output -- error messages. If this switch is False, then these sequences are still -- recognized (for the purposes of implementing the pattern matching in - -- pragmas Warnings (Off,..) and Warning_As_Pragma(...) but do not result + -- pragmas Warnings (Off,..) and Warning_As_Error(...) but do not result -- in adding the error message tag. The -gnatw.d switch sets this flag -- True, -gnatw.D sets this flag False. @@ -314,10 +314,11 @@ package Errout is -- continuations, use this in each continuation message. -- Insertion character ?x? ?.x? ?_x? (warning with switch) - -- Like ?, but if the flag Warn_Doc_Switch is True, adds the string + -- "x" is a (lower-case) warning switch character. + -- Like ??, but if the flag Warn_Doc_Switch is True, adds the string -- "[-gnatwx]", "[-gnatw.x]", or "[-gnatw_x]", at the end of the - -- warning message. x must be lower case. For continuations, use this - -- on each continuation message. + -- warning message. For continuations, use this on each continuation + -- message. -- Insertion character ?*? (restriction warning) -- Like ?, but if the flag Warn_Doc_Switch is True, adds the string diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 0d82691..1e70b58 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -4599,7 +4599,8 @@ package body Exp_Ch3 is end if; -- If not inherited and not user-defined, build body as for a type with - -- tagged components. + -- components of record type (i.e. a type for which "=" composes when + -- used as a component in an outer composite type). if Build_Eq then Decl := diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index b9433c3..4a60ff5 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -151,14 +151,17 @@ package body Exp_Ch4 is -- where we allow comparison of "out of range" values. function Expand_Composite_Equality - (Nod : Node_Id; - Typ : Entity_Id; - Lhs : Node_Id; - Rhs : Node_Id) return Node_Id; + (Outer_Type : Entity_Id; + Nod : Node_Id; + Comp_Type : Entity_Id; + Lhs : Node_Id; + Rhs : Node_Id) return Node_Id; -- Local recursive function used to expand equality for nested composite -- types. Used by Expand_Record/Array_Equality. Nod provides the Sloc value -- for generated code. Lhs and Rhs are the left and right sides for the - -- comparison, and Typ is the type of the objects to compare. + -- comparison, and Comp_Typ is the type of the objects to compare. + -- Outer_Type is the composite type containing a component of type + -- Comp_Type -- used for printing messages. procedure Expand_Concatenate (Cnode : Node_Id; Opnds : List_Id); -- Routine to expand concatenation of a sequence of two or more operands @@ -1721,7 +1724,8 @@ package body Exp_Ch4 is Prefix => Make_Identifier (Loc, Chars (B)), Expressions => Index_List2); - Test := Expand_Composite_Equality (Nod, Component_Type (Typ), L, R); + Test := Expand_Composite_Equality + (Typ, Nod, Component_Type (Typ), L, R); -- If some (sub)component is an unchecked_union, the whole operation -- will raise program error. @@ -1953,7 +1957,6 @@ package body Exp_Ch4 is if Ltyp /= Rtyp then Ltyp := Base_Type (Ltyp); Rtyp := Base_Type (Rtyp); - pragma Assert (Ltyp = Rtyp); end if; -- If the array type is distinct from the type of the arguments, it @@ -1976,6 +1979,7 @@ package body Exp_Ch4 is New_Rhs := Rhs; end if; + pragma Assert (Ltyp = Rtyp); First_Idx := First_Index (Ltyp); -- If optimization is enabled and the array boils down to a couple of @@ -1983,7 +1987,6 @@ package body Exp_Ch4 is -- which should be easier to optimize by the code generator. if Optimization_Level > 0 - and then Ltyp = Rtyp and then Is_Constrained (Ltyp) and then Number_Dimensions (Ltyp) = 1 and then Compile_Time_Known_Bounds (Ltyp) @@ -2010,7 +2013,7 @@ package body Exp_Ch4 is Prefix => New_Copy_Tree (New_Rhs), Expressions => New_List (New_Copy_Tree (Low_B))); - TestL := Expand_Composite_Equality (Nod, Ctyp, L, R); + TestL := Expand_Composite_Equality (Ltyp, Nod, Ctyp, L, R); L := Make_Indexed_Component (Loc, @@ -2022,7 +2025,7 @@ package body Exp_Ch4 is Prefix => New_Rhs, Expressions => New_List (New_Copy_Tree (High_B))); - TestH := Expand_Composite_Equality (Nod, Ctyp, L, R); + TestH := Expand_Composite_Equality (Ltyp, Nod, Ctyp, L, R); return Make_And_Then (Loc, Left_Opnd => TestL, Right_Opnd => TestH); @@ -2435,20 +2438,21 @@ package body Exp_Ch4 is -- case because it is not possible to respect normal Ada visibility rules. function Expand_Composite_Equality - (Nod : Node_Id; - Typ : Entity_Id; - Lhs : Node_Id; - Rhs : Node_Id) return Node_Id + (Outer_Type : Entity_Id; + Nod : Node_Id; + Comp_Type : Entity_Id; + Lhs : Node_Id; + Rhs : Node_Id) return Node_Id is Loc : constant Source_Ptr := Sloc (Nod); Full_Type : Entity_Id; Eq_Op : Entity_Id; begin - if Is_Private_Type (Typ) then - Full_Type := Underlying_Type (Typ); + if Is_Private_Type (Comp_Type) then + Full_Type := Underlying_Type (Comp_Type); else - Full_Type := Typ; + Full_Type := Comp_Type; end if; -- If the private type has no completion the context may be the @@ -2473,7 +2477,7 @@ package body Exp_Ch4 is -- Case of tagged record types if Is_Tagged_Type (Full_Type) then - Eq_Op := Find_Primitive_Eq (Typ); + Eq_Op := Find_Primitive_Eq (Comp_Type); pragma Assert (Present (Eq_Op)); return @@ -2635,18 +2639,20 @@ package body Exp_Ch4 is -- Equality composes in Ada 2012 for untagged record types. It also -- composes for bounded strings, because they are part of the - -- predefined environment. We could make it compose for bounded - -- strings by making them tagged, or by making sure all subcomponents - -- are set to the same value, even when not used. Instead, we have - -- this special case in the compiler, because it's more efficient. - - elsif Ada_Version >= Ada_2012 or else Is_Bounded_String (Typ) then + -- predefined environment (see 4.5.2(32.1/1)). We could make it + -- compose for bounded strings by making them tagged, or by making + -- sure all subcomponents are set to the same value, even when not + -- used. Instead, we have this special case in the compiler, because + -- it's more efficient. + elsif Ada_Version >= Ada_2012 or else Is_Bounded_String (Comp_Type) + then -- If no TSS has been created for the type, check whether there is -- a primitive equality declared for it. declare - Op : constant Node_Id := Build_Eq_Call (Typ, Loc, Lhs, Rhs); + Op : constant Node_Id := + Build_Eq_Call (Comp_Type, Loc, Lhs, Rhs); begin -- Use user-defined primitive if it exists, otherwise use @@ -2666,6 +2672,33 @@ package body Exp_Ch4 is -- Case of non-record types (always use predefined equality) else + -- Print a warning if there is a user-defined "=", because it can be + -- surprising that the predefined "=" takes precedence over it. + + -- Suppress the warning if the "user-defined" one is in the + -- predefined library, because those are defined to compose + -- properly by RM-4.5.2(32.1/1). Intrinsics also compose. + + declare + Op : constant Entity_Id := Find_Primitive_Eq (Comp_Type); + begin + if Warn_On_Ignored_Equality + and then Present (Op) + and then not In_Predefined_Unit (Base_Type (Comp_Type)) + and then not Is_Intrinsic_Subprogram (Op) + then + pragma Assert + (Is_First_Subtype (Outer_Type) + or else Is_Generic_Actual_Type (Outer_Type)); + Error_Msg_Node_1 := Outer_Type; + Error_Msg_Node_2 := Comp_Type; + Error_Msg + ("?_q?""="" for type & uses predefined ""="" for }", Loc); + Error_Msg_Sloc := Sloc (Op); + Error_Msg ("\?_q?""="" # is ignored here", Loc); + end if; + end; + return Make_Op_Eq (Loc, Left_Opnd => Lhs, Right_Opnd => Rhs); end if; end Expand_Composite_Equality; @@ -13347,7 +13380,7 @@ package body Exp_Ch4 is end if; Check := - Expand_Composite_Equality (Nod, Etype (C), + Expand_Composite_Equality (Typ, Nod, Etype (C), Lhs => Make_Selected_Component (Loc, Prefix => New_Lhs, diff --git a/gcc/ada/exp_ch4.ads b/gcc/ada/exp_ch4.ads index eb9b506..7efd105 100644 --- a/gcc/ada/exp_ch4.ads +++ b/gcc/ada/exp_ch4.ads @@ -97,7 +97,7 @@ package Exp_Ch4 is -- individually to yield the required Boolean result. Loc is the -- location for the generated nodes. Typ is the type of the record, and -- Lhs, Rhs are the record expressions to be compared, these - -- expressions need not to be analyzed but have to be side-effect free. + -- expressions need not be analyzed but have to be side-effect free. -- Nod provides the Sloc value for generated code. procedure Expand_Set_Membership (N : Node_Id); diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 0f23d5b..ff5cfa9 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -10733,6 +10733,9 @@ switch are: @code{-gnatw.q} (questionable layout of record types) @item +@code{-gnatw_q} (ignored equality) + +@item @code{-gnatw_r} (out-of-order record representation clauses) @item @@ -11948,6 +11951,34 @@ This switch suppresses warnings for cases where the default layout of a record type would very likely cause inefficiencies. @end table +@geindex -gnatw_q (gcc) + + +@table @asis + +@item @code{-gnatw_q} + +`Activate warnings for ignored equality operators.' + +This switch activates warnings for a user-defined “=” function that does +not compose (i.e. is ignored for a predefined “=” for a composite type +containing a component whose type has the user-defined “=” as +primitive). Note that the user-defined “=” must be a primitive operator +in order to trigger the warning. + +The default is that these warnings are not given. +@end table + +@geindex -gnatw_Q (gcc) + + +@table @asis + +@item @code{-gnatw_Q} + +`Suppress warnings for ignored equality operators.' +@end table + @geindex -gnatwr (gcc) diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb index bb732b7..244e53f 100644 --- a/gcc/ada/sem_case.adb +++ b/gcc/ada/sem_case.adb @@ -192,8 +192,13 @@ package body Sem_Case is record Low, High : Uint; end record; + function "=" (X, Y : Discrete_Range_Info) return Boolean is abstract; + -- Here (and below), we don't use "=", which is a good thing, + -- because it wouldn't work, because the user-defined "=" on + -- Uint does not compose according to Ada rules. type Composite_Range_Info is array (Part_Id) of Discrete_Range_Info; + function "=" (X, Y : Composite_Range_Info) return Boolean is abstract; type Choice_Range_Info (Is_Others : Boolean := False) is record @@ -204,6 +209,7 @@ package body Sem_Case is null; end case; end record; + function "=" (X, Y : Choice_Range_Info) return Boolean is abstract; type Choices_Range_Info is array (Choice_Id) of Choice_Range_Info; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 2126bed..e651b20 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1887,7 +1887,7 @@ package Sem_Util is function Is_Bounded_String (T : Entity_Id) return Boolean; -- True if T is a bounded string type. Used to make sure "=" composes - -- properly for bounded string types. + -- properly for bounded string types (see 4.5.2(32.1/1)). function Is_By_Protected_Procedure (Id : Entity_Id) return Boolean; -- Determine whether entity Id denotes a procedure with synchronization diff --git a/gcc/ada/warnsw.adb b/gcc/ada/warnsw.adb index 4a7dcc3..733c962 100644 --- a/gcc/ada/warnsw.adb +++ b/gcc/ada/warnsw.adb @@ -80,6 +80,7 @@ package body Warnsw is Warn_On_Questionable_Layout := Setting; Warn_On_Questionable_Missing_Parens := Setting; Warn_On_Record_Holes := Setting; + Warn_On_Ignored_Equality := Setting; Warn_On_Component_Order := Setting; Warn_On_Redundant_Constructs := Setting; Warn_On_Reverse_Bit_Order := Setting; @@ -181,6 +182,8 @@ package body Warnsw is W.Warn_On_Questionable_Missing_Parens; Warn_On_Record_Holes := W.Warn_On_Record_Holes; + Warn_On_Ignored_Equality := + W.Warn_On_Ignored_Equality; Warn_On_Component_Order := W.Warn_On_Component_Order; Warn_On_Redundant_Constructs := @@ -295,6 +298,8 @@ package body Warnsw is Warn_On_Questionable_Missing_Parens; W.Warn_On_Record_Holes := Warn_On_Record_Holes; + W.Warn_On_Ignored_Equality := + Warn_On_Ignored_Equality; W.Warn_On_Component_Order := Warn_On_Component_Order; W.Warn_On_Redundant_Constructs := @@ -516,6 +521,12 @@ package body Warnsw is when 'P' => Warn_On_Pedantic_Checks := False; + when 'q' => + Warn_On_Ignored_Equality := True; + + when 'Q' => + Warn_On_Ignored_Equality := False; + when 'r' => Warn_On_Component_Order := True; diff --git a/gcc/ada/warnsw.ads b/gcc/ada/warnsw.ads index 8fe5ef7..9edd6be 100644 --- a/gcc/ada/warnsw.ads +++ b/gcc/ada/warnsw.ads @@ -77,6 +77,12 @@ package Warnsw is -- Warn when explicit record component clauses leave uncovered holes (gaps) -- in a record layout. Off by default, set by -gnatw.h (but not -gnatwa). + Warn_On_Ignored_Equality : Boolean := False; + -- Warn when a user-defined "=" function does not compose (i.e. is ignored + -- for a predefined "=" for a composite type containing a component of + -- whose type has the user-defined "=" as primitive). Off by default, and + -- set by -gnatw_q (but not -gnatwa). + Warn_On_Component_Order : Boolean := False; -- Warn when record component clauses are out of order with respect to the -- component declarations, or if the memory layout is out of order with @@ -140,6 +146,7 @@ package Warnsw is Warn_On_Questionable_Layout : Boolean; Warn_On_Questionable_Missing_Parens : Boolean; Warn_On_Record_Holes : Boolean; + Warn_On_Ignored_Equality : Boolean; Warn_On_Component_Order : Boolean; Warn_On_Redundant_Constructs : Boolean; Warn_On_Reverse_Bit_Order : Boolean; @@ -156,7 +163,7 @@ package Warnsw is end record; function Save_Warnings return Warning_Record; - -- Returns current settingh of warnings + -- Returns current settings of warnings procedure Restore_Warnings (W : Warning_Record); -- Restores current settings of warning flags from W -- cgit v1.1 From d24f279c023051c95b88b8405ac8aa4ebb44b107 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Mon, 17 Oct 2022 15:49:22 -0400 Subject: ada: Use named notation in calls to Expand_Composite_Equality Use named notation in calls to Expand_Composite_Equality. gcc/ada/ * exp_ch4.adb (Component_Equality, Expand_Array_Equality) (Expand_Record_Equality): Use named notation. --- gcc/ada/exp_ch4.adb | 30 ++++++++++++++++++------------ 1 file changed, 18 insertions(+), 12 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 4a60ff5..0a104cd 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -1725,7 +1725,8 @@ package body Exp_Ch4 is Expressions => Index_List2); Test := Expand_Composite_Equality - (Typ, Nod, Component_Type (Typ), L, R); + (Outer_Type => Typ, Nod => Nod, Comp_Type => Component_Type (Typ), + Lhs => L, Rhs => R); -- If some (sub)component is an unchecked_union, the whole operation -- will raise program error. @@ -2013,7 +2014,9 @@ package body Exp_Ch4 is Prefix => New_Copy_Tree (New_Rhs), Expressions => New_List (New_Copy_Tree (Low_B))); - TestL := Expand_Composite_Equality (Ltyp, Nod, Ctyp, L, R); + TestL := Expand_Composite_Equality + (Outer_Type => Ltyp, Nod => Nod, Comp_Type => Ctyp, + Lhs => L, Rhs => R); L := Make_Indexed_Component (Loc, @@ -2025,7 +2028,9 @@ package body Exp_Ch4 is Prefix => New_Rhs, Expressions => New_List (New_Copy_Tree (High_B))); - TestH := Expand_Composite_Equality (Ltyp, Nod, Ctyp, L, R); + TestH := Expand_Composite_Equality + (Outer_Type => Ltyp, Nod => Nod, Comp_Type => Ctyp, + Lhs => L, Rhs => R); return Make_And_Then (Loc, Left_Opnd => TestL, Right_Opnd => TestH); @@ -13380,15 +13385,16 @@ package body Exp_Ch4 is end if; Check := - Expand_Composite_Equality (Typ, Nod, Etype (C), - Lhs => - Make_Selected_Component (Loc, - Prefix => New_Lhs, - Selector_Name => New_Occurrence_Of (C, Loc)), - Rhs => - Make_Selected_Component (Loc, - Prefix => New_Rhs, - Selector_Name => New_Occurrence_Of (C, Loc))); + Expand_Composite_Equality + (Outer_Type => Typ, Nod => Nod, Comp_Type => Etype (C), + Lhs => + Make_Selected_Component (Loc, + Prefix => New_Lhs, + Selector_Name => New_Occurrence_Of (C, Loc)), + Rhs => + Make_Selected_Component (Loc, + Prefix => New_Rhs, + Selector_Name => New_Occurrence_Of (C, Loc))); -- If some (sub)component is an unchecked_union, the whole -- operation will raise program error. -- cgit v1.1 From dc3208e698b2f424d892d3c9e5d5562ccde9e4cf Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Mon, 17 Oct 2022 22:08:37 +0200 Subject: ada: Fix performance regression related to references in Refined_State Recently added call to In_Pragma_Expression caused a performance regression. It might require climbing syntax trees of arbitrarily deep expressions, while previously references within pragmas were detected in bounded time. This patch restores the previous efficiency. However, while the original code only detected references directly within pragma argument associations, now we also detect references inside aggregates, e.g. like those in pragma Refined_State. gcc/ada/ * sem_prag.adb (Non_Significant_Pragma_Reference): Detect references with aggregates; only assign local variables Id and C when necessary. --- gcc/ada/sem_prag.adb | 56 +++++++++++++++++++++++++++------------------------- 1 file changed, 29 insertions(+), 27 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index f33d858..2a3aca8 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -31719,43 +31719,45 @@ package body Sem_Prag is -- Start of processing for Non_Significant_Pragma_Reference begin - P := Parent (N); - - if Nkind (P) /= N_Pragma_Argument_Association then + -- Reference might appear either directly as expression of a pragma + -- argument association, e.g. pragma Export (...), or within an + -- aggregate with component associations, e.g. pragma Refined_State + -- ((... => ...)). - -- References within pragma Refined_State are not significant. They - -- can't be recognized using pragma argument number, because they - -- appear inside refinement clauses that rely on aggregate syntax. + P := Parent (N); + loop + case Nkind (P) is + when N_Pragma_Argument_Association => + exit; + when N_Aggregate | N_Component_Association => + P := Parent (P); + when others => + return False; + end case; + end loop; - if In_Pragma_Expression (N, Name_Refined_State) then - return True; - end if; + AN := Arg_No; + if AN = 0 then return False; + end if; - else - Id := Get_Pragma_Id (Parent (P)); - C := Sig_Flags (Id); - AN := Arg_No; + Id := Get_Pragma_Id (Parent (P)); + C := Sig_Flags (Id); - if AN = 0 then + case C is + when -1 => return False; - end if; - - case C is - when -1 => - return False; - when 0 => - return True; + when 0 => + return True; - when 92 .. 99 => - return AN < (C - 90); + when 92 .. 99 => + return AN < (C - 90); - when others => - return AN /= C; - end case; - end if; + when others => + return AN /= C; + end case; end Is_Non_Significant_Pragma_Reference; ------------------------------ -- cgit v1.1 From bcb3f09ec6cb9b2c6e58243d05b5a0fc33e909f1 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Tue, 18 Oct 2022 09:33:38 +0200 Subject: ada: Tune hash function for cross-reference entries Tune the hash function that combines entity identifiers with source locations of where those entities are referenced. Previously the source location was multiplied by 2 ** 7 (i.e. shifted left by 7 bits), then added to the entity identifier, and finally divided modulo 2 ** 16 (i.e. masked to only use the lowest 16 bits). This hash routine caused collisions that could make some tests up to twice slower. With a large entity number the source location was only contributing few bits to the hash value. This large entity number might correspond to entity like Ada.Characters.Latin_1.NUL that occurs thousands of times in generated code. gcc/ada/ * lib-xref.adb (Hash): Tune hash function. --- gcc/ada/lib-xref.adb | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index 043444c..5a1538e 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -1271,10 +1271,10 @@ package body Lib.Xref is XE : Xref_Entry renames Xrefs.Table (F); type M is mod 2**32; - H : constant M := M (XE.Key.Ent) + 2 ** 7 * M (abs XE.Key.Loc); + H : constant M := 3 * M (XE.Key.Ent) + 5 * M (abs XE.Key.Loc); -- It would be more natural to write: -- - -- H : constant M := M'Mod (XE.Key.Ent) + 2**7 * M'Mod (XE.Key.Loc); + -- H : constant M := 3 * M'Mod (XE.Key.Ent) + 5 * M'Mod (XE.Key.Loc); -- -- But we can't use M'Mod, because it prevents bootstrapping with older -- compilers. Loc can be negative, so we do "abs" before converting. -- cgit v1.1 From 96c053335c7329ecd6c37f395b479994bc187d3a Mon Sep 17 00:00:00 2001 From: Cedric Landet Date: Tue, 18 Oct 2022 09:58:46 +0200 Subject: ada: Document that gprof won't work on windows with PIE. Document that gprof won't work on windows with PIE and -no-pie must be used. gcc/ada/ * doc/gnat_ugn/gnat_and_program_execution.rst: Mention the needed -no-pie for windows to use gprof. * gnat_ugn.texi: Regenerate. --- gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst | 8 ++++++-- gcc/ada/gnat_ugn.texi | 7 +++++-- 2 files changed, 11 insertions(+), 4 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst b/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst index e827d1f..c239c36 100644 --- a/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst +++ b/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst @@ -1252,8 +1252,8 @@ most often, and are therefore the most time-consuming. better handle Ada programs and multitasking. It is currently supported on the following platforms -* linux x86/x86_64 -* windows x86 +* Linux x86/x86_64 +* Windows x86/x86_64 (without PIE support) In order to profile a program using ``gprof``, several steps are needed: @@ -1291,6 +1291,10 @@ Note that only the objects that were compiled with the ``-pg`` switch will be profiled; if you need to profile your whole project, use the ``-f`` gnatmake switch to force full recompilation. +Note that on Windows, gprof does not support PIE. The ``-no-pie`` switch +should be added to the linker flags to disable this feature. + + .. _Program_execution: diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index ff5cfa9..385f1d3 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -19552,10 +19552,10 @@ It is currently supported on the following platforms @itemize * @item -linux x86/x86_64 +Linux x86/x86_64 @item -windows x86 +Windows x86/x86_64 (without PIE support) @end itemize In order to profile a program using @code{gprof}, several steps are needed: @@ -19614,6 +19614,9 @@ Note that only the objects that were compiled with the @code{-pg} switch will be profiled; if you need to profile your whole project, use the @code{-f} gnatmake switch to force full recompilation. +Note that on Windows, gprof does not support PIE. The @code{-no-pie} switch +should be added to the linker flags to disable this feature. + @node Program execution,Running gprof,Compilation for profiling,Profiling an Ada Program with gprof @anchor{gnat_ugn/gnat_and_program_execution id23}@anchor{175}@anchor{gnat_ugn/gnat_and_program_execution program-execution}@anchor{176} @subsubsection Program execution -- cgit v1.1 From 33dc1bacc3d4f13bf4f5bc321780452591c32861 Mon Sep 17 00:00:00 2001 From: Martin Liska Date: Mon, 7 Nov 2022 09:50:21 +0100 Subject: Mitigate clang warnings: gcc/range-op.cc:1752:16: warning: 'wi_fold' overrides a member function but is not marked 'override' [-Winconsistent-missing-override] gcc/range-op.cc:1757:16: warning: 'wi_op_overflows' overrides a member function but is not marked 'override' [-Winconsistent-missing-override] gcc/range-op.cc:1759:16: warning: 'op1_range' overrides a member function but is not marked 'override' [-Winconsistent-missing-override] gcc/range-op.cc:1763:16: warning: 'op2_range' overrides a member function but is not marked 'override' [-Winconsistent-missing-override] gcc/range-op.cc:1928:16: warning: 'wi_fold' overrides a member function but is not marked 'override' [-Winconsistent-missing-override] gcc/range-op.cc:1933:16: warning: 'wi_op_overflows' overrides a member function but is not marked 'override' [-Winconsistent-missing-override] gcc/ChangeLog: * range-op.cc: Add final override keywords. --- gcc/range-op.cc | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) (limited to 'gcc') diff --git a/gcc/range-op.cc b/gcc/range-op.cc index 25c004d..5e94c3d 100644 --- a/gcc/range-op.cc +++ b/gcc/range-op.cc @@ -1753,17 +1753,18 @@ public: const wide_int &lh_lb, const wide_int &lh_ub, const wide_int &rh_lb, - const wide_int &rh_ub) const; + const wide_int &rh_ub) const final override; virtual bool wi_op_overflows (wide_int &res, tree type, - const wide_int &w0, const wide_int &w1) const; + const wide_int &w0, const wide_int &w1) + const final override; virtual bool op1_range (irange &r, tree type, const irange &lhs, const irange &op2, - relation_trio) const; + relation_trio) const final override; virtual bool op2_range (irange &r, tree type, const irange &lhs, const irange &op1, - relation_trio) const; + relation_trio) const final override; } op_mult; bool @@ -1929,9 +1930,10 @@ public: const wide_int &lh_lb, const wide_int &lh_ub, const wide_int &rh_lb, - const wide_int &rh_ub) const; + const wide_int &rh_ub) const final override; virtual bool wi_op_overflows (wide_int &res, tree type, - const wide_int &, const wide_int &) const; + const wide_int &, const wide_int &) + const final override; virtual bool fold_range (irange &r, tree type, const irange &lh, const irange &rh, relation_trio trio) const final override; -- cgit v1.1 From a8fb90eb3949bfb101bd6f50f24a029e10119591 Mon Sep 17 00:00:00 2001 From: Martin Liska Date: Mon, 7 Nov 2022 09:54:09 +0100 Subject: docs: update: document sanitizers can trigger warnings gcc/ChangeLog: * doc/invoke.texi: Improve wording. Co-Authored-By: Gerald Pfeifer --- gcc/doc/invoke.texi | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'gcc') diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index 4a0fbca..94a2e20 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -16502,9 +16502,10 @@ by this option. @end table -Note the enabled sanitizer options tend to increase a false-positive rate -of selected warnings, most notably @option{-Wmaybe-uninitialized}. -And thus we recommend to disable @option{-Werror}. +Note that sanitizers tend to increase the rate of false positive +warnings, most notably those around @option{-Wmaybe-uninitialized}. +We recommend against combining @option{-Werror} and [the use of] +sanitizers. While @option{-ftrapv} causes traps for signed overflows to be emitted, @option{-fsanitize=undefined} gives a diagnostic message. -- cgit v1.1