[COMMITTED] ada: Crash processing pragmas Compile_Time_Error and Compile_Time_Warning
From: Javier Miranda gcc/ada/ * sem_attr.adb (Analyze_Attribute): Protect the frontend against replacing 'Size by its static value if 'Size is not known at compile time and we are processing pragmas Compile_Time_Warning or Compile_Time_Errors. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_attr.adb | 25 +++-- 1 file changed, 19 insertions(+), 6 deletions(-) diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index d03761b1e30..3eba3a29362 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -6457,17 +6457,30 @@ package body Sem_Attr is or else Size_Known_At_Compile_Time (Entity (P))) then declare - Siz : Uint; + Prefix_E : Entity_Id := Entity (P); + Siz : Uint; begin - if Known_Static_RM_Size (Entity (P)) then - Siz := RM_Size (Entity (P)); + -- Handle private and incomplete types + + if Present (Underlying_Type (Prefix_E)) then + Prefix_E := Underlying_Type (Prefix_E); + end if; + + if Known_Static_RM_Size (Prefix_E) then + Siz := RM_Size (Prefix_E); else - Siz := Esize (Entity (P)); + Siz := Esize (Prefix_E); end if; - Rewrite (N, Make_Integer_Literal (Sloc (N), Siz)); - Analyze (N); + -- Protect the frontend against cases where the attribute + -- Size_Known_At_Compile_Time is set, but the Esize value + -- is not available (see Einfo.ads). + + if Present (Siz) then + Rewrite (N, Make_Integer_Literal (Sloc (N), Siz)); + Analyze (N); + end if; end; end if; -- 2.42.0
[COMMITTED] ada: Tweak documentation comments
From: Ronan Desplanques The concept of extended nodes was retired at the same time Gen_IL was introduced, but there was a reference to that concept left over in a comment. This patch removes that reference. Also, the description of the field Comes_From_Check_Or_Contract was incorrectly placed in a section for fields present in all nodes in sinfo.ads. This patch fixes this. gcc/ada/ * atree.ads, nlists.ads, types.ads: Remove references to extended nodes. Fix typo. * sinfo.ads: Likewise and fix position of Comes_From_Check_Or_Contract description. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/atree.ads | 9 - gcc/ada/nlists.ads | 3 --- gcc/ada/sinfo.ads | 31 ++- gcc/ada/types.ads | 4 +--- 4 files changed, 11 insertions(+), 36 deletions(-) diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index abe5cc5f3b5..2ff65d24679 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -252,7 +252,7 @@ package Atree is -- The usual approach is to build a new node using this function and -- then, using the value returned, use the Set_xxx functions to set -- fields of the node as required. New_Node can only be used for - -- non-entity nodes, i.e. it never generates an extended node. + -- non-entity nodes. -- -- If we are currently parsing, as indicated by a previous call to -- Set_Comes_From_Source_Default (True), then this call also resets @@ -308,8 +308,7 @@ package Atree is -- returns Empty, and New_Copy (Error) returns Error. Note that, unlike -- Copy_Separate_Tree, New_Copy does not recursively copy any descendants, -- so in general parent pointers are not set correctly for the descendants - -- of the copied node. Both normal and extended nodes (entities) may be - -- copied using New_Copy. + -- of the copied node. function Relocate_Node (Source : Node_Id) return Node_Id; -- Source is a non-entity node that is to be relocated. A new node is @@ -359,7 +358,7 @@ package Atree is -- caller, according to context. procedure Extend_Node (Source : Node_Id); - -- This turns a node into an entity; it function is used only by Sinfo.CN. + -- This turns a node into an entity; it is only used by Sinfo.CN. type Ignored_Ghost_Record_Proc is access procedure (N : Node_Or_Entity_Id); @@ -540,7 +539,7 @@ package Atree is -- newly constructed replacement subtree. The actual mechanism is to swap -- the contents of these two nodes fixing up the parent pointers of the -- replaced node (we do not attempt to preserve parent pointers for the - -- original node). Neither Old_Node nor New_Node can be extended nodes. + -- original node). -- ??? The above explanation is incorrect, instead Copy_Node is called. -- -- Note: New_Node may not contain references to Old_Node, for example as diff --git a/gcc/ada/nlists.ads b/gcc/ada/nlists.ads index 5e88032ff7d..7afe80f0051 100644 --- a/gcc/ada/nlists.ads +++ b/gcc/ada/nlists.ads @@ -43,9 +43,6 @@ package Nlists is -- this header, which may be used to access the nodes in the list using -- the set of routines that define this interface. - -- Note: node lists can contain either nodes or entities (extended nodes) - -- or a mixture of nodes and extended nodes. - function In_Same_List (N1, N2 : Node_Or_Entity_Id) return Boolean; pragma Inline (In_Same_List); -- Equivalent to List_Containing (N1) = List_Containing (N2) diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 57fd704475c..fc9bcfbd44d 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -82,12 +82,6 @@ package Sinfo is -- for this purpose, so e.g. in X := (if A then B else C); -- Paren_Count for the right side will be 1. - -- Comes_From_Check_Or_Contract - -- This flag is present in all N_If_Statement nodes and - -- gets set when an N_If_Statement is generated as part of - -- the expansion of a Check, Assert, or contract-related - -- pragma. - -- Comes_From_Source -- This flag is present in all nodes. It is set if the -- node is built by the scanner or parser, and clear if @@ -953,6 +947,12 @@ package Sinfo is --attribute definition clause is given, rather than testing this at the --freeze point. + -- Comes_From_Check_Or_Contract + --This flag is present in all N_If_Statement nodes and + --gets set when an N_If_Statement is generated as part of + --the expansion of a Check, Assert, or contract-related + --pragma. + -- Comes_From_Extended_Return_Statement --Present in N_Simple_Return_Statement nodes. True if this node was --constructed as part of the N_Extended_Return_Statement expansion. @@ -2809,12 +2809,6 @@ package Sinfo is -- fields are defi
[COMMITTED] ada: Fix bad finalization of limited aggregate in conditional expression
From: Eric Botcazou This happens when the conditional expression is immediately returned, for example in an expression function. gcc/ada/ * exp_aggr.adb (Is_Build_In_Place_Aggregate_Return): Return true if the aggregate is a dependent expression of a conditional expression being returned from a build-in-place function. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_aggr.adb | 13 ++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 165f517c031..e5f36326600 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -173,8 +173,11 @@ package body Exp_Aggr is -- function Is_Build_In_Place_Aggregate_Return (N : Node_Id) return Boolean; - -- True if N is an aggregate (possibly qualified or converted) that is - -- being returned from a build-in-place function. + -- True if N is an aggregate (possibly qualified or a dependent expression + -- of a conditional expression, and possibly recursively so) that is being + -- returned from a build-in-place function. Such qualified and conditional + -- expressions are transparent for this purpose because an enclosing return + -- is propagated resp. distributed into these expressions by the expander. function Build_Record_Aggr_Code (N : Node_Id; @@ -8463,7 +8466,11 @@ package body Exp_Aggr is P : Node_Id := Parent (N); begin - while Nkind (P) = N_Qualified_Expression loop + while Nkind (P) in N_Case_Expression + | N_Case_Expression_Alternative + | N_If_Expression + | N_Qualified_Expression + loop P := Parent (P); end loop; -- 2.42.0
[COMMITTED] ada: Remove superfluous setter procedure
From: Eric Botcazou It is only called once. gcc/ada/ * sem_util.ads (Set_Scope_Is_Transient): Delete. * sem_util.adb (Set_Scope_Is_Transient): Likewise. * exp_ch7.adb (Create_Transient_Scope): Set Is_Transient directly. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_ch7.adb | 2 +- gcc/ada/sem_util.adb | 9 - gcc/ada/sem_util.ads | 3 --- 3 files changed, 1 insertion(+), 13 deletions(-) diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 5049de54dd7..00b7692c964 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -4529,7 +4529,7 @@ package body Exp_Ch7 is Push_Scope (Trans_Scop); Scope_Stack.Table (Scope_Stack.Last).Node_To_Be_Wrapped := Context; - Set_Scope_Is_Transient; + Scope_Stack.Table (Scope_Stack.Last).Is_Transient := True; -- The transient scope must also manage the secondary stack diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index e778bab95d1..26ddb52bc4a 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -27792,15 +27792,6 @@ package body Sem_Util is end if; end Set_Rep_Info; - - -- Set_Scope_Is_Transient -- - - - procedure Set_Scope_Is_Transient (V : Boolean := True) is - begin - Scope_Stack.Table (Scope_Stack.Last).Is_Transient := V; - end Set_Scope_Is_Transient; - --- -- Set_Size_Info -- --- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 92016bc0eef..dda71e402b2 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -3165,9 +3165,6 @@ package Sem_Util is -- from sub(type) entity T2 to (sub)type entity T1, as well as Is_Volatile -- if T1 is a base type. - procedure Set_Scope_Is_Transient (V : Boolean := True); - -- Set the flag Is_Transient of the current scope - procedure Set_Size_Info (T1, T2 : Entity_Id); pragma Inline (Set_Size_Info); -- Copies the Esize field and Has_Biased_Representation flag from sub(type) -- 2.42.0
[COMMITTED] ada: Tweak internal subprogram in Ada.Directories
From: Ronan Desplanques The purpose of this patch is to work around false-positive warnings emitted by GNAT SAS (also known as CodePeer). It does not change the behavior of the modified subprogram. gcc/ada/ * libgnat/a-direct.adb (Start_Search_Internal): Tweak subprogram body. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnat/a-direct.adb | 46 1 file changed, 25 insertions(+), 21 deletions(-) diff --git a/gcc/ada/libgnat/a-direct.adb b/gcc/ada/libgnat/a-direct.adb index f7a1d5dfd6d..594971c6021 100644 --- a/gcc/ada/libgnat/a-direct.adb +++ b/gcc/ada/libgnat/a-direct.adb @@ -1379,13 +1379,21 @@ package body Ada.Directories is Compose (Directory, File_Name) & ASCII.NUL; Path : String renames Path_C (Path_C'First .. Path_C'Last - 1); - Found : Boolean := False; Attr : aliased File_Attributes; Exists : Integer; Error : Integer; - Kind : File_Kind; - Size : File_Size; + type Result (Found : Boolean := False) is record + case Found is +when True => + Kind : File_Kind; + Size : File_Size; +when False => + null; + end case; + end record; + + Res : Result := (Found => False); begin -- Get the file attributes for the directory item @@ -1416,32 +1424,28 @@ package body Ada.Directories is if Is_Regular_File_Attr (Path_C'Address, Attr'Access) = 1 then if Filter (Ordinary_File) then - Found := True; - Kind := Ordinary_File; - Size := - File_Size - (File_Length_Attr - (-1, Path_C'Address, Attr'Access)); + Res := (Found => True, + Kind => Ordinary_File, + Size => File_Size + (File_Length_Attr +(-1, Path_C'Address, Attr'Access))); end if; elsif Is_Directory_Attr (Path_C'Address, Attr'Access) = 1 then if Filter (File_Kind'First) then - Found := True; - Kind := File_Kind'First; - -- File_Kind'First is used instead of Directory due - -- to a name overload issue with the procedure - -- parameter Directory. - Size := 0; + Res := (Found => True, + Kind => File_Kind'First, + Size => 0); end if; elsif Filter (Special_File) then -Found := True; -Kind := Special_File; -Size := 0; +Res := (Found => True, +Kind => Special_File, +Size => 0); end if; - if Found then + if Res.Found then Search.State.Dir_Contents.Append (Directory_Entry_Type' (Valid => True, @@ -1449,9 +1453,9 @@ package body Ada.Directories is To_Unbounded_String (File_Name), Full_Name => To_Unbounded_String (Path), Attr_Error_Code => 0, - Kind => Kind, + Kind => Res.Kind, Modification_Time => Modification_Time (Path), - Size => Size)); + Size => Res.Size)); end if; end if; end; -- 2.42.0
[COMMITTED] ada: Fix infinite loop with multiple limited with clauses
From: Eric Botcazou
This occurs when one of the types has an incomplete declaration in addition
to its full declaration in its package. In this case AI05-129 says that the
incomplete type is not part of the limited view of the package, i.e. only
the full view is. Now, in the GNAT implementation, it's the opposite in the
regular view of the package, i.e. the incomplete type is the visible one.
That's why the implementation needs to also swap the types on the visibility
chain while it is swapping the views when the clauses are either installed
or removed. This works correctly for the installation, but does not for the
removal, so this change rewrites the code doing the latter.
gcc/ada/
PR ada/111434
* sem_ch10.adb (Replace): New procedure to replace an entity with
another on the homonym chain.
(Install_Limited_With_Clause): Rename Non_Lim_View to Typ for the
sake of consistency. Call Replace to do the replacements and split
the code into the regular and the special cases. Add debuggging
output controlled by -gnatdi.
(Install_With_Clause): Print the Parent_With and Implicit_With flags
in the debugging output controlled by -gnatdi.
(Remove_Limited_With_Unit.Restore_Chain_For_Shadow (Shadow)): Rewrite
using a direct replacement of E4 by E2. Call Replace to do the
replacements. Add debuggging output controlled by -gnatdi.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_ch10.adb | 170 +++
1 file changed, 107 insertions(+), 63 deletions(-)
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index a6cbe466b75..ba4beae2851 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -238,6 +238,9 @@ package body Sem_Ch10 is
-- Reset all visibility flags on unit after compiling it, either as a main
-- unit or as a unit in the context.
+ procedure Replace (Old_E, New_E : Entity_Id);
+ -- Replace Old_E by New_E on visibility list
+
procedure Unchain (E : Entity_Id);
-- Remove single entity from visibility list
@@ -5310,15 +5313,12 @@ package body Sem_Ch10 is
and then not Is_Child_Unit (Lim_Typ)
then
declare
- Non_Lim_View : constant Entity_Id :=
- Non_Limited_View (Lim_Typ);
+ Typ : constant Entity_Id := Non_Limited_View (Lim_Typ);
Prev : Entity_Id;
begin
- Prev := Current_Entity (Lim_Typ);
-
- -- Replace Non_Lim_View in the homonyms list, so that the
+ -- Replace Typ by Lim_Typ in the homonyms list, so that the
-- limited view becomes available.
-- If the nonlimited view is a record with an anonymous
@@ -5350,38 +5350,47 @@ package body Sem_Ch10 is
--
-- [*] denotes the visible entity (Current_Entity)
- if Prev = Non_Lim_View
-or else
- (Ekind (Prev) = E_Incomplete_Type
-and then Full_View (Prev) = Non_Lim_View)
-or else
- (Ekind (Prev) = E_Incomplete_Type
-and then From_Limited_With (Prev)
-and then
- Ekind (Non_Limited_View (Prev)) = E_Incomplete_Type
-and then
- Full_View (Non_Limited_View (Prev)) = Non_Lim_View)
- then
- Set_Current_Entity (Lim_Typ);
+ Prev := Current_Entity (Lim_Typ);
- else
- while Present (Homonym (Prev))
- and then Homonym (Prev) /= Non_Lim_View
- loop
-Prev := Homonym (Prev);
- end loop;
+ while Present (Prev) loop
+ -- This is a regular replacement
- Set_Homonym (Prev, Lim_Typ);
- end if;
+ if Prev = Typ
+ or else (Ekind (Prev) = E_Incomplete_Type
+ and then Full_View (Prev) = Typ)
+ then
+Replace (Prev, Lim_Typ);
- Set_Homonym (Lim_Typ, Homonym (Non_Lim_View));
- end;
+if Debug_Flag_I then
+ Write_Str (" (homonym) replace ");
+ Write_Name (Chars (Typ));
+ Write_Eol;
+end if;
- if Debug_Flag_I then
- Write_Str (" (homonym) chain ");
- Write_Name (Chars (Lim_Typ));
- Write_Eol;
- end if;
+exit;
+
+ -- This is where E1
[COMMITTED] ada: Fix internal error on too large representation clause for small component
From: Eric Botcazou This is a small bug present on strict-alignment platforms for questionable representation clauses. gcc/ada/ * gcc-interface/decl.cc (inline_status_for_subprog): Minor tweak. (gnat_to_gnu_field): Try harder to get a packable form of the type for a bitfield. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/gcc-interface/decl.cc | 14 +- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc index 5e16b56217c..20ab185d577 100644 --- a/gcc/ada/gcc-interface/decl.cc +++ b/gcc/ada/gcc-interface/decl.cc @@ -5114,7 +5114,7 @@ inline_status_for_subprog (Entity_Id subprog) tree gnu_type; /* This is a kludge to work around a pass ordering issue: for small -record types with many components, i.e. typically bit-fields, the +record types with many components, i.e. typically bitfields, the initialization routine can contain many assignments that will be merged by the GIMPLE store merging pass. But this pass runs very late in the pipeline, in particular after the inlining decisions @@ -7702,6 +7702,18 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, gnu_field_type = maybe_pad_type (gnu_field_type, gnu_size, 0, gnat_field, false, definition, true); + /* For a bitfield, if the type still has BLKmode, try again to change it +to an integral mode form. This may be necessary on strict-alignment +platforms with a size clause that is much larger than the field type, +because maybe_pad_type has preserved the alignment of the field type, +which may be too low for the new size. */ + if (!needs_strict_alignment + && RECORD_OR_UNION_TYPE_P (gnu_field_type) + && !TYPE_FAT_POINTER_P (gnu_field_type) + && TYPE_MODE (gnu_field_type) == BLKmode + && is_bitfield) + gnu_field_type = make_packable_type (gnu_field_type, true, 1); + /* If a padding record was made, declare it now since it will never be declared otherwise. This is necessary to ensure that its subtrees are properly marked. */ -- 2.42.0
[COMMITTED] ada: Fix filesystem entry filtering
From: Ronan Desplanques This patch fixes the behavior of Ada.Directories.Search when being requested to filter out regular files or directories. One of the configurations in which that behavior was incorrect was that when the caller requested only the regular and special files but not the directories, the directories would still be returned. gcc/ada/ * libgnat/a-direct.adb: Fix filesystem entry filtering. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnat/a-direct.adb | 30 -- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/gcc/ada/libgnat/a-direct.adb b/gcc/ada/libgnat/a-direct.adb index 4b08d41337d..f7a1d5dfd6d 100644 --- a/gcc/ada/libgnat/a-direct.adb +++ b/gcc/ada/libgnat/a-direct.adb @@ -1414,24 +1414,26 @@ package body Ada.Directories is elsif Exists = 1 then if Is_Regular_File_Attr (Path_C'Address, Attr'Access) = 1 - and then Filter (Ordinary_File) then -Found := True; -Kind := Ordinary_File; -Size := - File_Size -(File_Length_Attr - (-1, Path_C'Address, Attr'Access)); +if Filter (Ordinary_File) then + Found := True; + Kind := Ordinary_File; + Size := + File_Size + (File_Length_Attr + (-1, Path_C'Address, Attr'Access)); +end if; elsif Is_Directory_Attr (Path_C'Address, Attr'Access) = 1 - and then Filter (File_Kind'First) then -Found := True; -Kind := File_Kind'First; --- File_Kind'First is used instead of Directory due --- to a name overload issue with the procedure --- parameter Directory. -Size := 0; +if Filter (File_Kind'First) then + Found := True; + Kind := File_Kind'First; + -- File_Kind'First is used instead of Directory due + -- to a name overload issue with the procedure + -- parameter Directory. + Size := 0; +end if; elsif Filter (Special_File) then Found := True; -- 2.42.0
[COMMITTED] ada: Simplify "not Present" with "No"
From: Piotr Trojanek gcc/ada/ * exp_aggr.adb (Expand_Container_Aggregate): Simplify with "No". Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_aggr.adb | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index e5f36326600..340c8c68465 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -7288,7 +7288,7 @@ package body Exp_Aggr is -- Iterated component association. Discard -- positional insertion procedure. - if not Present (Iterator_Specification (Comp)) then + if No (Iterator_Specification (Comp)) then Add_Named_Subp := Assign_Indexed_Subp; Add_Unnamed_Subp := Empty; end if; -- 2.42.0
[COMMITTED] ada: Seize opportunity to reuse List_Length
From: Ronan Desplanques This patch is intended as a readability improvement. It doesn't change the behavior of the compiler. gcc/ada/ * sem_ch3.adb (Constrain_Array): Replace manual list length computation by call to List_Length. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_ch3.adb | 8 +--- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index c79d323395f..e92b46fa6f6 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -13809,7 +13809,7 @@ package body Sem_Ch3 is Suffix : Character) is C : constant Node_Id := Constraint (SI); - Number_Of_Constraints : Nat := 0; + Number_Of_Constraints : constant Nat := List_Length (Constraints (C)); Index : Node_Id; S, T : Entity_Id; Constraint_OK : Boolean := True; @@ -13835,12 +13835,6 @@ package body Sem_Ch3 is Constraint_OK := False; else - S := First (Constraints (C)); - while Present (S) loop -Number_Of_Constraints := Number_Of_Constraints + 1; -Next (S); - end loop; - -- In either case, the index constraint must provide a discrete -- range for each index of the array type and the type of each -- discrete range must be the same as that of the corresponding -- 2.42.0
[COMMITTED] ada: Document gnatbind -Q switch
From: Patrick Bernardi
Add documentation for the -Q gnatbind switch in GNAT User's Guide and
improve gnatbind's help output for the switch to emphasize that it adds the
requested number of stacks to the secondary stack pool generated by the
binder.
gcc/ada/
* bindusg.adb (Display): Make it clear -Q adds to the number of
secondary stacks generated by the binder.
* doc/gnat_ugn/building_executable_programs_with_gnat.rst:
Document the -Q gnatbind switch and fix references to old
runtimes.
* gnat-style.texi: Regenerate.
* gnat_rm.texi: Regenerate.
* gnat_ugn.texi: Regenerate.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/bindusg.adb | 2 +-
...building_executable_programs_with_gnat.rst | 29 ++---
gcc/ada/gnat-style.texi | 4 +-
gcc/ada/gnat_rm.texi | 4 +-
gcc/ada/gnat_ugn.texi | 41 ++-
5 files changed, 59 insertions(+), 21 deletions(-)
diff --git a/gcc/ada/bindusg.adb b/gcc/ada/bindusg.adb
index fca425b2244..89a6caedf31 100644
--- a/gcc/ada/bindusg.adb
+++ b/gcc/ada/bindusg.adb
@@ -234,7 +234,7 @@ package body Bindusg is
-- Line for Q switch
Write_Line
-(" -Qnnn Generate nnn default-sized secondary stacks");
+(" -Qnnn Generate nnn additional default-sized secondary stacks");
-- Line for -r switch
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 6e80163d6d4..a708ef4b995 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
@@ -6524,12 +6524,12 @@ be presented in subsequent sections.
determines the initial size of the secondary stack for each task and the
smallest amount the secondary stack can grow by.
- For Ravenscar, ZFP, and Cert run-times the size of the secondary stack is
- fixed. This switch can be used to change the default size of these stacks.
- The default secondary stack size can be overridden on a per-task basis if
- individual tasks have different secondary stack requirements. This is
- achieved through the Secondary_Stack_Size aspect that takes the size of the
- secondary stack in bytes.
+ For Light, Light-Tasking, and Embedded run-times the size of the secondary
+ stack is fixed. This switch can be used to change the default size of these
+ stacks. The default secondary stack size can be overridden on a per-task
+ basis if individual tasks have different secondary stack requirements. This
+ is achieved through the Secondary_Stack_Size aspect, which takes the size of
+ the secondary stack in bytes.
.. index:: -e (gnatbind)
@@ -6739,6 +6739,23 @@ be presented in subsequent sections.
Generate binder file suitable for CodePeer.
+.. index:: -Q (gnatbind)
+
+:switch:`-Q{nnn}`
+ Generate ``nnn`` additional default-sized secondary stacks.
+
+ Tasks declared at the library level that use default-size secondary stacks
+ have their secondary stacks allocated from a pool of stacks generated by
+ gnatbind. This allows the default secondary stack size to be quickly changed
+ by rebinding the application.
+
+ While the binder sizes this pool to match the number of such tasks defined in
+ the application, the pool size may need to be increased with the :switch:`-Q`
+ switch to accommodate foreign threads registered with the Light run-time. For
+ more information, please see the *The Primary and Secondary Stack* chapter in
+ the *GNAT User’s Guide Supplement for Cross Platforms*.
+
+
.. index:: -R (gnatbind)
:switch:`-R`
diff --git a/gcc/ada/gnat-style.texi b/gcc/ada/gnat-style.texi
index bcdc160..33bb1886985 100644
--- a/gcc/ada/gnat-style.texi
+++ b/gcc/ada/gnat-style.texi
@@ -3,7 +3,7 @@
@setfilename gnat-style.info
@documentencoding UTF-8
@ifinfo
-@*Generated by Sphinx 5.2.3.@*
+@*Generated by Sphinx 7.2.6.@*
@end ifinfo
@settitle GNAT Coding Style A Guide for GNAT Developers
@defindex ge
@@ -19,7 +19,7 @@
@copying
@quotation
-GNAT Coding Style: A Guide for GNAT Developers , May 09, 2023
+GNAT Coding Style: A Guide for GNAT Developers , Oct 16, 2023
AdaCore
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index b7e098331e9..9a6a0170ae8 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -3,7 +3,7 @@
@setfilename gnat_rm.info
@documentencoding UTF-8
@ifinfo
-@*Generated by Sphinx 5.2.3.@*
+@*Generated by Sphinx 7.2.6.@*
@end ifinfo
@settitle GNAT Reference Manual
@defindex ge
@@ -19,7 +19,7 @@
@copying
@quotation
-GNAT Reference Manual , Jul 17, 2023
+GNAT Reference Manual , Oct 16, 2023
AdaCore
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 1562bee1f64..897153bcfc7 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -
[COMMITTED] ada: Add pragma Annotate for GNATcheck exemptions
From: Sheri Bernstein Exempt the GNATcheck rule "Unassigned_OUT_Parameters" with the rationale "the OUT parameter is assigned by component". gcc/ada/ * libgnat/s-imguti.adb (Set_Decimal_Digits): Add pragma to exempt Unassigned_OUT_Parameters. (Set_Floating_Invalid_Value): Likewise Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnat/s-imguti.adb | 8 1 file changed, 8 insertions(+) diff --git a/gcc/ada/libgnat/s-imguti.adb b/gcc/ada/libgnat/s-imguti.adb index 4b9e27a7d8f..cb081108950 100644 --- a/gcc/ada/libgnat/s-imguti.adb +++ b/gcc/ada/libgnat/s-imguti.adb @@ -37,6 +37,8 @@ package body System.Img_Util is -- Set_Decimal_Digits -- + pragma Annotate (Gnatcheck, Exempt_On, "Unassigned_OUT_Parameters", +"the OUT parameter is assigned by component"); procedure Set_Decimal_Digits (Digs : in out String; NDigs : Natural; @@ -47,6 +49,8 @@ package body System.Img_Util is Aft : Natural; Exp : Natural) is + pragma Annotate (Gnatcheck, Exempt_Off, "Unassigned_OUT_Parameters"); + pragma Assert (NDigs >= 1); pragma Assert (Digs'First = 1); pragma Assert (Digs'First < Digs'Last); @@ -413,6 +417,8 @@ package body System.Img_Util is -- Set_Floating_Invalid_Value -- + pragma Annotate (Gnatcheck, Exempt_On, "Unassigned_OUT_Parameters", +"the OUT parameter is assigned by component"); procedure Set_Floating_Invalid_Value (V: Floating_Invalid_Value; S: out String; @@ -421,6 +427,8 @@ package body System.Img_Util is Aft : Natural; Exp : Natural) is + pragma Annotate (Gnatcheck, Exempt_Off, "Unassigned_OUT_Parameters"); + procedure Set (C : Character); -- Sets character C in output buffer -- 2.42.0
[COMMITTED] ada: Refactor code to remove GNATcheck violation
From: Sheri Bernstein Rewrite for loop containing an exit (which violates GNATcheck rule Exits_From_Conditional_Loops), to use a while loop which contains the exit criteria in its condition. Also, move special case of first time through loop, to come before loop. gcc/ada/ * libgnat/s-imagef.adb (Set_Image_Fixed): Refactor loop. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnat/s-imagef.adb | 75 +++- 1 file changed, 40 insertions(+), 35 deletions(-) diff --git a/gcc/ada/libgnat/s-imagef.adb b/gcc/ada/libgnat/s-imagef.adb index 3f6bfa20cb2..6194a3163de 100644 --- a/gcc/ada/libgnat/s-imagef.adb +++ b/gcc/ada/libgnat/s-imagef.adb @@ -307,6 +307,9 @@ package body System.Image_F is YY : Int := Y; -- First two operands of the scaled divide + J : Natural; + -- Loop index + begin -- Set the first character like Image @@ -317,59 +320,61 @@ package body System.Image_F is Ndigs := 0; end if; - for J in 1 .. N loop - exit when XX = 0; + -- First round of scaled divide + if XX /= 0 then Scaled_Divide (XX, YY, Z, Q, R => XX, Round => False); + if Q /= 0 then +Set_Image_Integer (Q, Digs, Ndigs); + end if; - if J = 1 then -if Q /= 0 then - Set_Image_Integer (Q, Digs, Ndigs); -end if; - -Scale := Scale + D; + Scale := Scale + D; --- Prepare for next round, if any + -- Prepare for next round, if any -YY := 10**Maxdigs; + YY := 10**Maxdigs; + end if; - else -pragma Assert (-10**Maxdigs < Q and then Q < 10**Maxdigs); + J := 2; + while J <= N and then XX /= 0 loop + Scaled_Divide (XX, YY, Z, Q, R => XX, Round => False); -Len := 0; -Set_Image_Integer (abs Q, Buf, Len); + pragma Assert (-10**Maxdigs < Q and then Q < 10**Maxdigs); -pragma Assert (1 <= Len and then Len <= Maxdigs); + Len := 0; + Set_Image_Integer (abs Q, Buf, Len); --- If no character but the space has been written, write the --- minus if need be, since Set_Image_Integer did not do it. + pragma Assert (1 <= Len and then Len <= Maxdigs); -if Ndigs <= 1 then - if Q /= 0 then - if Ndigs = 0 then - Digs (1) := '-'; - end if; + -- If no character but the space has been written, write the + -- minus if need be, since Set_Image_Integer did not do it. - Digs (2 .. Len + 1) := Buf (1 .. Len); - Ndigs := Len + 1; + if Ndigs <= 1 then +if Q /= 0 then + if Ndigs = 0 then + Digs (1) := '-'; end if; --- Or else pad the output with zeroes up to Maxdigs + Digs (2 .. Len + 1) := Buf (1 .. Len); + Ndigs := Len + 1; +end if; -else - for K in 1 .. Maxdigs - Len loop - Digs (Ndigs + K) := '0'; - end loop; + -- Or else pad the output with zeroes up to Maxdigs - for K in 1 .. Len loop - Digs (Ndigs + Maxdigs - Len + K) := Buf (K); - end loop; + else +for K in 1 .. Maxdigs - Len loop + Digs (Ndigs + K) := '0'; +end loop; - Ndigs := Ndigs + Maxdigs; -end if; +for K in 1 .. Len loop + Digs (Ndigs + Maxdigs - Len + K) := Buf (K); +end loop; -Scale := Scale + Maxdigs; +Ndigs := Ndigs + Maxdigs; end if; + + Scale := Scale + Maxdigs; + J := J + 1; end loop; -- If no digit was output, this is zero -- 2.42.0
[PATCH] testsuite: skip gcc.target/i386/pr106910-1.c test when using newlib
Using newlib produces a different codegen because the support for c99
differs (see libc_has_function hook).
gcc/testsuite/ChangeLog:
* gcc.target/i386/pr106910-1.c: Disable for newlib.
---
Tested on x86_64-linux and x86_64-elf.
OK for master?
gcc/testsuite/gcc.target/i386/pr106910-1.c | 2 ++
1 file changed, 2 insertions(+)
diff --git a/gcc/testsuite/gcc.target/i386/pr106910-1.c
b/gcc/testsuite/gcc.target/i386/pr106910-1.c
index c7685a32183..00c93f444b6 100644
--- a/gcc/testsuite/gcc.target/i386/pr106910-1.c
+++ b/gcc/testsuite/gcc.target/i386/pr106910-1.c
@@ -1,4 +1,6 @@
+
/* { dg-do compile { target { ! ia32 } } } */
+/* { dg-skip-if "newlib libc math causes different codegen" { newlib } } */
/* { dg-options "-msse4.1 -O2 -Ofast" } */
/* { dg-final { scan-assembler-times "roundps" 9 } } */
/* { dg-final { scan-assembler-times "cvtps2dq" 1 } } */
--
2.42.0
[PATCH] testsuite: require avx_runtime for some tests
These 3 tests fails parsing the 'vect' dump when not using -mavx. Make
the dependency explicit.
gcc/testsuite/ChangeLog:
* gcc.dg/vect/vect-ifcvt-18.c: Add dep on avx_runtime.
* gcc.dg/vect/vect-simd-clone-16f.c: Likewise.
* gcc.dg/vect/vect-simd-clone-18f.c: Likewise.
---
Tested on x86_64-linux and x86_64-elf.
Ok for master?
gcc/testsuite/gcc.dg/vect/vect-ifcvt-18.c | 3 ++-
gcc/testsuite/gcc.dg/vect/vect-simd-clone-16f.c | 4 ++--
gcc/testsuite/gcc.dg/vect/vect-simd-clone-18f.c | 4 ++--
3 files changed, 6 insertions(+), 5 deletions(-)
diff --git a/gcc/testsuite/gcc.dg/vect/vect-ifcvt-18.c
b/gcc/testsuite/gcc.dg/vect/vect-ifcvt-18.c
index c1d3c27d819..607194496e9 100644
--- a/gcc/testsuite/gcc.dg/vect/vect-ifcvt-18.c
+++ b/gcc/testsuite/gcc.dg/vect/vect-ifcvt-18.c
@@ -1,6 +1,7 @@
/* { dg-require-effective-target vect_condition } */
/* { dg-require-effective-target vect_float } */
-/* { dg-additional-options "-Ofast -mavx" { target avx_runtime } } */
+/* { dg-require-effective-target avx_runtime } */
+/* { dg-additional-options "-Ofast -mavx" } */
int A0[4] = {36,39,42,45};
diff --git a/gcc/testsuite/gcc.dg/vect/vect-simd-clone-16f.c
b/gcc/testsuite/gcc.dg/vect/vect-simd-clone-16f.c
index 7cd29e894d0..c6615dc626d 100644
--- a/gcc/testsuite/gcc.dg/vect/vect-simd-clone-16f.c
+++ b/gcc/testsuite/gcc.dg/vect/vect-simd-clone-16f.c
@@ -1,6 +1,6 @@
/* { dg-require-effective-target vect_simd_clones } */
-/* { dg-additional-options "-fopenmp-simd --param vect-epilogues-nomask=0" } */
-/* { dg-additional-options "-mavx" { target avx_runtime } } */
+/* { dg-additional-options "-fopenmp-simd --param vect-epilogues-nomask=0
-mavx" } */
+/* { dg-require-effective-target avx_runtime } */
/* { dg-additional-options "-mno-avx512f" { target { { i?86*-*-* x86_64-*-* }
&& { ! lp64 } } } } */
#define TYPE __INT64_TYPE__
diff --git a/gcc/testsuite/gcc.dg/vect/vect-simd-clone-18f.c
b/gcc/testsuite/gcc.dg/vect/vect-simd-clone-18f.c
index 4dd51381d73..787b918d0c4 100644
--- a/gcc/testsuite/gcc.dg/vect/vect-simd-clone-18f.c
+++ b/gcc/testsuite/gcc.dg/vect/vect-simd-clone-18f.c
@@ -1,6 +1,6 @@
/* { dg-require-effective-target vect_simd_clones } */
-/* { dg-additional-options "-fopenmp-simd --param vect-epilogues-nomask=0" } */
-/* { dg-additional-options "-mavx" { target avx_runtime } } */
+/* { dg-additional-options "-fopenmp-simd --param vect-epilogues-nomask=0
-mavx" } */
+/* { dg-require-effective-target avx_runtime } */
/* { dg-additional-options "-mno-avx512f" { target { { i?86*-*-* x86_64-*-* }
&& { ! lp64 } } } } */
#define TYPE __INT64_TYPE__
--
2.42.0
[PATCH] testsuite: refine gcc.dg/analyzer/fd-4.c test for newlib
Contrary to glibc, including stdio.h from newlib defines mode_t which
conflicts with the test's type definition.
.../gcc/testsuite/gcc.dg/analyzer/fd-4.c:19:3: error: redefinition of typedef
'mode_t' with different type
...
.../include/sys/types.h:189:25: note: previous declaration of 'mode_t' with
type 'mode_t' {aka 'unsigned int'}
Defining _MODE_T_DECLARED skips the type definition.
gcc/testsuite/ChangeLog:
* gcc.dg/analyzer/fd-4.c: Fix for newlib.
---
Tested on x86_64-linux and x86_64-elf.
Ok for master?
gcc/testsuite/gcc.dg/analyzer/fd-4.c | 1 +
1 file changed, 1 insertion(+)
diff --git a/gcc/testsuite/gcc.dg/analyzer/fd-4.c
b/gcc/testsuite/gcc.dg/analyzer/fd-4.c
index 994bad84342..e4a834ade30 100644
--- a/gcc/testsuite/gcc.dg/analyzer/fd-4.c
+++ b/gcc/testsuite/gcc.dg/analyzer/fd-4.c
@@ -1,3 +1,4 @@
+/* { dg-additional-options "-D_MODE_T_DECLARED=1" { target newlib } } */
#ifdef _AIX
#define _MODE_T
#endif
--
2.42.0
Re: [wwwdocs] Add Ada's GCC 14 changelog entry
Fernando Oleo Blanco writes: > Dear all, > > just like last year, I would like to commit the changes that took place > over at GNAT for GCC v14. The patch is attached to the email. Hopefully > it is good enough to just be added to master. If you see something wrong > or if you would like to add anything to it, feel free :) Feedback is > always welcomed. Fernando, Thank you for this work! I have a few comments, see below. diff --git a/htdocs/gcc-14/changes.html b/htdocs/gcc-14/changes.html index 85ccc54d..e6c96c9f 100644 --- a/htdocs/gcc-14/changes.html +++ b/htdocs/gcc-14/changes.html @@ -171,7 +171,49 @@ a work-in-progress. New Languages and Language specific improvements - +Ada + + + Several new aspects and contracts have been implemented: Maybe worth noting that these are implementation defined aspects. + + Exceptional_Cases may be specified for procedures and + functions with side effects; it can be used to list exceptions that might + be propagated by the subprogram with side effects in the context of its + precondition, and associate them with a specific postcondition. For more + information, refer to SPARK 2014 Reference Manual, section 6.1.9. + User_Aspect takes an argument that is the name of an + aspect defined by a User_Aspect_Definition configuration pragma. + Local_Restrictions is used to specify that a particular + subprogram does not violate one or more local restrictions, nor can it + call a subprogram that is not subject to the same requirements. + Side_Effects is equivalent to pragma + Side_Effecs. + Always_Terminates is a boolean equivalent to pragma + Always_Terminates + Ghost_Predicate It looks like Ghost_Predicate is missing some text here. It may be a good thing to link to the actual documentation for these options. Thanks to some documention changes, we can now link to an option directly. For example: https://gcc.gnu.org/onlinedocs/gnat_rm/Implementation-Defined-Pragmas.html You would need to point to the correct version (this one points to current devel version). + + + The new attributes and contracts have been applied to the relevant parts +of the Ada library and more code has been proven to be correct. + Initial support for the + https://www.cl.cam.ac.uk/research/security/ctsrd/cheri/";>CHERI + architecture. + Support for the LoongArch architecture. + Hardening improvements: + + Use of the new -fharden* options. Most + notably -fharden-compares, + -fharden-conditional-branches and + -fharden-control-flow-redundancy. + Custom bools with higher Hamming distance. + The strub attribute has been added for functions and Same as above for doc links: https://gcc.gnu.org/onlinedocs/gcc/Instrumentation-Options.html#index-fharden-compares + variables in order to automatically zero-out their stack upon use or + return. + + + Further clean up and improvements to the GNAT code. + Support for vxWorks 7 Cert RTP has been removed. +
[COMMITTED] Update year in Gnatvsn
From: Ronan Desplanques gcc/ada/ * gnatvsn.ads: Update year. --- gcc/ada/gnatvsn.ads | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gcc/ada/gnatvsn.ads b/gcc/ada/gnatvsn.ads index 934c22206f7..29238362cc0 100644 --- a/gcc/ada/gnatvsn.ads +++ b/gcc/ada/gnatvsn.ads @@ -39,7 +39,7 @@ package Gnatvsn is -- Note: Makefile.in uses the library version string to construct the -- soname value. - Current_Year : constant String := "2023"; + Current_Year : constant String := "2024"; -- Used in printing copyright messages Verbose_Library_Version : constant String := "GNAT Lib v" & Library_Version; -- 2.43.0
[COMMITTED] ada: Further cleanup in finalization machinery
From: Eric Botcazou This streamlines the submachinery that makes it so that the finalization of temporaries created for EWAs and conditional expressions is deferred to the enclosing context. The original implementation was using a deep tree traversal for EWAs, which was later restricted to immediate subexpressions; this further flattens it to the traversal of the immediate list of actions of the EWA in keeping with the implementation for conditional expressions. This should not change anything because the enclosing context found by the machinery is the same, whatever the starting position in a nest of EWAs or conditional expressions. gcc/ada/ * exp_ch4.adb (Process_If_Case_Statements): Rename into... (Process_Transients_In_Expression): ...this and beef up comment. (Expand_N_Case_Expression): Call Process_Transients_In_Expression unconditionally on the list of actions of each alternative. (Expand_N_Expression_With_Actions): Do not deal with actions in nested subexpressions, but call Process_Transients_In_Expression on the list of actions only. (Expand_N_If_Expression): Adjust to above renaming. Add missing calls to Process_Transients_In_Expression in the case when an EWA is not used because of Minimize_Expression_With_Actions. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_ch4.adb | 154 +++- 1 file changed, 66 insertions(+), 88 deletions(-) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 99be96d3ab7..8f4cf0808dc 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -241,11 +241,6 @@ package body Exp_Ch4 is -- and X is a simple entity, and op is a comparison operator, optimizes it -- into a comparison of X'First and X'Last. - procedure Process_If_Case_Statements (N : Node_Id; Stmts : List_Id); - -- Inspect and process statement list Stmt of if or case expression N for - -- transient objects. If such objects are found, the routine generates code - -- to clean them up when the context of the expression is evaluated. - procedure Process_Transient_In_Expression (Obj_Decl : Node_Id; Expr : Node_Id; @@ -255,9 +250,25 @@ package body Exp_Ch4 is -- object when the enclosing context is elaborated or evaluated. Obj_Decl -- denotes the declaration of the transient object, which is usually the -- result of a controlled function call. Expr denotes the expression with - -- actions, if expression, or case expression node. Stmts denotes the - -- statement list which contains Decl, either at the top level or within a - -- nested construct. + -- actions, if expression, or case expression node. Stmts denotes one of + -- the actions list of Expr, which contains Decl. + + procedure Process_Transients_In_Expression + (Expr : Node_Id; + Stmts : List_Id); + -- Subsidiary routine to the expansion of expression_with_actions, if and + -- case expressions. Inspect and process actions list Stmts of expression + -- Expr for transient objects. If such objects are found, the routine will + -- generate code to finalize them when the enclosing context is elaborated + -- or evaluated. + + -- This specific processing is required for these expressions because the + -- management of transient objects for expressions implemented in Exp_Ch7 + -- cannot deal with nested lists of actions whose effects may outlive the + -- lists and affect the result of the parent expressions. In these cases, + -- the lifetime of temporaries created in these lists must be extended to + -- match that of the enclosing context of the parent expressions and, in + -- particular, their finalization must be deferred to this context. procedure Rewrite_Comparison (N : Node_Id); -- If N is the node for a comparison whose outcome can be determined at @@ -5411,14 +5422,10 @@ package body Exp_Ch4 is Statements => Stmts)); -- Finalize any transient objects on exit from the alternative. --- This needs to be done only when the case expression is _not_ --- later converted into an expression with actions, which already --- contains this form of processing, and after Stmts is attached +-- Note that this needs to be done only after Stmts is attached -- to the Alternatives list above (for Safe_To_Capture_Value). -if Optimize_Return_Stmt or else not Is_Copy_Type (Typ) then - Process_If_Case_Statements (N, Stmts); -end if; +Process_Transients_In_Expression (N, Stmts); end; Next (Alt); @@ -5482,12 +5489,6 @@ package body Exp_Ch4 is procedure Force_Boolean_Evaluation (Expr : Node_Id); -- Force the evaluation of Boolean expression Expr - function Process_Action (Act : Node_Id) return Traverse_
[COMMITTED] ada: Illegal instance of Generic_1.Generic_2 incorrectly accepted
From: Steve Baird
If G1 is a generic package and G1.G2 is a child unit (also a generic package)
then it would be illegal if some third generic unit (declared outside of G1)
takes a formal instance of G1.G2, as in "with package I2 is new G1.G2;".
This construct was incorrectly accepted in some cases.
gcc/ada/
* sem_ch12.adb (Check_Generic_Child_Unit): Introduce a new nested
function Adjusted_Inst_Par_Ekind to cope with cases where either
a- the visibility of a compiler-generated renaming is incorrect;
or b- we are inside of a generic parent unit G1 that has a child
unit G1.G2, so instantiation of G1.G2 is permitted.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_ch12.adb | 96 +++-
1 file changed, 85 insertions(+), 11 deletions(-)
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 5db9754f81d..e229d217555 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -7234,7 +7234,7 @@ package body Sem_Ch12 is
Loc : constant Source_Ptr := Sloc (Gen_Id);
Gen_Par : Entity_Id := Empty;
E: Entity_Id;
- Inst_Par : Entity_Id;
+ Inst_Par : Entity_Id := Empty;
S: Node_Id;
function Find_Generic_Child
@@ -7440,16 +7440,90 @@ package body Sem_Ch12 is
-- the instance of Gpar, so this is illegal. The test below
-- recognizes this particular case.
- if Is_Child_Unit (E)
- and then not Comes_From_Source (Entity (Prefix (Gen_Id)))
- and then (not In_Instance
-or else Nkind (Parent (Parent (Gen_Id))) =
- N_Compilation_Unit)
- then
- Error_Msg_N
-("prefix of generic child unit must be instance of parent",
- Gen_Id);
- end if;
+ declare
+ -- We want to reject the final instantiation in
+ --generic package G1 is end G1;
+ --generic package G1.G2 is end G1.G2;
+ --with G1; package I1 is new G1;
+ --with G1.G2; package I1.I2 is new G1.G2;
+ -- because the use of G1.G2 should instead be either
+ -- I1.G2 or simply G2. However, the tree that is built
+ -- in this case is wrong. In the expanded copy
+ -- of G2, we need (and therefore generate) a renaming
+ --package G1 renames I1;
+ -- but this renaming should not participate in resolving
+ -- this occurrence of the name "G1.G2"; unfortunately,
+ -- it does. Rather than correct this error, we compensate
+ -- for it in this function.
+ --
+ -- We also perform another adjustment here. If we are
+ -- currently inside a generic package, then that
+ -- generic package needs to be treated as a package.
+ -- For example, if a generic Aaa declares a nested generic
+ -- Bbb (perhaps as a child unit) then Aaa can also legally
+ -- declare an instance of Aaa.Bbb.
+
+ function Adjusted_Inst_Par_Ekind return Entity_Kind;
+
+ -
+ -- Adjusted_Inst_Par_Ekind --
+ -
+
+ function Adjusted_Inst_Par_Ekind return Entity_Kind is
+ Prefix_Entity : Entity_Id;
+ Inst_Par_GP : Node_Id;
+ Inst_Par_Parent : Node_Id := Parent (Inst_Par);
+ begin
+ if Nkind (Inst_Par_Parent) = N_Defining_Program_Unit_Name
+ then
+Inst_Par_Parent := Parent (Inst_Par_Parent);
+ end if;
+
+ Inst_Par_GP := Generic_Parent (Inst_Par_Parent);
+
+ if Nkind (Gen_Id) = N_Expanded_Name
+ and then Present (Inst_Par_GP)
+ and then Ekind (Inst_Par_GP) = E_Generic_Package
+ then
+Prefix_Entity := Entity (Prefix (Gen_Id));
+
+if Present (Prefix_Entity)
+ and then not Comes_From_Source (Prefix_Entity)
+ and then Nkind (Parent (Prefix_Entity)) =
+ N_Package_Renaming_Declaration
+ and then Chars (Prefix_Entity) = Chars (Inst_Par_GP)
+then
+ return E_Generic_Package;
+end if;
+ end if;
+
+ if Ekind (Inst_Par) = E_Generic_Package
+
[COMMITTED] ada: Cleanup SPARK legality checking
From: Yannick Moy
Move one SPARK legality check from GNAT to GNATprove, and cleanup
other uses of SPARK_Mode for legality checking.
gcc/ada/
* sem_ch4.adb (Analyze_Selected_Component): Check correct mode
variable for GNATprove.
* sem_prag.adb (Refined_State): Call SPARK_Msg_NE which checks
value of SPARK_Mode before issuing a message.
* sem_res.adb (Resolve_Entity_Name): Remove legality check for
SPARK RM 6.1.9(1), moved to GNATprove.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_ch4.adb | 10 ++---
gcc/ada/sem_prag.adb | 12 +++---
gcc/ada/sem_res.adb | 100 ---
3 files changed, 10 insertions(+), 112 deletions(-)
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index d506944bc8d..64aa9a84e60 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -6025,17 +6025,17 @@ package body Sem_Ch4 is
-- Emit appropriate message. The node will be replaced
-- by an appropriate raise statement.
- -- Note that in SPARK mode, as with all calls to apply a
- -- compile time constraint error, this will be made into
- -- an error to simplify the processing of the formal
- -- verification backend.
+ -- Note that in GNATprove mode, as with all calls to
+ -- apply a compile time constraint error, this will be
+ -- made into an error to simplify the processing of the
+ -- formal verification backend.
Apply_Compile_Time_Constraint_Error
(N, "component not present in }??",
CE_Discriminant_Check_Failed,
Ent => Prefix_Type,
Emit_Message =>
- SPARK_Mode = On or not In_Instance_Not_Visible);
+ GNATprove_Mode or not In_Instance_Not_Visible);
return;
end if;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 9d66fb71a06..db20f20b9f1 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -23375,15 +23375,13 @@ package body Sem_Prag is
Analyze_If_Present (Pragma_SPARK_Mode);
-- State refinement is allowed only when the corresponding package
--- declaration has non-null pragma Abstract_State. Refinement not
--- enforced when SPARK checks are suppressed (SPARK RM 7.2.2(3)).
+-- declaration has non-null pragma Abstract_State (SPARK RM
+-- 7.2.2(3)).
-if SPARK_Mode /= Off
- and then
-(No (Abstract_States (Spec_Id))
- or else Has_Null_Abstract_State (Spec_Id))
+if No (Abstract_States (Spec_Id))
+ or else Has_Null_Abstract_State (Spec_Id)
then
- Error_Msg_NE
+ SPARK_Msg_NE
("useless refinement, package & does not define abstract "
& "states", N, Spec_Id);
return;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index c684075219b..d81a5af9032 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -7787,14 +7787,6 @@ package body Sem_Res is
-- Determine whether Expr is part of an N_Attribute_Reference
-- expression.
- function In_Attribute_Old (Expr : Node_Id) return Boolean;
- -- Determine whether Expr is in attribute Old
-
- function Within_Exceptional_Cases_Consequence
-(Expr : Node_Id)
- return Boolean;
- -- Determine whether Expr is part of an Exceptional_Cases consequence
-
-- Is_Assignment_Or_Object_Expression --
@@ -7836,31 +7828,6 @@ package body Sem_Res is
end if;
end Is_Assignment_Or_Object_Expression;
- --
- -- In_Attribute_Old --
- --
-
- function In_Attribute_Old (Expr : Node_Id) return Boolean is
- N : Node_Id := Expr;
- begin
- while Present (N) loop
-if Nkind (N) = N_Attribute_Reference
- and then Attribute_Name (N) = Name_Old
-then
- return True;
-
--- Prevent the search from going too far
-
-elsif Is_Body_Or_Package_Declaration (N) then
- return False;
-end if;
-
-N := Parent (N);
- end loop;
-
- return False;
- end In_Attribute_Old;
-
-
-- Is_Attribute_Expression --
-
@@ -7884,39 +7851,6 @@ package body Sem_Res is
return False;
end Is_Attribute_Expression;
- --
[COMMITTED] ada: Restore object constraint optimization
From: Ronan Desplanques This patch relaxes the requirement that discriminants values should be known at compile time for a particular optimization to be applied. That optimization is the one that treats an unconstrained object as constrained when the object is of a limited type, in order to reduce the size of the object. What makes it possible to relax this requirement is that the set of cases where the optimization is applied was narrowed in a previous patch. gcc/ada/ * sem_util.adb (Build_Default_Subtype_OK): Relax known-at-compile-time requirement. * sem_util.ads (Build_Default_Subtype_OK): Bring documentation comment up-to-date. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_util.adb | 57 gcc/ada/sem_util.ads | 11 - 2 files changed, 5 insertions(+), 63 deletions(-) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 909f93da040..2a31a11f9a2 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -1813,51 +1813,6 @@ package body Sem_Util is -- function Build_Default_Subtype_OK (T : Entity_Id) return Boolean is - - function Default_Discriminant_Values_Known_At_Compile_Time - (T : Entity_Id) return Boolean; - -- For an unconstrained type T, return False if the given type has a - -- discriminant with default value not known at compile time. Return - -- True otherwise. - - - - -- Default_Discriminant_Values_Known_At_Compile_Time -- - - - - function Default_Discriminant_Values_Known_At_Compile_Time - (T : Entity_Id) return Boolean - is - Discr : Entity_Id; - DDV : Node_Id; - - begin - - -- If the type has no discriminant, we know them all at compile time - - if not Has_Discriminants (T) then -return True; - end if; - - -- The type has discriminants, check that none of them has a default - -- value not known at compile time. - - Discr := First_Discriminant (T); - - while Present (Discr) loop -DDV := Discriminant_Default_Value (Discr); - -if Present (DDV) and then not Compile_Time_Known_Value (DDV) then - return False; -end if; - -Next_Discriminant (Discr); - end loop; - - return True; - end Default_Discriminant_Values_Known_At_Compile_Time; - - -- Start of processing for Build_Default_Subtype_OK - begin if Is_Constrained (T) then @@ -1867,18 +1822,6 @@ package body Sem_Util is return False; end if; - if not Default_Discriminant_Values_Known_At_Compile_Time (T) then - - -- This is a special case of definite subtypes. To allocate a - -- specific size to the subtype, we need to know the value at compile - -- time. This might not be the case if the default value is the - -- result of a function. In that case, the object might be definite - -- and limited but the needed size might not be statically known or - -- too tricky to obtain. In that case, we will not build the subtype. - - return False; - end if; - return Is_Definite_Subtype (T) and then Is_Inherently_Limited_Type (T); end Build_Default_Subtype_OK; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 081217a455a..2dc75a1387f 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -282,14 +282,13 @@ package Sem_Util is -- subtype. Otherwise, simply return T. function Build_Default_Subtype_OK (T : Entity_Id) return Boolean; - -- When analyzing components or object declarations, it is possible, in - -- some cases, to build subtypes for discriminated types. This is - -- worthwhile to avoid the backend allocating the maximum possible size for - -- objects of the type. + -- When analyzing object declarations, it is possible, in some cases, to + -- build subtypes for discriminated types. This is worthwhile to avoid the + -- backend allocating the maximum possible size for objects of the type. -- In particular, when T is limited, the discriminants and therefore the -- size of an object of type T cannot change. Furthermore, if T is definite - -- with statically initialized defaulted discriminants, we are able and - -- want to build a constrained subtype of the right size. + -- with initialized defaulted discriminants, we are able and want to build + -- a constrained subtype of the right size. function Build_Discriminal_Subtype_Of_Component (T : Entity_Id) return Node_Id; -- 2.43.0
[COMMITTED] ada: Plug small loophole in finalization machinery
From: Eric Botcazou The path in Expand_N_If_Expression implementing the special optimization for an unidimensional array type and dependent expressions with static bounds fails to call Process_Transients_In_Expression on their list of actions. gcc/ada/ * exp_ch4.adb (Expand_N_If_Expression): Also add missing calls to Process_Transients_In_Expression on the code path implementing the special optimization for an unidimensional array type and dependent expressions with static bounds. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_ch4.adb | 8 1 file changed, 8 insertions(+) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 8f4cf0808dc..527ca16aac4 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -5912,6 +5912,14 @@ package body Exp_Ch4 is and then not Generate_C_Code and then not Unnest_Subprogram_Mode then + -- When the "then" or "else" expressions involve controlled function + -- calls, generated temporaries are chained on the corresponding list + -- of actions. These temporaries need to be finalized after the if + -- expression is evaluated. + + Process_Transients_In_Expression (N, Then_Actions (N)); + Process_Transients_In_Expression (N, Else_Actions (N)); + declare Ityp : constant Entity_Id := Base_Type (Etype (First_Index (Typ))); -- 2.43.0
[COMMITTED] ada: Adapt Ada.Command_Line to work on configurable runtimes
From: Patrick Bernardi
The behaviour of the binder when handling command line arguments and exit
codes is simplified so that references to the corresponding runtime symbols
are always generated when the runtime is configured with command line
argument and exit code support. This allows Ada.Command_Line to work with
all runtimes, which was not the case previously.
As a result of this change, configurable runtimes that do not include
Ada.Command_Line and it support files, but are configured with
Command_Line_Args and/or Exit_Status_Supported set to True will need to
provide the symbols required by the binder, as these symbols will no longer
be defined in the binder generated file.
argv.c includes a small change to exclude adaint.h when compiling for a
light runtime, since this header is not required.
gcc/ada/
* argv.c: Do not include adaint.h if LIGHT_RUNTIME is defined.
* bindgen.adb (Gen_Main): Simplify command line argument and exit
handling by requiring the runtime to always provide the required
symbols if command line argument and exit code is enabled.
* targparm.ads: Update comments to reflect changes to gnatbind.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/argv.c | 2 ++
gcc/ada/bindgen.adb | 60
gcc/ada/targparm.ads | 20 ---
3 files changed, 28 insertions(+), 54 deletions(-)
diff --git a/gcc/ada/argv.c b/gcc/ada/argv.c
index a773befb8c0..17369a9f3f9 100644
--- a/gcc/ada/argv.c
+++ b/gcc/ada/argv.c
@@ -51,7 +51,9 @@
#include "system.h"
#endif
+#ifndef LIGHT_RUNTIME
#include "adaint.h"
+#endif
#ifdef __cplusplus
extern "C" {
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index 87f162e6b43..03315fe2251 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -2092,12 +2092,14 @@ package body Bindgen is
WBI (" begin");
- -- Acquire command-line arguments if present on target
+ -- Acquire command-line arguments if present and supported on the
+ -- target. Do not acquire command-line arguments if pragma No_Run_Time
+ -- is in effect as the run-time symbols will not be available.
if CodePeer_Mode then
null;
- elsif Command_Line_Args_On_Target then
+ elsif Command_Line_Args_On_Target and then not No_Run_Time_Mode then
-- Initialize gnat_argc/gnat_argv only if not already initialized,
-- to avoid losing the result of any command-line processing done by
@@ -2109,20 +2111,6 @@ package body Bindgen is
WBI (" end if;");
WBI (" gnat_envp := envp;");
WBI ("");
-
- -- If configurable run-time and no command-line args, then nothing needs
- -- to be done since the gnat_argc/argv/envp variables are suppressed in
- -- this case.
-
- elsif Configurable_Run_Time_On_Target then
- null;
-
- -- Otherwise set dummy values (to be filled in by some other unit?)
-
- else
- WBI (" gnat_argc := 0;");
- WBI (" gnat_argv := System.Null_Address;");
- WBI (" gnat_envp := System.Null_Address;");
end if;
if Opt.Default_Exit_Status /= 0
@@ -2199,7 +2187,11 @@ package body Bindgen is
if No_Main_Subprogram
or else ALIs.Table (ALIs.First).Main_Program = Proc
then
-WBI (" return (gnat_exit_status);");
+if No_Run_Time_Mode then
+ WBI (" return (0);");
+else
+ WBI (" return (gnat_exit_status);");
+end if;
else
WBI (" return (Result);");
end if;
@@ -2595,38 +2587,28 @@ package body Bindgen is
if Bind_Main_Program then
-- Generate argc/argv stuff unless suppressed
- if Command_Line_Args_On_Target
- or not Configurable_Run_Time_On_Target
- then
+ -- A run-time configured to support command line arguments defines
+ -- a number of internal symbols that need to be set by the binder.
+
+ if Command_Line_Args_On_Target and then not No_Run_Time_Mode then
WBI ("");
WBI (" gnat_argc : Integer;");
WBI (" gnat_argv : System.Address;");
WBI (" gnat_envp : System.Address;");
--- If the standard library is not suppressed, these variables
--- are in the run-time data area for easy run time access.
-
-if not Suppress_Standard_Library_On_Target then
- WBI ("");
- WBI (" pragma Import (C, gnat_argc);");
- WBI (" pragma Import (C, gnat_argv);");
- WBI (" pragma Import (C, gnat_envp);");
-end if;
+WBI ("");
+WBI (" pragma Import (C, gnat_argc);");
+WBI (" pragma Import (C, gnat_argv);");
+WBI (" pragma Import (C, gnat_envp);");
[COMMITTED] ada: Cope with Sem_Util.Enclosing_Declaration oddness.
From: Steve Baird Sem_Util.Enclosing_Declaration can return a non-empty result which is not a declaration; clients may need to compensate for the case where an N_Subprogram_Specification node is returned. One such client is the function Is_Actual_Subp_Of_Inst. gcc/ada/ * sem_ch8.adb (Is_Actual_Subp_Of_Inst): After calling Enclosing_Declaration, add a check for the case where one more Parent call is needed to get the enclosing declaration. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_ch8.adb | 12 +++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index c5bf0864671..2e6b1b6d785 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -2691,7 +2691,7 @@ package body Sem_Ch8 is -- Each attempt to find a suitable primitive of a particular -- type operates on its own copy of the original renaming. -- As a result the original renaming is kept decoration and - -- side-effect-free. + -- side-effect free. -- Inherit the overloaded status of the renamed subprogram name @@ -6550,6 +6550,16 @@ package body Sem_Ch8 is Decl := Enclosing_Declaration (E); + -- Enclosing_Declaration does not always return a + -- declaration; cope with this irregularity. + if Decl in N_Subprogram_Specification_Id + and then Nkind (Parent (Decl)) in + N_Subprogram_Body | N_Subprogram_Declaration + | N_Subprogram_Renaming_Declaration + then +Decl := Parent (Decl); + end if; + -- Look for the suprogram renaming declaration built -- for a generic actual subprogram. Unclear why -- Original_Node call is needed, but sometimes it is. -- 2.43.0
[COMMITTED] ada: Fix SPARK expansion of container aggregates
From: Yannick Moy GNATprove supports container aggregates, except for indexed aggregates. It needs all expressions to have suitable target types and Do_Range_Check flags, which are added by the special expansion for GNATprove. There is no impact on code generation. gcc/ada/ * exp_spark.adb (Expand_SPARK_N_Aggregate): New procedure for the special expansion. (Expand_SPARK): Call the new expansion procedure. * sem_util.adb (Is_Container_Aggregate): Implement missing test. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_spark.adb | 146 ++ gcc/ada/sem_util.adb | 17 ++--- 2 files changed, 155 insertions(+), 8 deletions(-) diff --git a/gcc/ada/exp_spark.adb b/gcc/ada/exp_spark.adb index ae0e616c797..f77d5f9f829 100644 --- a/gcc/ada/exp_spark.adb +++ b/gcc/ada/exp_spark.adb @@ -23,6 +23,7 @@ -- -- -- +with Aspects;use Aspects; with Atree; use Atree; with Checks; use Checks; with Einfo; use Einfo; @@ -47,6 +48,7 @@ with Sem_Aggr; use Sem_Aggr; with Sem_Aux;use Sem_Aux; with Sem_Ch7;use Sem_Ch7; with Sem_Ch8;use Sem_Ch8; +with Sem_Ch13; use Sem_Ch13; with Sem_Prag; use Sem_Prag; with Sem_Res;use Sem_Res; with Sem_Util; use Sem_Util; @@ -64,6 +66,10 @@ package body Exp_SPARK is -- Local Subprograms -- --- + procedure Expand_SPARK_N_Aggregate (N : Node_Id); + -- Perform specific expansion of container aggregates, to ensure suitable + -- checking of expressions. + procedure Expand_SPARK_N_Attribute_Reference (N : Node_Id); -- Perform attribute-reference-specific expansion @@ -139,6 +145,9 @@ package body Exp_SPARK is when N_Delta_Aggregate => Expand_SPARK_N_Delta_Aggregate (N); + when N_Aggregate => +Expand_SPARK_N_Aggregate (N); + when N_Expanded_Name | N_Identifier => @@ -418,6 +427,143 @@ package body Exp_SPARK is end if; end Expand_SPARK_Delta_Or_Update; + -- + -- Expand_SPARK_N_Aggregate -- + -- + + procedure Expand_SPARK_N_Aggregate (N : Node_Id) is + + -- Local subprograms + + procedure Parse_Named_Subp +(Subp : Subprogram_Kind_Id; + Key_Type : out Type_Kind_Id; + Element_Type : out Type_Kind_Id); + -- Retrieve key and element types from subprogram for named addition + + procedure Parse_Unnamed_Subp +(Subp : Subprogram_Kind_Id; + Element_Type : out Type_Kind_Id); + -- Retrieve element types from subprogram for unnamed addition + + procedure Wrap_For_Checks (Expr : N_Subexpr_Id; Typ : Type_Kind_Id); + -- If Expr might require a range check for conversion to type Typ, set + -- Do_Range_Check on Expr. In all cases, wrap Expr in a type conversion + -- if Typ is not the type of Expr already, for GNATprove to correctly + -- identity the target type for the range check and insert any other + -- checks. + + -- + -- Parse_Named_Subp -- + -- + + procedure Parse_Named_Subp +(Subp : Subprogram_Kind_Id; + Key_Type : out Type_Kind_Id; + Element_Type : out Type_Kind_Id) + is + Formal : Entity_Id := First_Formal (Subp); + begin + Next_Formal (Formal); + Key_Type := Etype (Formal); + Next_Formal (Formal); + Element_Type := Etype (Formal); + end Parse_Named_Subp; + + + -- Parse_Unnamed_Subp -- + + + procedure Parse_Unnamed_Subp +(Subp : Subprogram_Kind_Id; + Element_Type : out Type_Kind_Id) + is + Formal : Entity_Id := First_Formal (Subp); + begin + Next_Formal (Formal); + Element_Type := Etype (Formal); + end Parse_Unnamed_Subp; + + - + -- Wrap_For_Checks -- + - + + procedure Wrap_For_Checks (Expr : N_Subexpr_Id; Typ : Type_Kind_Id) is + begin + if Is_Scalar_Type (Typ) then +Apply_Scalar_Range_Check (Expr, Typ); + end if; + + Convert_To_And_Rewrite (Typ, Expr); + end Wrap_For_Checks; + + -- Local variables + + Typ : constant Entity_Id := Etype (N); + Asp : constant Node_Id := Find_Value_Of_Aspect (Typ, Aspect_Aggregate); + + Empty_Subp : Node_Id := Empty; + Add_Named_Subp : Node_Id := Empty; + Add_Unnamed_Subp: Node_Id := Empty; + New_Indexed_Subp: Node_Id := Empty; + Assign_Indexed_Subp : Node_Id := Empty; +
[COMMITTED] ada: Fix spurious visibility error on parent's component in instance
From: Eric Botcazou
This occurs for an aggregate of a derived tagged type in the body of the
instance, because the full view of the parent type, which was visible in
the generic construct (otherwise the aggregate would have been illegal),
is not restored in the body of the instance.
Copy_Generic_Node already contains code to restore the full view in this
case, but it works only if the derived tagged type is itself global to
the generic construct, and not if the derived tagged type is local but
the parent type global, as is the case here.
gcc/ada/
* gen_il-fields.ads (Aggregate_Bounds): Rename to
Aggregate_Bounds_Or_Ancestor_Type.
* gen_il-gen-gen_nodes.adb (Aggregate_Bounds): Likewise.
* sem_aggr.adb (Resolve_Record_Aggregate): Remove obsolete bypass.
* sem_ch12.adb (Check_Generic_Actuals): Add decoration.
(Copy_Generic_Node): For an extension aggregate, restore only the
full view, if any. For a full aggregate, restore the full view as
well as that of its Ancestor_Type, if any, and up to the root type.
(Save_References_In_Aggregate): For a full aggregate of a local
derived tagged type with a global ancestor, set Ancestor_Type to
this ancestor. For a full aggregate of a global derived tagged
type, set Ancestor_Type to the parent type.
* sinfo-utils.ads (Aggregate_Bounds): New function renaming.
(Ancestor_Type): Likewise.
(Set_Aggregate_Bounds): New procedure renaming.
(Set_Ancestor_Type): Likewise.
* sinfo.ads (Ancestor_Type): Document new field.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/gen_il-fields.ads| 2 +-
gcc/ada/gen_il-gen-gen_nodes.adb | 2 +-
gcc/ada/sem_aggr.adb | 8 +--
gcc/ada/sem_ch12.adb | 107 +++
gcc/ada/sinfo-utils.ads | 16 +
gcc/ada/sinfo.ads| 7 +-
6 files changed, 107 insertions(+), 35 deletions(-)
diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads
index c565e19701d..632ce489b08 100644
--- a/gcc/ada/gen_il-fields.ads
+++ b/gcc/ada/gen_il-fields.ads
@@ -66,7 +66,7 @@ package Gen_IL.Fields is
Acts_As_Spec,
Actual_Designated_Subtype,
Address_Warning_Posted,
- Aggregate_Bounds,
+ Aggregate_Bounds_Or_Ancestor_Type,
Aliased_Present,
All_Others,
All_Present,
diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb
index 087f78567f4..064d25fbd79 100644
--- a/gcc/ada/gen_il-gen-gen_nodes.adb
+++ b/gcc/ada/gen_il-gen-gen_nodes.adb
@@ -493,7 +493,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sy (Is_Parenthesis_Aggregate, Flag),
Sy (Is_Homogeneous_Aggregate, Flag),
Sy (Is_Enum_Array_Aggregate, Flag),
-Sm (Aggregate_Bounds, Node_Id),
+Sm (Aggregate_Bounds_Or_Ancestor_Type, Node_Id),
Sm (Entity_Or_Associated_Node, Node_Id), -- just Associated_Node
Sm (Compile_Time_Known_Aggregate, Flag),
Sm (Expansion_Delayed, Flag),
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index e1e7b8bac37..a61326c9ae2 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -5644,18 +5644,14 @@ package body Sem_Aggr is
Parent_Typ := Etype (Parent_Typ);
-- Check whether a private parent requires the use of
- -- an extension aggregate. This test does not apply in
- -- an instantiation: if the generic unit is legal so is
- -- the instance.
+ -- an extension aggregate.
if Nkind (Parent (Base_Type (Parent_Typ))) =
N_Private_Type_Declaration
or else Nkind (Parent (Base_Type (Parent_Typ))) =
N_Private_Extension_Declaration
then
- if Nkind (N) /= N_Extension_Aggregate
-and then not In_Instance
- then
+ if Nkind (N) /= N_Extension_Aggregate then
Error_Msg_NE
("type of aggregate has private ancestor&!",
N, Parent_Typ);
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index e229d217555..2b8436d7c18 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -7059,10 +7059,14 @@ package body Sem_Ch12 is
end if;
end Check_Actual_Type;
+ -- Local variables
+
Astype : Entity_Id;
E : Entity_Id;
Formal : Node_Id;
+ -- Start of processing for Check_Generic_Actuals
+
begin
E := First_Entity (Instance);
while Present (E) loop
@@ -8495,38 +8499,46 @@ package body Sem_Ch12 is
Set_Associated_Node (N, New_N);
else
-if Present (Get_Associated_Node (N))
- and then Nkind (Get_Associated_Node (N)) = Nkind (N)
-then
[COMMITTED] ada: Remove No_Dynamic_Priorities from Restricted_Tasking
From: Johannes Kliemann Some of our restricted runtimes support dynamic priorities. The binder needs to generate code for a restricted runtime even if the restriction No_Dynamic_Priorities is not in place. gcc/ada/ * libgnat/s-rident.ads: Remove No_Dynamic_Priorities from Restricted_Tasking. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnat/s-rident.ads | 1 - 1 file changed, 1 deletion(-) diff --git a/gcc/ada/libgnat/s-rident.ads b/gcc/ada/libgnat/s-rident.ads index de8b20edd7a..d280cfc219f 100644 --- a/gcc/ada/libgnat/s-rident.ads +++ b/gcc/ada/libgnat/s-rident.ads @@ -449,7 +449,6 @@ package System.Rident is No_Asynchronous_Control => True, No_Dynamic_Attachment => True, No_Dynamic_CPU_Assignment => True, - No_Dynamic_Priorities => True, No_Local_Protected_Objects => True, No_Protected_Type_Allocators=> True, No_Requeue_Statements => True, -- 2.43.0
[COMMITTED] ada: Ignore unconstrained components as inputs for Depends
From: Piotr Trojanek The current wording of SPARK RM 6.1.5(5) about the inputs for the Depends contract doesn't mention "a record with at least one unconstrained component". gcc/ada/ * sem_prag.adb (Is_Unconstrained_Or_Tagged_Item): Update comment and body. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_prag.adb | 38 ++ 1 file changed, 2 insertions(+), 36 deletions(-) diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index db20f20b9f1..a2e705110de 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -283,8 +283,7 @@ package body Sem_Prag is function Is_Unconstrained_Or_Tagged_Item (Item : Entity_Id) return Boolean; -- Subsidiary to Collect_Subprogram_Inputs_Outputs and the analysis of -- pragma Depends. Determine whether the type of dependency item Item is - -- tagged, unconstrained array, unconstrained record or a record with at - -- least one unconstrained component. + -- tagged, unconstrained array or unconstrained record. procedure Record_Possible_Body_Reference (State_Id : Entity_Id; @@ -32957,36 +32956,7 @@ package body Sem_Prag is function Is_Unconstrained_Or_Tagged_Item (Item : Entity_Id) return Boolean is - function Has_Unconstrained_Component (Typ : Entity_Id) return Boolean; - -- Determine whether record type Typ has at least one unconstrained - -- component. - - - - -- Has_Unconstrained_Component -- - - - - function Has_Unconstrained_Component (Typ : Entity_Id) return Boolean is - Comp : Entity_Id; - - begin - Comp := First_Component (Typ); - while Present (Comp) loop -if Is_Unconstrained_Or_Tagged_Item (Comp) then - return True; -end if; - -Next_Component (Comp); - end loop; - - return False; - end Has_Unconstrained_Component; - - -- Local variables - Typ : constant Entity_Id := Etype (Item); - - -- Start of processing for Is_Unconstrained_Or_Tagged_Item - begin if Is_Tagged_Type (Typ) then return True; @@ -32995,11 +32965,7 @@ package body Sem_Prag is return True; elsif Is_Record_Type (Typ) then - if Has_Discriminants (Typ) and then not Is_Constrained (Typ) then -return True; - else -return Has_Unconstrained_Component (Typ); - end if; + return Has_Discriminants (Typ) and then not Is_Constrained (Typ); elsif Is_Private_Type (Typ) and then Has_Discriminants (Typ) then return True; -- 2.43.0
[COMMITTED] ada: Fix crash on concurrent type aggregate
From: Ronan Desplanques Before this patch, the compiler would fail to examine the corresponding record types of concurrent types when building aggregate components. This patch fixes this, and adds a precondition and additional documentation on the subprogram that triggered the crash, as it never makes sense to call it with a concurrent type. gcc/ada/ * exp_aggr.adb (Initialize_Component): Use corresponding record types of concurrent types. * exp_util.ads (Make_Tag_Assignment_From_Type): Add precondition and extend documentation. Co-authored-by: Javier Miranda Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_aggr.adb | 15 --- gcc/ada/exp_util.ads | 8 ++-- 2 files changed, 18 insertions(+), 5 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index d61fbbc8c73..50063ed819e 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -8509,9 +8509,18 @@ package body Exp_Aggr is Set_No_Ctrl_Actions (Init_Stmt); if Tagged_Type_Expansion and then Is_Tagged_Type (Comp_Typ) then -Append_To (Blk_Stmts, - Make_Tag_Assignment_From_Type -(Loc, New_Copy_Tree (Comp), Underlying_Type (Comp_Typ))); +declare + Typ : Entity_Id := Underlying_Type (Comp_Typ); + +begin + if Is_Concurrent_Type (Typ) then + Typ := Corresponding_Record_Type (Typ); + end if; + + Append_To (Blk_Stmts, + Make_Tag_Assignment_From_Type + (Loc, New_Copy_Tree (Comp), Typ)); +end; end if; end if; diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 267a127ec5e..d15e4f90865 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -941,9 +941,13 @@ package Exp_Util is function Make_Tag_Assignment_From_Type (Loc: Source_Ptr; Target : Node_Id; - Typ: Entity_Id) return Node_Id; + Typ: Entity_Id) return Node_Id + with + Pre => (not Is_Concurrent_Type (Typ)); -- Return an assignment of the tag of tagged type Typ to prefix Target, - -- which must be a record object of a descendant of Typ. + -- which must be a record object of a descendant of Typ. Typ cannot be a + -- concurrent type; for concurrent types, the corresponding record types + -- should be passed to this function instead. function Make_Variant_Comparison (Loc : Source_Ptr; -- 2.43.0
[COMMITTED] ada: Add makefile targets for building/installing html doc
Add the ada.html and ada.install-html targets so that we can build the html with `make html`. gcc/ada/ * gcc-interface/Make-lang.in (ada.html, ada.install-html): Add. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/gcc-interface/Make-lang.in | 35 ++ 1 file changed, 31 insertions(+), 4 deletions(-) diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index 97830ee37f9..2cf0c6d0977 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -889,10 +889,6 @@ ada.install-pdf: $(ADA_PDFFILES) $(INSTALL_DATA) "$$d$$p" "$(DESTDIR)$(pdfdir)/gcc/$$f"; \ done -ada.html: - -ada.install-html: - doc/gnat_ugn.dvi: ada/gnat_ugn.texi \ $(gcc_docdir)/include/fdl.texi \ $(gcc_docdir)/include/gcc-common.texi gcc-vers.texi @@ -917,6 +913,37 @@ doc/gnat_rm.pdf: ada/gnat_rm.texi $(gcc_docdir)/include/fdl.texi \ doc/gnat-style.pdf: ada/gnat-style.texi $(gcc_docdir)/include/fdl.texi $(TEXI2PDF) -c -I $(abs_docdir)/include -o $@ $< +ADA_TEXI_FILES = \ + ada/gnat_rm.texi \ + ada/gnat_ugn.texi \ + $(gcc_docdir)/include/fdl.texi \ + $(gcc_docdir)/include/gpl_v3.texi \ + $(gcc_docdir)/include/gcc-common.texi \ + gcc-vers.texi + +$(build_htmldir)/ada/index.html: $(ADA_TEXI_FILES) + $(mkinstalldirs) $(@D) + rm -f $(@D)/* + $(TEXI2HTML) -I $(gcc_docdir)/include -I $(srcdir)/ada -o $(@D) $< + +ada.html: $(build_htmldir)/ada/index.html +ada.install-html: $(build_htmldir)/ada + @$(NORMAL_INSTALL) + test -z "$(htmldir)" || $(mkinstalldirs) "$(DESTDIR)$(htmldir)" + @for p in $(build_htmldir)/ada; do \ + if test -f "$$p" || test -d "$$p"; then d=""; else d="$(srcdir)/"; fi; \ + f=$(html__strip_dir) \ + if test -d "$$d$$p"; then \ + echo " $(mkinstalldirs) '$(DESTDIR)$(htmldir)/$$f'"; \ + $(mkinstalldirs) "$(DESTDIR)$(htmldir)/$$f" || exit 1; \ + echo " $(INSTALL_DATA) '$$d$$p'/* '$(DESTDIR)$(htmldir)/$$f'"; \ + $(INSTALL_DATA) "$$d$$p"/* "$(DESTDIR)$(htmldir)/$$f"; \ + else \ + echo " $(INSTALL_DATA) '$$d$$p' '$(DESTDIR)$(htmldir)/$$f'"; \ + $(INSTALL_DATA) "$$d$$p" "$(DESTDIR)$(htmldir)/$$f"; \ + fi; \ + done + # Install hooks: # gnat1 is installed elsewhere as part of $(COMPILERS). -- 2.43.0
[COMMITTED] ada: Remove unreferenced utility routine Get_Logical_Line_Number_Img
From: Piotr Trojanek Routine Get_Logical_Line_Number_Img was introduced for splitting of Pre/Post contracts, but subsequent patch for that feature removed its only use. It was then used by GNATprove, but that use is now removed as well. gcc/ada/ * sinput.adb, sinput.ads (Get_Logical_Line_Number_Img): Remove. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sinput.adb | 13 - gcc/ada/sinput.ads | 5 - 2 files changed, 18 deletions(-) diff --git a/gcc/ada/sinput.adb b/gcc/ada/sinput.adb index 4352cad62c7..dc6b55aede1 100644 --- a/gcc/ada/sinput.adb +++ b/gcc/ada/sinput.adb @@ -460,19 +460,6 @@ package body Sinput is end if; end Get_Logical_Line_Number; - - - -- Get_Logical_Line_Number_Img -- - - - - function Get_Logical_Line_Number_Img - (P : Source_Ptr) return String - is - begin - Name_Len := 0; - Add_Nat_To_Name_Buffer (Nat (Get_Logical_Line_Number (P))); - return Name_Buffer (1 .. Name_Len); - end Get_Logical_Line_Number_Img; - -- -- Get_Physical_Line_Number -- -- diff --git a/gcc/ada/sinput.ads b/gcc/ada/sinput.ads index 6ce2a22e746..e30487e276f 100644 --- a/gcc/ada/sinput.ads +++ b/gcc/ada/sinput.ads @@ -541,11 +541,6 @@ package Sinput is -- WARNING: There is a matching C declaration of this subprogram in fe.h - function Get_Logical_Line_Number_Img - (P : Source_Ptr) return String; - -- Same as above function, but returns the line number as a string of - -- decimal digits, with no leading space. Destroys Name_Buffer. - function Get_Physical_Line_Number (P : Source_Ptr) return Physical_Line_Number; -- The line number of the specified source position is obtained by -- 2.43.0
[COMMITTED] ada: Fix style and typos in comments
From: Piotr Trojanek Code cleanup. gcc/ada/ * exp_ch9.adb, sem_ch10.adb, sem_util.adb: Fix comments. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_ch9.adb | 4 ++-- gcc/ada/sem_ch10.adb | 2 +- gcc/ada/sem_util.adb | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index cfdab114c9b..f83c233a516 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -7264,7 +7264,7 @@ package body Exp_Ch9 is -- Generate: --if K = Ada.Tags.TK_Limited_Tagged -- or else K = Ada.Tags.TK_Tagged --- then +--then -- Lim_Typ_Stmts --else -- Conc_Typ_Stmts @@ -12740,7 +12740,7 @@ package body Exp_Ch9 is -- Generate: --if K = Ada.Tags.TK_Limited_Tagged -- or else K = Ada.Tags.TK_Tagged - -- then + --then -- Lim_Typ_Stmts --else -- Conc_Typ_Stmts diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 7cca555f276..ea9bc0d8830 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -4529,7 +4529,7 @@ package body Sem_Ch10 is then -- If the unit is an ancestor of the current one, it is the -- case of a private limited with clause on a child unit, and - -- the compilation of one of its descendants, In that case the + -- the compilation of one of its descendants, in that case the -- limited view is errelevant. if Limited_Present (Item) then diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index f8922fed322..791fa7bc12e 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -15980,7 +15980,7 @@ package body Sem_Util is Param_Typ := Etype (Param); end if; - -- In the case where an Itype was created for a dispatchin call, the + -- In the case where an Itype was created for a dispatching call, the -- procedure call has been rewritten. The actual may be an access to -- interface type in which case it is the designated type that is the -- controlling type. -- 2.43.0
[COMMITTED] ada: Further cleanup in finalization machinery
From: Eric Botcazou This removes the setting of the Is_Ignored_Transient flag on the temporaries needing finalization created by Expand_Ctrl_Function_Call when invoked from within the dependent expressions of conditional expressions. This flag tells the general finalization machinery to disregard the object. But temporaries needing finalization present in action lists of dependent expressions are picked up by Process_Transients_In_Expression, which deals with their finalization and sets the Is_Finalized_Transient flag on them. Now this latter flag has exactly the same effect as Is_Ignored_Transient as far as the general finalization machinery is concerned, so setting the flag is unnecessary. In the end, the flag can be decoupled entirely from transient objects and renamed into Is_Ignored_For_Finalization. This also moves around the declaration of a local variable and turns a library-level procedure into a nested procedure. gcc/ada/ * einfo.ads (Is_Ignored_Transient): Rename into... (Is_Ignored_For_Finalization): ...this. * gen_il-fields.ads (Opt_Field_Enum): Adjust to above renaming. * gen_il-gen-gen_entities.adb (Object_Kind): Likewise. * exp_aggr.adb (Expand_Array_Aggregate): Likewise. * exp_ch7.adb (Build_Finalizer.Process_Declarations): Likewise. * exp_util.adb (Requires_Cleanup_Actions): Likewise. * exp_ch4.adb (Expand_N_If_Expression): Move down declaration of variable Optimize_Return_Stmt. (Process_Transient_In_Expression): Turn procedure into a child of... (Process_Transients_In_Expression): ...this procedure. * exp_ch6.adb (Expand_Ctrl_Function_Call): Remove obsolete setting of Is_Ignored_Transient flag on the temporary if within a dependent expression of a conditional expression. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/einfo.ads | 16 +- gcc/ada/exp_aggr.adb| 2 +- gcc/ada/exp_ch4.adb | 278 ++-- gcc/ada/exp_ch6.adb | 43 - gcc/ada/exp_ch7.adb | 14 +- gcc/ada/exp_util.adb| 12 +- gcc/ada/gen_il-fields.ads | 2 +- gcc/ada/gen_il-gen-gen_entities.adb | 2 +- 8 files changed, 158 insertions(+), 211 deletions(-) diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 9165fb7485d..1dd55494a53 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2727,6 +2727,11 @@ package Einfo is -- instantiation of a child unit, and whose entities are not visible -- during analysis of the instance. +--Is_Ignored_For_Finalization +-- Defined in constants and variables. Set when an object must be ignored +-- by the general finalization mechanism because its cleanup actions are +-- already accounted for. + --Is_Ignored_Ghost_Entity -- Applies to all entities. Set for abstract states, [generic] packages, -- [generic] subprograms, components, discriminants, formal parameters, @@ -2734,13 +2739,6 @@ package Einfo is -- pragma Ghost or inherit "ghostness" from an enclosing construct, and -- subject to Assertion_Policy Ghost => Ignore. ---Is_Ignored_Transient --- Defined in constants, loop parameters of generalized iterators, and --- variables. Set when a transient object must be processed by one of --- the transient finalization mechanisms. Once marked, a transient is --- intentionally ignored by the general finalization mechanism because --- its clean up actions are context specific. - --Is_Immediately_Visible -- Defined in all entities. Set if entity is immediately visible, i.e. -- is defined in some currently open scope (RM 8.3(4)). @@ -5325,7 +5323,7 @@ package Einfo is --Is_Elaboration_Warnings_OK_Id (constants only) --Is_Eliminated --Is_Finalized_Transient - --Is_Ignored_Transient + --Is_Ignored_For_Finalization --Is_Independent --Is_Return_Object --Is_True_Constant @@ -6213,7 +6211,7 @@ package Einfo is --Is_Elaboration_Warnings_OK_Id --Is_Eliminated --Is_Finalized_Transient - --Is_Ignored_Transient + --Is_Ignored_For_Finalization --Is_Independent --Is_Return_Object --Is_Safe_To_Reevaluate diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 2d02bad0c4c..d61fbbc8c73 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -6317,7 +6317,7 @@ package body Exp_Aggr is and then No_Ctrl_Actions (Parent_Node) then Mutate_Ekind (Tmp, E_Variable); -Set_Is_Ignored_Transient (Tmp); +Set_Is_Ignored_For_Finalization (Tmp); end if; Insert_Action (N, Tmp_Decl); diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 527ca16aac4..037c8b528bd 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/a
[COMMITTED] ada: Compiler hangs on container aggregate with function call as key expression
From: Gary Dismukes The compiler hangs (or may crash, if assertions are enabled) when compiling an iterated association of a container aggregate that has a key expression given by a function call. The resolution of the call leads to a blowup in Build_Call_Marker, because the temporary copy of the expression that's analyzed has an Empty parent, causing insertion of the call marker to fail. The fix for this is to preanalyze, rather than analyze, the copy of the key expression (Build_Call_Marker will return without creating a call marker in the case of preanalysis). gcc/ada/ * sem_aggr.adb (Resolve_Iterated_Association): Call Preanalyze_And_Resolve instead of Analyze_And_Resolve on a key expression of an iterated association. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_aggr.adb | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index a61326c9ae2..bf249620d04 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -3270,13 +3270,13 @@ package body Sem_Aggr is (Iterator_Specification (Comp))); end if; --- Key expression must have the type of the key. We analyze +-- Key expression must have the type of the key. We preanalyze -- a copy of the original expression, because it will be -- reanalyzed and copied as needed during expansion of the -- corresponding loop. Key_Expr := Key_Expression (Comp); -Analyze_And_Resolve (New_Copy_Tree (Key_Expr), Key_Type); +Preanalyze_And_Resolve (New_Copy_Tree (Key_Expr), Key_Type); End_Scope; Typ := Key_Type; -- 2.43.0
[COMMITTED] ada: Optimize performance and remove dynamic frame requirement.
From: Vasiliy Fofanov gcc/ada/ * libgnat/i-cstrin.adb (Value): Optimize. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnat/i-cstrin.adb | 17 ++--- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/gcc/ada/libgnat/i-cstrin.adb b/gcc/ada/libgnat/i-cstrin.adb index 1eb28655004..73a0bc875bd 100644 --- a/gcc/ada/libgnat/i-cstrin.adb +++ b/gcc/ada/libgnat/i-cstrin.adb @@ -346,11 +346,13 @@ is end Value; function Value (Item : chars_ptr; Length : size_t) return String is - Result : char_array (0 .. Length); + Result : String (1 .. Natural (Length)); + C : char; begin pragma Annotate (Gnatcheck, Exempt_On, "Improper_Returns", "early returns for performance"); + -- As per AI-00177, this is equivalent to: --To_Ada (Value (Item, Length) & nul); @@ -359,16 +361,17 @@ is raise Dereference_Error; end if; - for J in 0 .. Length - 1 loop - Result (J) := Peek (Item + J); + for J in Result'Range loop + C := Peek (Item + size_t (J - 1)); - if Result (J) = nul then -return To_Ada (Result (0 .. J)); + if C = nul then +return Result (1 .. J - 1); + else +Result (J) := To_Ada (C); end if; end loop; - Result (Length) := nul; - return To_Ada (Result); + return Result; pragma Annotate (Gnatcheck, Exempt_Off, "Improper_Returns"); end Value; -- 2.43.0
[COMMITTED] ada: Check all interfaces for valid iterator type
From: Viljar Indus
gcc/ada/
* sem_ch13.adb (Valid_Default_Iterator): Check all interfaces for
valid iterator type. Also improve error reporting.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_ch13.adb | 103 +--
1 file changed, 90 insertions(+), 13 deletions(-)
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 8f6fa3af0f8..6513afa0b1c 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -5876,39 +5876,116 @@ package body Sem_Ch13 is
--
procedure Check_Iterator_Functions is
- function Valid_Default_Iterator (Subp : Entity_Id) return Boolean;
- -- Check one possible interpretation for validity
+ function Valid_Default_Iterator (Subp : Entity_Id;
+ Ref_Node : Node_Id := Empty)
+ return Boolean;
+ -- Check one possible interpretation for validity. If
+ -- Ref_Node is present report errors on violations.
-- Valid_Default_Iterator --
- function Valid_Default_Iterator (Subp : Entity_Id) return Boolean is
-Root_T : constant Entity_Id := Root_Type (Etype (Etype (Subp)));
-Formal : Entity_Id;
+ function Valid_Default_Iterator (Subp : Entity_Id;
+ Ref_Node : Node_Id := Empty)
+ return Boolean
+ is
+Return_Type : constant Entity_Id := Etype (Etype (Subp));
+Return_Node : Node_Id;
+Root_T : constant Entity_Id := Root_Type (Return_Type);
+Formal : Entity_Id;
+
+function Valid_Iterator_Name (E : Entity_Id) return Boolean
+is (Chars (E) in Name_Forward_Iterator | Name_Reversible_Iterator);
+
+function Valid_Iterator_Name (L : Elist_Id) return Boolean;
+
+-
+-- Valid_Iterator_Name --
+-
+
+function Valid_Iterator_Name (L : Elist_Id) return Boolean
+is
+ Iface_Elmt : Elmt_Id := First_Elmt (L);
+begin
+ while Present (Iface_Elmt) loop
+ if Valid_Iterator_Name (Node (Iface_Elmt)) then
+ return True;
+ end if;
+ Next_Elmt (Iface_Elmt);
+ end loop;
+
+ return False;
+end Valid_Iterator_Name;
begin
+if Subp = Any_Id then
+ if Present (Ref_Node) then
+
+ -- Subp is not resolved and an error will be posted about
+ -- it later
+
+ Error_Msg_N ("improper function for default iterator!",
+ Ref_Node);
+ end if;
+
+ return False;
+end if;
+
if not Check_Primitive_Function (Subp) then
+ if Present (Ref_Node) then
+ Error_Msg_N ("improper function for default iterator!",
+ Ref_Node);
+ Error_Msg_Sloc := Sloc (Subp);
+ Error_Msg_NE
+ ("\\default iterator defined # "
+ & "must be a primitive function",
+ Ref_Node, Subp);
+ end if;
+
return False;
+end if;
-- The return type must be derived from a type in an instance
-- of Iterator.Interfaces, and thus its root type must have a
-- predefined name.
-elsif Chars (Root_T) /= Name_Forward_Iterator
- and then Chars (Root_T) /= Name_Reversible_Iterator
+if not Valid_Iterator_Name (Root_T)
+ and then not (Has_Interfaces (Return_Type) and then
+ Valid_Iterator_Name (Interfaces (Return_Type)))
then
- return False;
+ if Present (Ref_Node) then
-else
- Formal := First_Formal (Subp);
+ Return_Node := Result_Definition (Parent (Subp));
+
+ Error_Msg_N ("improper function for default iterator!",
+ Ref_Node);
+ Error_Msg_Sloc := Sloc (Return_Node);
+ Error_Msg_NE ("\\return type & # "
+ & "must inherit from either "
+ & "Forward_Iterator or Reversible_Iterator",
+ Ref_Node, Return_Node);
+ end if;
+
+ return False;
end if;
+Formal := First_Formal (Subp);
+
-- False if any subsequent formal has no default expression
Next_Formal (Formal);
while Present (Formal) loop
if No (Expression (
[COMMITTED] ada: Rework comment in Expand_Ctrl_Function_Call
From: Eric Botcazou This expands on the reason for properly guarding the transformation. gcc/ada/ * exp_ch6.adb (Expand_Ctrl_Function_Call): Rework last comment. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_ch6.adb | 7 ++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 195e34a3479..8e4c9035b22 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -5477,7 +5477,12 @@ package body Exp_Ch6 is Set_Analyzed (N); - -- Apply the transformation, unless it was already applied manually + -- Apply the transformation unless it was already applied earlier. This + -- may happen because Remove_Side_Effects can be called during semantic + -- analysis, for example from Build_Actual_Subtype_Of_Component. It is + -- crucial to avoid creating a reference of reference here, because it + -- would not be subsequently recognized by the Is_Finalizable_Transient + -- and Requires_Cleanup_Actions predicates. if Nkind (Par) /= N_Reference then Remove_Side_Effects (N); -- 2.43.0
[COMMITTED] ada: Add missing guard to previous change
From: Eric Botcazou Ancestor_Type is overloaded with Aggregate_Bounds on N_Aggregate nodes so its access needs to be guarded in Copy_Generic_Node. gcc/ada/ * sem_ch12.adb (Copy_Generic_Node): Add guard for Ancestor_Type. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_ch12.adb | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 2b8436d7c18..bfb400f5642 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -8518,10 +8518,12 @@ package body Sem_Ch12 is -- Moreover, for a full aggregate, if the type is a derived tagged -- type and has a global ancestor, then also restore the full view --- of this ancestor, and do so up to the root type. +-- of this ancestor and do so up to the root type. Beware that the +-- Ancestor_Type field is overloaded, so test that it's an entity. if Nkind (N) = N_Aggregate and then Present (Ancestor_Type (N)) + and then Nkind (Ancestor_Type (N)) in N_Entity then declare Root_Typ : constant Entity_Id := -- 2.43.0
[COMMITTED] ada: Rename Is_Constr_Subt_For_UN_Aliased flag
From: Eric Botcazou The flag is set on the constructed subtype of an object with unconstrained nominal subtype that is aliased and is used by the code generator to adjust the layout of the object. But it is actually only used for array subtypes, where it determines whether the object is allocated with its bounds, and this usage could be extended to other cases than the original case. gcc/ada/ * einfo.ads (Is_Constr_Subt_For_UN_Aliased): Rename into... (Is_Constr_Array_Subt_With_Bounds): ...this. * exp_ch3.adb (Expand_N_Object_Declaration): Adjust to above renaming and remove now redundant test. * sem_ch3.adb (Analyze_Object_Declaration): Likewise, but set Is_Constr_Array_Subt_With_Bounds only on arrays. * gen_il-fields.ads (Opt_Field_Enum): Apply same renaming. * gen_il-gen-gen_entities.adb (Entity_Kind): Likewise. * gen_il-internals.adb (Image): Remove specific processing for Is_Constr_Subt_For_UN_Aliased. * treepr.adb (Image): Likewise. * gcc-interface/decl.cc (gnat_to_gnu_entity): Adjust to renaming and remove now redundant tests. * gcc-interface/trans.cc (Identifier_to_gnu): Likewise. (Call_to_gnu): Likewise. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/einfo.ads | 14 - gcc/ada/exp_ch3.adb | 3 +- gcc/ada/gcc-interface/decl.cc | 44 + gcc/ada/gcc-interface/trans.cc | 16 +-- gcc/ada/gen_il-fields.ads | 2 +- gcc/ada/gen_il-gen-gen_entities.adb | 2 +- gcc/ada/gen_il-internals.adb| 2 -- gcc/ada/sem_ch3.adb | 27 -- gcc/ada/treepr.adb | 2 -- 9 files changed, 55 insertions(+), 57 deletions(-) diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 1dd55494a53..d08f02ba5cb 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2474,17 +2474,17 @@ package Einfo is -- and subtypes, string types and subtypes, and all numeric types). -- Set if the type or subtype is constrained. +--Is_Constr_Array_Subt_With_Bounds +-- Defined in all types and subtypes. Set only for an array subtype +-- which is constrained but nevertheless requires objects of this +-- subtype to be allocated with their bounds. This flag is used by +-- the back end to determine whether the bounds must be constructed. + --Is_Constr_Subt_For_U_Nominal -- Defined in all types and subtypes. Set only for the constructed -- subtype of an object whose nominal subtype is unconstrained. Note -- that the constructed subtype itself will be constrained. ---Is_Constr_Subt_For_UN_Aliased --- Defined in all types and subtypes. This flag can be set only if --- Is_Constr_Subt_For_U_Nominal is also set. It indicates that in --- addition the object concerned is aliased. This flag is used by --- the backend to determine whether a template must be constructed. - --Is_Constructor -- Defined in function and procedure entities. Set if a pragma -- CPP_Constructor applies to the subprogram. @@ -5058,8 +5058,8 @@ package Einfo is --Is_Abstract_Type --Is_Asynchronous --Is_Atomic + --Is_Constr_Array_Subt_With_Bounds --Is_Constr_Subt_For_U_Nominal - --Is_Constr_Subt_For_UN_Aliased --Is_Controlled_Active (base type only) --Is_Eliminated --Is_Frozen diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index f88ac7e6542..d616c5cba9f 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -8107,8 +8107,7 @@ package body Exp_Ch3 is -- initialization expression has an unconstrained subtype too, -- because the bounds must be present within X. -and then not (Is_Array_Type (Typ) - and then Is_Constr_Subt_For_UN_Aliased (Typ) +and then not (Is_Constr_Array_Subt_With_Bounds (Typ) and then Is_Constrained (Etype (Expr_Q))) -- We may use a renaming if the initialization expression is a diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc index d2456bfbc01..c3d2de22b65 100644 --- a/gcc/ada/gcc-interface/decl.cc +++ b/gcc/ada/gcc-interface/decl.cc @@ -889,7 +889,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) || (TYPE_SIZE (gnu_type) && integer_zerop (TYPE_SIZE (gnu_type)) && !TREE_OVERFLOW (TYPE_SIZE (gnu_type - && !Is_Constr_Subt_For_UN_Aliased (gnat_type) + && !Is_Constr_Array_Subt_With_Bounds (gnat_type) && No (gnat_renamed_obj) && No (Address_Clause (gnat_entity))) gnu_size = bitsize_unit_node; @@ -907,7 +907,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree
[COMMITTED] ada: gnatbind: Do not generate Ada.Command_Line references when not used
From: Patrick Bernardi
It was previously assumed that configurable runtimes could not return exit
statuses, however this assumption no longer holds. Instead, only import
the required symbols from Ada.Command_Line's support packages if
Ada.Command_Line is in the closure of the partition when a configurable
runtime is used.
gcc/ada/
* bindgen.adb (Command_Line_Used): New object.
(Gen_Main): Only generate references to symbols used by
Ada.Command_Line if the package is used by the partition.
(Gen_Output_File_Ada): Ditto.
(Resolve_Binder_Options): Check if Ada.Command_Line is in the
closure of the partition.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/bindgen.adb | 55 ++---
1 file changed, 42 insertions(+), 13 deletions(-)
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index 03315fe2251..005ad70f507 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -65,6 +65,15 @@ package body Bindgen is
-- Number of default-sized primary stacks the binder needs to allocate for
-- task objects declared in the program.
+ Command_Line_Used : Boolean := False;
+ -- Flag indicating whether the unit Ada.Command_Line is in the closure of
+ -- the partition. This is set by Resolve_Binder_Options, and is used to
+ -- determine whether or not to import and use symbols defined in
+ -- Ada.Command_Line's support packages (gnat_argc, gnat_argv, gnat_envp
+ -- and gnat_exit_status). Conservatively, it is always set to True for
+ -- non-configurable run-times as parts of the compiler and run-time assume
+ -- these symbols are available and can be imported directly.
+
System_Restrictions_Used : Boolean := False;
-- Flag indicating whether the unit System.Restrictions is in the closure
-- of the partition. This is set by Resolve_Binder_Options, and is used
@@ -2092,15 +2101,13 @@ package body Bindgen is
WBI (" begin");
- -- Acquire command-line arguments if present and supported on the
- -- target. Do not acquire command-line arguments if pragma No_Run_Time
- -- is in effect as the run-time symbols will not be available.
+ -- Acquire command-line arguments if supported on the target and used
+ -- by the program.
if CodePeer_Mode then
null;
- elsif Command_Line_Args_On_Target and then not No_Run_Time_Mode then
-
+ elsif Command_Line_Args_On_Target and then Command_Line_Used then
-- Initialize gnat_argc/gnat_argv only if not already initialized,
-- to avoid losing the result of any command-line processing done by
-- earlier GNAT run-time initialization.
@@ -2187,10 +2194,13 @@ package body Bindgen is
if No_Main_Subprogram
or else ALIs.Table (ALIs.First).Main_Program = Proc
then
-if No_Run_Time_Mode then
- WBI (" return (0);");
-else
+-- Return gnat_exit_status if Ada.Command_Line is used otherwise
+-- return 0.
+
+if Command_Line_Used then
WBI (" return (gnat_exit_status);");
+else
+ WBI (" return (0);");
end if;
else
WBI (" return (Result);");
@@ -2589,8 +2599,11 @@ package body Bindgen is
-- A run-time configured to support command line arguments defines
-- a number of internal symbols that need to be set by the binder.
+ -- We do not do this in cases where the program does not use
+ -- Ada.Command_Line, as the package and it's support files may not be
+ -- present.
- if Command_Line_Args_On_Target and then not No_Run_Time_Mode then
+ if Command_Line_Args_On_Target and then Command_Line_Used then
WBI ("");
WBI (" gnat_argc : Integer;");
WBI (" gnat_argv : System.Address;");
@@ -2602,13 +2615,17 @@ package body Bindgen is
WBI (" pragma Import (C, gnat_envp);");
end if;
- -- Define exit status. The exit status is stored in the run-time
- -- library to allow applications set the state through
- -- Ada.Command_Line. It is initialized there.
+ -- Define exit status if supported by the target. The exit status is
+ -- stored in the run-time library to allow applications set the state
+ -- through Ada.Command_Line and is initialized in the run-time. Like
+ -- command line arguments, skip if Ada.Command_Line is not used in
+ -- the enclosure of the partition because this package may not be
+ -- available in the runtime.
WBI ("");
- if Exit_Status_Supported_On_Target and then not No_Run_Time_Mode then
+ if Exit_Status_Supported_On_Target and then Command_Line_Used
+ then
WBI (" gnat_exit_status
[COMMITTED] ada: Remove GNATcheck violations
From: Sheri Bernstein Remove GNATcheck violations by refactoring code and also using pragma Annotate to exempt them. gcc/ada/ * libgnat/a-comlin.adb (Argument_Count): Rewrite code so there is only one return, to remove Improper_Returns violation. (Command_Name): Add pragma to exempt Improper_Returns violation. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnat/a-comlin.adb | 18 -- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/gcc/ada/libgnat/a-comlin.adb b/gcc/ada/libgnat/a-comlin.adb index b95ecd3290c..8a6686181bd 100644 --- a/gcc/ada/libgnat/a-comlin.adb +++ b/gcc/ada/libgnat/a-comlin.adb @@ -77,16 +77,11 @@ package body Ada.Command_Line is function Argument_Count return Natural is begin - if not Initialized then - -- RM A.15 (11) - return 0; - end if; - - if Remove_Args = null then - return Arg_Count - 1; - else - return Remove_Count; - end if; + return + (if not Initialized then 0 -- RM A.15 (11) + elsif Remove_Args = null then Arg_Count - 1 + else Remove_Count + ); end Argument_Count; - @@ -107,6 +102,8 @@ package body Ada.Command_Line is function Command_Name return String is begin + pragma Annotate (Gnatcheck, Exempt_On, "Improper_Returns", + "early returns for performance"); if not Initialized then return ""; end if; @@ -118,6 +115,7 @@ package body Ada.Command_Line is Fill_Arg (Arg'Address, 0); return Arg; end; + pragma Annotate (Gnatcheck, Exempt_Off, "Improper_Returns"); end Command_Name; end Ada.Command_Line; -- 2.43.0
[COMMITTED] ada: Missing error on positional container aggregates for types with Add_Named
From: Gary Dismukes
The compiler fails to reject a container aggregate written using positional
notation when the container type specifies an Add_Named operation in its
Aggregate aspect. Container aggregates for such types must be written using
named associations. The compiler ignores the positional associations and
produces an empty aggregate object. An error check is added to catch such
illegal container aggregates.
gcc/ada/
* sem_aggr.adb (Resolve_Container_Aggregate): In the Add_Named
case, issue an error if the container aggregate is written as a
positional aggregate, since such an aggregate must have named
associations.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_aggr.adb | 20 +---
1 file changed, 17 insertions(+), 3 deletions(-)
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index bf249620d04..1027acf20b5 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -3436,11 +3436,25 @@ package body Sem_Aggr is
Key_Type : constant Entity_Id := Etype (Next_Formal (Container));
Elmt_Type : constant Entity_Id :=
Etype (Next_Formal (Next_Formal (Container)));
-Comp : Node_Id;
-Choice : Node_Id;
+
+Comp_Assocs : constant List_Id := Component_Associations (N);
+Comp: Node_Id;
+Choice : Node_Id;
begin
-Comp := First (Component_Associations (N));
+-- In the Add_Named case, the aggregate must consist of named
+-- associations (Add_Unnnamed is not allowed), so we issue an
+-- error if there are positional associations.
+
+if not Present (Comp_Assocs)
+ and then Present (Expressions (N))
+then
+ Error_Msg_N ("container aggregate must be "
+ & "named, not positional", N);
+ return;
+end if;
+
+Comp := First (Comp_Assocs);
while Present (Comp) loop
if Nkind (Comp) = N_Component_Association then
Choice := First (Choices (Comp));
--
2.43.0
[COMMITTED] ada: Fix internal error on call with parameter of predicated subtype
From: Eric Botcazou The problem is that the predicated subtype does not inherit all the required attributes of a string subtype with a static predicate. gcc/ada/ * sem_ch3.adb (Analyze_Subtype_Declaration): Remove a short-circuit for subtypes without aspects when it comes to predicates. * sem_util.adb (Inherit_Predicate_Flags): Deal with private subtypes whose full view is an Itype. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_ch3.adb | 11 ++- gcc/ada/sem_util.adb | 7 ++- 2 files changed, 8 insertions(+), 10 deletions(-) diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 33d8f116bc2..a6bc8c95cd2 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -6032,17 +6032,10 @@ package body Sem_Ch3 is -- If this is a subtype declaration for an actual in an instance, -- inherit static and dynamic predicates if any. - -- If declaration has no aspect specifications, inherit predicate - -- info as well. Unclear how to handle the case of both specified - -- and inherited predicates ??? Other inherited aspects, such as - -- invariants, should be OK, but the combination with later pragmas - -- may also require special merging. - if Has_Predicates (T) and then Present (Predicate_Function (T)) -and then - ((In_Instance and then not Comes_From_Source (N)) - or else No (Aspect_Specifications (N))) +and then In_Instance +and then not Comes_From_Source (N) then -- Inherit Subprograms_For_Type from the full view, if present diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 791fa7bc12e..9cff9e1be16 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -14531,11 +14531,16 @@ package body Sem_Util is -- A named subtype does not inherit the predicate function of its -- parent but an itype declared for a loop index needs the discrete -- predicate information of its parent to execute the loop properly. + -- Moreover, a named private subtype whose full view is an itype also + -- needs to inherit a predicate function because it will not be frozen. -- A non-discrete type may has a static predicate (for example True) -- but has no static_discrete_predicate. if not Only_Flags -and then Is_Itype (Subt) +and then (Is_Itype (Subt) + or else (Ekind (Subt) = E_Private_Subtype + and then Present (Full_View (Subt)) + and then Is_Itype (Full_View (Subt and then Present (Predicate_Function (Par)) then Set_Subprograms_For_Type (Subt, Subprograms_For_Type (Par)); -- 2.43.0
Re: [PATCH 2/3] Add generated .opt.urls files
Marc Poulhiès writes: >> Perhaps this script could also deal directly with Sphinx-generated >> HTML? > > I investigated a bit... The Ada part doesn't handle the html target, so > it's expected you don't have anything to parse. The online docs are > generated using a different script, not using these makefiles. > > I'll see if I can fix the html target for ada, so that your script > doesn't need to be changed :) > >>> We are generating the texinfo files >>> from sphinx, so maybe we could adjust the script to also match what >>> the >>> sphinx generator produces? >> >> It *might* be as simple as pointing it at the option index for the >> generated HTML for Ada. > > That's worth a try, when/if I can fix the HTML target. FYI, I've committed a simple patch for having the HTML documentation correctly generated when invoking "make html" (r14-6712) so maybe you can also enable it for the Ada frontend. But that will probably not produce any useful output as most compiler options for GNAT are handled in the frontend (no .opt and the actual messages are emitted without using gcc's mechanism). Marc
[COMMITTED] ada: Fix precondition in Interfaces.C.Strings
From: Joffrey Huguet The precondition of both Update procedures in Interfaces.C.Strings were incorrect. This patch fixes this. gcc/ada/ * libgnat/i-cstrin.ads (Update): Fix precondition. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnat/i-cstrin.ads | 9 + 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/gcc/ada/libgnat/i-cstrin.ads b/gcc/ada/libgnat/i-cstrin.ads index 9f1577f5e14..3f55ddfbdc5 100644 --- a/gcc/ada/libgnat/i-cstrin.ads +++ b/gcc/ada/libgnat/i-cstrin.ads @@ -121,8 +121,9 @@ is with Pre=> Item /= Null_Ptr - and then Strlen (Item) <= size_t'Last - Offset - and then Strlen (Item) + Offset <= Chars'Length, + and then (Chars'First /= 0 or else Chars'Last /= size_t'Last) + and then Chars'Length <= size_t'Last - Offset + and then Chars'Length + Offset <= Strlen (Item), Global => (In_Out => C_Memory); procedure Update @@ -133,8 +134,8 @@ is with Pre=> Item /= Null_Ptr - and then Strlen (Item) <= size_t'Last - Offset - and then Strlen (Item) + Offset <= Str'Length, + and then Str'Length <= size_t'Last - Offset + and then Str'Length + Offset <= Strlen (Item), Global => (In_Out => C_Memory); Update_Error : exception; -- 2.43.0
[COMMITTED] ada: Error compiling Ada 2022 object renaming with no subtype mark
From: Steve Baird In some cases the compiler would crash or generate spurious errors compiling a legal object renaming declaration that lacks a subtype mark. In addition to fixing the immediate problem, change Atree.Copy_Slots so that attempts to modify either the Empty or the Error nodes (e.g., by passing one of them as the target in a call to Rewrite) are ineffective. Cope with the consequences of this. gcc/ada/ * sem_ch8.adb (Check_Constrained_Object): Before updating the subtype mark of an object renaming declaration by calling Rewrite, first check whether the destination of the Rewrite call exists. * atree.adb (Copy_Slots): Return without performing any updates if Destination equals Empty or Error, or if Source equals Empty. Any of those conditions indicates an error case. * sem_ch12.adb (Analyze_Formal_Derived_Type): Avoid cascading errors. * sem_ch3.adb (Analyze_Number_Declaration): In an error case, do not pass Error as destination in a call to Rewrite. (Find_Type_Of_Subtype_Indic): In an error case, do not pass Error or Empty as destination in a call to Rewrite. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/atree.adb| 16 +--- gcc/ada/sem_ch12.adb | 6 ++ gcc/ada/sem_ch3.adb | 14 -- gcc/ada/sem_ch8.adb | 14 +- 4 files changed, 40 insertions(+), 10 deletions(-) diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index f265526afb7..7a55b18c605 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -1260,9 +1260,9 @@ package body Atree is end if; end Change_Node; - - -- Copy_Slots -- - + + -- Copy_Dynamic_Slots -- + procedure Copy_Dynamic_Slots (From, To : Node_Offset; Num_Slots : Slot_Count) @@ -1282,6 +1282,10 @@ package body Atree is Destination_Slots := Source_Slots; end Copy_Dynamic_Slots; + + -- Copy_Slots -- + + procedure Copy_Slots (Source, Destination : Node_Id) is pragma Debug (Validate_Node (Source)); pragma Assert (Source /= Destination); @@ -1292,6 +1296,12 @@ package body Atree is Node_Offsets.Table (Node_Offsets.First .. Node_Offsets.Last); begin + -- Empty_Or_Error use as described in types.ads + if Destination <= Empty_Or_Error or No (Source) then + pragma Assert (Serious_Errors_Detected > 0); + return; + end if; + Copy_Dynamic_Slots (Off_F (Source), Off_F (Destination), S_Size); All_Node_Offsets (Destination).Slots := All_Node_Offsets (Source).Slots; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index d2285082f97..5bddb5a8556 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -2541,6 +2541,12 @@ package body Sem_Ch12 is end if; end if; + if Subtype_Mark (Def) <= Empty_Or_Error then + pragma Assert (Serious_Errors_Detected > 0); + -- avoid passing bad argument to Entity + return; + end if; + -- If the parent type has a known size, so does the formal, which makes -- legal representation clauses that involve the formal. diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index a6bc8c95cd2..70cf772edcc 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3668,7 +3668,7 @@ package body Sem_Ch3 is procedure Analyze_Number_Declaration (N : Node_Id) is - E : constant Node_Id := Expression (N); + E : Node_Id:= Expression (N); Id: constant Entity_Id := Defining_Identifier (N); Index : Interp_Index; It: Interp; @@ -3694,14 +3694,13 @@ package body Sem_Ch3 is Set_Is_Pure (Id, Is_Pure (Current_Scope)); - -- Process expression, replacing error by integer zero, to avoid - -- cascaded errors or aborts further along in the processing - -- Replace Error by integer zero, which seems least likely to cause -- cascaded errors. if E = Error then - Rewrite (E, Make_Integer_Literal (Sloc (E), Uint_0)); + pragma Assert (Serious_Errors_Detected > 0); + E := Make_Integer_Literal (Sloc (N), Uint_0); + Set_Expression (N, E); Set_Error_Posted (E); end if; @@ -18615,7 +18614,10 @@ package body Sem_Ch3 is -- Otherwise we have a subtype mark without a constraint elsif Error_Posted (S) then - Rewrite (S, New_Occurrence_Of (Any_Id, Sloc (S))); + -- Don't rewrite if S is Empty or Error + if S > Empty_Or_Error then +Rewrite (S, New_Occurrence_Of (Any_Id, Sloc (S))); + end if; return Any_Type; else diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 2e6b1b6d785..5408be3e1a5 100644 --- a/gcc/ada/sem_c
[COMMITTED] ada: Avoid xref on out params of TSS
From: Bob Duff For an actual passed as an 'in out' parameter of a type support subprogram such as deep finalize, do not count it as a read reference of the actual. Clearly these should not count. Furthermore, counting them causes different warnings in -gnatc mode compared to normal mode, because the calls only exist in normal mode, which would disable the warnings. Such warnings now occur in both modes, instead of just with -gnatc. gcc/ada/ * lib-xref.adb (Generate_Reference): Do not count it as a read reference if we're calling a TSS. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/lib-xref.adb | 12 +--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index 3d6b29862b3..340f5ca73ae 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -29,6 +29,7 @@ with Einfo; use Einfo; with Einfo.Utils;use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; +with Exp_Tss;use Exp_Tss; with Lib.Util; use Lib.Util; with Nlists; use Nlists; with Opt;use Opt; @@ -789,10 +790,15 @@ package body Lib.Xref is elsif Kind = E_In_Out_Parameter and then Is_Assignable (E) then --- For sure this counts as a normal read reference +-- We count it as a read reference unless we're calling a +-- type support subprogram such as deep finalize. -Set_Referenced (E); -Set_Last_Assignment (E, Empty); +if not Is_Entity_Name (Name (Call)) + or else Get_TSS_Name (Entity (Name (Call))) = TSS_Null +then + Set_Referenced (E); + Set_Last_Assignment (E, Empty); +end if; -- We count it as being referenced as an out parameter if the -- option is set to warn on all out parameters, except that we -- 2.43.0
[COMMITTED] ada: Fix uses of not Present
From: Piotr Trojanek
Fix style violation reported by GNATcheck.
gcc/ada/
* sem_aggr.adb (Resolve_Container_Aggregate): Use "No".
* sem_ch8.adb (Find_Direct_Name): Likewise.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_aggr.adb | 2 +-
gcc/ada/sem_ch8.adb | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index f586c18e655..d3d4c4a140f 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -3445,7 +3445,7 @@ package body Sem_Aggr is
-- associations (Add_Unnnamed is not allowed), so we issue an
-- error if there are positional associations.
-if not Present (Comp_Assocs)
+if No (Comp_Assocs)
and then Present (Expressions (N))
then
Error_Msg_N ("container aggregate must be "
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index fc2fec5f224..451a1b67fba 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -6745,7 +6745,7 @@ package body Sem_Ch8 is
Id : Entity_Id := Gen_Trailer;
begin
loop
-if not Present (Id) then
+if No (Id) then
-- E_Trailer presumably occurred
-- earlier on the entity list than
-- Gen_Trailer. So E preceded the
--
2.43.0
[COMMITTED] ada: Fix bug in Sem_Util.Enclosing_Declaration
From: Steve Baird Fix Sem_Util.Enclosing_Declaration to not return an N_Subprogram_Specification node. Remove code in various places that was formerly needed to cope with this misbehavior. gcc/ada/ * sem_util.adb (Enclosing_Declaration): Instead of returning a subprogram specification node, return its parent (which is presumably a subprogram declaration). * contracts.adb (Insert_Stable_Property_Check): Remove code formerly needed to compensate for incorrect behavior of Sem_Util.Enclosing_Declaration. * exp_attr.adb (In_Available_Context): Remove code formerly needed to compensate for incorrect behavior of Sem_Util.Enclosing_Declaration. * sem_ch8.adb (Is_Actual_Subp_Of_Inst): Remove code formerly needed to compensate for incorrect behavior of Sem_Util.Enclosing_Declaration. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/contracts.adb | 12 ++-- gcc/ada/exp_attr.adb | 11 +-- gcc/ada/sem_ch8.adb | 10 -- gcc/ada/sem_util.adb | 5 + 4 files changed, 8 insertions(+), 30 deletions(-) diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb index fa0d59a246a..21bbbf1219e 100644 --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -2529,17 +2529,9 @@ package body Contracts is Pragma_Argument_Associations => Args, Class_Present=> Class_Present); -Subp_Decl : Node_Id := Subp_Id; +Subp_Decl : constant Node_Id := Enclosing_Declaration (Subp_Id); +pragma Assert (Is_Declaration (Subp_Decl)); begin --- Enclosing_Declaration may return, for example, --- a N_Procedure_Specification node. Cope with this. -loop - Subp_Decl := Enclosing_Declaration (Subp_Decl); - exit when Is_Declaration (Subp_Decl); - Subp_Decl := Parent (Subp_Decl); - pragma Assert (Present (Subp_Decl)); -end loop; - Insert_After_And_Analyze (Subp_Decl, Prag); end Insert_Stable_Property_Check; diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 66fd6848a1d..a781f93c4ef 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -8653,17 +8653,8 @@ package body Exp_Attr is -- function In_Available_Context (Ent : Entity_Id) return Boolean is - Decl : Node_Id := Enclosing_Declaration (Ent); + Decl : constant Node_Id := Enclosing_Declaration (Ent); begin - -- Enclosing_Declaration does not always return a declaration; - -- cope with this irregularity. - if Decl in N_Subprogram_Specification_Id - and then Nkind (Parent (Decl)) in - N_Subprogram_Body | N_Subprogram_Declaration - then -Decl := Parent (Decl); - end if; - if Has_Declarations (Parent (Decl)) then return In_Subtree (Attr_Ref, Root => Parent (Decl)); elsif Is_List_Member (Decl) then diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 5408be3e1a5..fc2fec5f224 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -6562,16 +6562,6 @@ package body Sem_Ch8 is Decl := Enclosing_Declaration (E); - -- Enclosing_Declaration does not always return a - -- declaration; cope with this irregularity. - if Decl in N_Subprogram_Specification_Id - and then Nkind (Parent (Decl)) in - N_Subprogram_Body | N_Subprogram_Declaration - | N_Subprogram_Renaming_Declaration - then -Decl := Parent (Decl); - end if; - -- Look for the suprogram renaming declaration built -- for a generic actual subprogram. Unclear why -- Original_Node call is needed, but sometimes it is. diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 9cff9e1be16..01be86cb41f 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -7386,6 +7386,11 @@ package body Sem_Util is Decl := Parent (Decl); end loop; + -- cope with oddness in definition of N_Declaration + if Nkind (Decl) in N_Subprogram_Specification then + Decl := Parent (Decl); + end if; + return Decl; end Enclosing_Declaration; -- 2.43.0
[COMMITTED] ada: Remove unreachable code in Resolve_Extension_Aggregate
From: Eric Botcazou
The only functions using the BIP protocol are now those returning a limited
type: Is_Build_In_Place_Result_Type => Is_Inherently_Limited_Type.
gcc/ada/
* sem_aggr.adb (Resolve_Extension_Aggregate): Remove the unreachable
call to Transform_BIP_Assignment as well as the procedure.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_aggr.adb | 39 +--
1 file changed, 1 insertion(+), 38 deletions(-)
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 1027acf20b5..f586c18e655 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -31,7 +31,6 @@ with Einfo.Utils;use Einfo.Utils;
with Elists; use Elists;
with Errout; use Errout;
with Expander; use Expander;
-with Exp_Ch6;use Exp_Ch6;
with Exp_Tss;use Exp_Tss;
with Exp_Util; use Exp_Util;
with Freeze; use Freeze;
@@ -4232,11 +4231,6 @@ package body Sem_Aggr is
-- Verify that the type of the ancestor part is a non-private ancestor
-- of the expected type, which must be a type extension.
- procedure Transform_BIP_Assignment (Typ : Entity_Id);
- -- For an extension aggregate whose ancestor part is a build-in-place
- -- call returning a nonlimited type, this is used to transform the
- -- assignment to the ancestor part to use a temp.
-
-- Valid_Limited_Ancestor --
@@ -4328,26 +4322,6 @@ package body Sem_Aggr is
return False;
end Valid_Ancestor_Type;
- --
- -- Transform_BIP_Assignment --
- --
-
- procedure Transform_BIP_Assignment (Typ : Entity_Id) is
- Loc : constant Source_Ptr := Sloc (N);
- Def_Id : constant Entity_Id := Make_Temporary (Loc, 'Y', A);
- Obj_Decl : constant Node_Id:=
- Make_Object_Declaration (Loc,
-Defining_Identifier => Def_Id,
-Constant_Present=> True,
-Object_Definition => New_Occurrence_Of (Typ, Loc),
-Expression => A,
-Has_Init_Expression => True);
- begin
- Set_Etype (Def_Id, Typ);
- Set_Ancestor_Part (N, New_Occurrence_Of (Def_Id, Loc));
- Insert_Action (N, Obj_Decl);
- end Transform_BIP_Assignment;
-
-- Start of processing for Resolve_Extension_Aggregate
begin
@@ -4521,19 +4495,8 @@ package body Sem_Aggr is
-- an AdaCore query to the ARG after this test was added.
Error_Msg_N ("ancestor part must be statically tagged", A);
-else
- -- We are using the build-in-place protocol, but we can't build
- -- in place, because we need to call the function before
- -- allocating the aggregate. Could do better for null
- -- extensions, and maybe for nondiscriminated types.
- -- This is wrong for limited, but those were wrong already.
-
- if not Is_Inherently_Limited_Type (A_Type)
- and then Is_Build_In_Place_Function_Call (A)
- then
- Transform_BIP_Assignment (A_Type);
- end if;
+else
Resolve_Record_Aggregate (N, Typ);
end if;
end if;
--
2.43.0
[COMMITTED] ada: Cannot requeue to a procedure implemented by an entry
From: Javier Miranda Add missing support for RM 9.5.4(5.6/4): the target of a requeue statement may be a procedure when its name denotes a renaming of an entry. gcc/ada/ * sem_ch6.adb (Analyze_Subprogram_Specification): Do not replace the type of the formals with its corresponding record in init-procs. * sem_ch9.adb (Analyze_Requeue): Add missing support to requeue to a procedure that denotes a renaming of an entry. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_ch6.adb | 1 + gcc/ada/sem_ch9.adb | 26 ++ 2 files changed, 27 insertions(+) diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index bdfe446d014..8a7dfef9019 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -5373,6 +5373,7 @@ package body Sem_Ch6 is if Ada_Version >= Ada_2005 and then not Is_Invariant_Procedure_Or_Body (Designator) + and then not Is_Init_Proc (Designator) then declare Formal : Entity_Id; diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index 365887cbe14..8e6ba4c6b81 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -2438,6 +2438,32 @@ package body Sem_Ch9 is Entry_Name := Selector_Name (Entry_Name); end if; + -- Ada 2012 (9.5.4(5.6/4): "If the target is a procedure, the name + -- shall denote a renaming of an entry or ...". We support this + -- language rule replacing the target procedure with the renamed + -- entry. Thus, reanalyzing the resulting requeue statement we + -- reuse all the Ada 2005 machinery to perform the analysis. + + if Nkind (Entry_Name) in N_Has_Entity then + declare +Target_E : constant Entity_Id := Entity (Entry_Name); + + begin +if Ada_Version >= Ada_2012 + and then Ekind (Target_E) = E_Procedure + and then Convention (Target_E) = Convention_Entry + and then Nkind (Original_Node (Parent (Parent (Target_E + = N_Subprogram_Renaming_Declaration +then + Set_Name (N, + New_Copy_Tree + (Name (Original_Node (Parent (Parent (Target_E)); + Analyze_Requeue (N); + return; +end if; + end; + end if; + -- If an explicit target object is given then we have to check the -- restrictions of 9.5.4(6). -- 2.43.0
[COMMITTED] ada: Minor change replacing "not Present" tests with "No" tests
From: Gary Dismukes Fixing two places flagged by gnatcheck to use "No" instead of "not Present". gcc/ada/ * exp_aggr.adb (Expand_Container_Aggregate): Change "not Present" tests to tests using "No" (in two places). Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_aggr.adb | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 6fceda3ceff..25215cb8499 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -7047,7 +7047,7 @@ package body Exp_Aggr is -- Determine whether this is an indexed aggregate (see RM 4.3.5(25/5)). if Present (New_Indexed_Subp) then - if not Present (Add_Unnamed_Subp) then + if No (Add_Unnamed_Subp) then Is_Indexed_Aggregate := True; else @@ -7226,7 +7226,7 @@ package body Exp_Aggr is end Expand_Range_Component; begin -pragma Assert (not Present (Expressions (N))); +pragma Assert (No (Expressions (N))); if Siz > 0 then -- 2.43.0
[COMMITTED] ada: Excess elements created for indexed aggregates with iterator_specifications
From: Gary Dismukes
In the case of an indexed aggregate of a container type with both Add_Unnamed
and New_Indexed specified in the Aggregate aspect of the type (such as for
the Vector type in Ada.Containers.Vectors), in cases where a component
association is given by an iterator_specification, the compiler could end
up generating a call to the New_Indexed operation rather than the Empty
operation. For example, in the case of a Vector type, this could result
in allocating a container of the size of the defaulted Capacity formal of
the New_Vector function (with uninitialized components), and elements added
in the aggregate would append to that preallocated Vector. The compiler is
corrected so that the Empty function is called to initialize the implicit
aggregate object, rather than the New_Indexed function.
gcc/ada/
* exp_aggr.adb (Expand_Container_Aggregate): Add code to determine
whether the aggregate is an indexed aggregate, setting a flag
(Is_Indexed_Aggregate), which is tested to have proper separation
of treatment for the Add_Unnamed
(for positional aggregates) and New_Indexed (for indexed
aggregates) cases. In the code generating associations for indexed
aggregates, remove the code for Expressions cases entirely, since
the code for indexed aggregates is governed by the presence of
Component_Associations, and add an assertion that Expressions must
be Empty. Also, exclude empty aggregates from entering that code.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_aggr.adb | 151 ++-
1 file changed, 77 insertions(+), 74 deletions(-)
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 50063ed819e..6fceda3ceff 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6606,6 +6606,8 @@ package body Exp_Aggr is
Siz_Exp: Node_Id := Empty;
Count_Type : Entity_Id;
+ Is_Indexed_Aggregate : Boolean := False;
+
function Aggregate_Size return Int;
-- Compute number of entries in aggregate, including choices
-- that cover a range or subtype, as well as iterated constructs.
@@ -7042,6 +7044,35 @@ package body Exp_Aggr is
("\this will result in infinite recursion??", Parent (N));
end if;
+ -- Determine whether this is an indexed aggregate (see RM 4.3.5(25/5)).
+
+ if Present (New_Indexed_Subp) then
+ if not Present (Add_Unnamed_Subp) then
+Is_Indexed_Aggregate := True;
+
+ else
+declare
+ Comp_Assns : constant List_Id := Component_Associations (N);
+ Comp_Assn : Node_Id;
+
+begin
+ if Present (Comp_Assns)
+ and then not Is_Empty_List (Comp_Assns)
+ then
+ Comp_Assn := First (Comp_Assns);
+
+ if Nkind (Comp_Assn) = N_Component_Association
+or else
+ (Nkind (Comp_Assn) = N_Iterated_Component_Association
+and then Present (Defining_Identifier (Comp_Assn)))
+ then
+ Is_Indexed_Aggregate := True;
+ end if;
+ end if;
+end;
+ end if;
+ end if;
+
---
-- Positional aggregate --
---
@@ -7068,12 +7099,11 @@ package body Exp_Aggr is
Next (Comp);
end loop;
end;
- end if;
-- Indexed aggregates are handled below. Unnamed aggregates
-- such as sets may include iterated component associations.
- if No (New_Indexed_Subp) then
+ elsif not Is_Indexed_Aggregate then
Comp := First (Component_Associations (N));
while Present (Comp) loop
if Nkind (Comp) = N_Iterated_Component_Association then
@@ -7128,15 +7158,16 @@ package body Exp_Aggr is
-- Indexed_Aggregate --
---
- -- For an indexed aggregate there must be an Assigned_Indexeed
+ -- For an indexed aggregate there must be an Assigned_Indexed
-- subprogram. Note that unlike array aggregates, a container
-- aggregate must be fully positional or fully indexed. In the
-- first case the expansion has already taken place.
-- TBA: the keys for an indexed aggregate must provide a dense
-- range with no repetitions.
- if Present (Assign_Indexed_Subp)
+ if Is_Indexed_Aggregate
and then Present (Component_Associations (N))
+and then not Is_Empty_List (Component_Associations (N))
then
declare
Insert : constant Entity_Id := Entity (Assign_Indexed_Subp);
@@ -7153,7 +7184,6 @@ package body Exp_Aggr is
Comp : Node_Id;
Index : Node_Id;
-Pos: Int := 0;
[COMMITTED] ada: Add __atomic_store_n binding to System.Atomic_Primitives
From: Eric Botcazou
This is modeled on the existing binding for __atomic_load_n.
gcc/ada/
* libgnat/s-atopri.ads (Atomic_Store): New generic procedure.
(Atomic_Store_8): New instantiated procedure.
(Atomic_Store_16): Likewise.
(Atomic_Store_32): Likewise.
(Atomic_Store_64): Likewise.
* libgnat/s-atopri__32.ads (Atomic_Store): New generic procedure.
(Atomic_Store_8): New instantiated procedure.
(Atomic_Store_16): Likewise.
(Atomic_Store_32): Likewise.
* gcc-interface/decl.cc (gnat_to_gnu_subprog_type): Implement the
support for __atomic_store_n and __sync_bool_compare_and_swap_n.
* gcc-interface/gigi.h (list_second): New inline function.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/gcc-interface/decl.cc| 24 ++--
gcc/ada/gcc-interface/gigi.h | 8
gcc/ada/libgnat/s-atopri.ads | 13 +
gcc/ada/libgnat/s-atopri__32.ads | 12
4 files changed, 55 insertions(+), 2 deletions(-)
diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
index c3d2de22b65..89a374fab1a 100644
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -6504,6 +6504,28 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool
definition,
}
break;
+ case BUILT_IN_SYNC_BOOL_COMPARE_AND_SWAP_N:
+ case BUILT_IN_ATOMIC_STORE_N:
+ /* This is a generic builtin overloaded on its second
+parameter type, so do type resolution based on it. */
+ if (list_length (gnu_param_type_list) >= 3
+ && type_for_atomic_builtin_p
+ (list_second (gnu_param_type_list)))
+ gnu_builtin_decl
+ = resolve_atomic_builtin
+ (fncode, list_second (gnu_param_type_list));
+ else
+ {
+ post_error
+ ("??cannot import type-generic 'G'C'C builtin!",
+gnat_subprog);
+ post_error
+ ("\\?use a supported second parameter type",
+gnat_subprog);
+ gnu_builtin_decl = NULL_TREE;
+ }
+ break;
+
case BUILT_IN_ATOMIC_COMPARE_EXCHANGE_N:
/* This is a generic builtin overloaded on its third
parameter type, so do type resolution based on it. */
@@ -6525,9 +6547,7 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool
definition,
}
break;
- case BUILT_IN_SYNC_BOOL_COMPARE_AND_SWAP_N:
case BUILT_IN_SYNC_LOCK_RELEASE_N:
- case BUILT_IN_ATOMIC_STORE_N:
post_error
("??unsupported type-generic 'G'C'C builtin!",
gnat_subprog);
diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
index 63ccf311c23..2a7320f0a4b 100644
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/gcc/ada/gcc-interface/gigi.h
@@ -1238,6 +1238,14 @@ operand_type (tree expr)
return TREE_TYPE (TREE_OPERAND (expr, 0));
}
+/* Return the second value of a list. */
+
+static inline tree
+list_second (tree list)
+{
+ return TREE_VALUE (TREE_CHAIN (list));
+}
+
/* Return the third value of a list. */
static inline tree
diff --git a/gcc/ada/libgnat/s-atopri.ads b/gcc/ada/libgnat/s-atopri.ads
index 8ee2e371f6f..f742812bb22 100644
--- a/gcc/ada/libgnat/s-atopri.ads
+++ b/gcc/ada/libgnat/s-atopri.ads
@@ -78,6 +78,19 @@ package System.Atomic_Primitives is
function Atomic_Load_32 is new Atomic_Load (uint32);
function Atomic_Load_64 is new Atomic_Load (uint64);
+ generic
+ type Atomic_Type is mod <>;
+ procedure Atomic_Store
+ (Ptr : Address;
+ Value : Atomic_Type;
+ Model : Mem_Model := Seq_Cst);
+ pragma Import (Intrinsic, Atomic_Store, "__atomic_store_n");
+
+ procedure Atomic_Store_8 is new Atomic_Store (uint8);
+ procedure Atomic_Store_16 is new Atomic_Store (uint16);
+ procedure Atomic_Store_32 is new Atomic_Store (uint32);
+ procedure Atomic_Store_64 is new Atomic_Store (uint64);
+
generic
type Atomic_Type is mod <>;
function Atomic_Compare_Exchange
diff --git a/gcc/ada/libgnat/s-atopri__32.ads b/gcc/ada/libgnat/s-atopri__32.ads
index 1281e9bea31..419ca179c43 100644
--- a/gcc/ada/libgnat/s-atopri__32.ads
+++ b/gcc/ada/libgnat/s-atopri__32.ads
@@ -76,6 +76,18 @@ package System.Atomic_Primitives is
function Atomic_Load_16 is new Atomic_Load (uint16);
function Atomic_Load_32 is new Atomic_Load (uint32);
+ generic
+ type Atomic_Type is mod <>;
+ proc
[COMMITTED] ada: Remove side effects depending on the context of subtype declaration
From: Piotr Trojanek In GNATprove mode the removal of side effects is only needed in certain syntactic contexts, which include subtype declarations. Now this removal is limited to genuine subtype declarations and not to itypes coming from expressions where side effects are not expected. gcc/ada/ * exp_util.adb (Possible_Side_Effect_In_SPARK): Refine handling of itype declarations. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_util.adb | 74 +--- 1 file changed, 63 insertions(+), 11 deletions(-) diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index b9346a9f405..1df63ed38c8 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -12012,19 +12012,71 @@ package body Exp_Util is function Possible_Side_Effect_In_SPARK (Exp : Node_Id) return Boolean is begin --- Side-effect removal in SPARK should only occur when not inside a --- generic and not doing a preanalysis, inside an object renaming or --- a type declaration or a for-loop iteration scheme. + -- Side-effect removal in SPARK should only occur when not inside a + -- generic and not doing a preanalysis, inside an object renaming or + -- a type declaration or a for-loop iteration scheme. - return not Inside_A_Generic + if not Inside_A_Generic and then Full_Analysis - and then Nkind (Enclosing_Declaration (Exp)) in - N_Component_Declaration -| N_Full_Type_Declaration -| N_Iterator_Specification -| N_Loop_Parameter_Specification -| N_Object_Renaming_Declaration -| N_Subtype_Declaration; + then + +case Nkind (Enclosing_Declaration (Exp)) is + when N_Component_Declaration + | N_Full_Type_Declaration + | N_Iterator_Specification + | N_Loop_Parameter_Specification + | N_Object_Renaming_Declaration + => + return True; + + -- If the expression belongs to an itype declaration, then + -- check if side effects are allowed in the original + -- associated node. + + when N_Subtype_Declaration => + declare + Subt : constant Entity_Id := + Defining_Identifier (Enclosing_Declaration (Exp)); + begin + if Is_Itype (Subt) then + +-- When this routine is called while the itype +-- is being created, the entity might not yet be +-- decorated with the associated node, but should +-- have the related expression. + +if Present (Associated_Node_For_Itype (Subt)) then + return + Possible_Side_Effect_In_SPARK + (Associated_Node_For_Itype (Subt)); + +elsif Present (Related_Expression (Subt)) then + return + Possible_Side_Effect_In_SPARK + (Related_Expression (Subt)); + +-- When the itype doesn't have any indication of its +-- origin (which currently only happens for packed +-- array types created by freezing that shouldn't +-- be picked by GNATprove anyway), then we can +-- conservatively assume that the expression can +-- be kept as it appears in the source code. + +else + pragma Assert (Is_Packed_Array_Impl_Type (Subt)); + return False; +end if; + else +return True; + end if; + end; + + when others => + return False; +end case; + else +return False; + end if; end Possible_Side_Effect_In_SPARK; -- Local variables -- 2.43.0
[COMMITTED] ada: Remove dead code for GNATprove inlining
From: Piotr Trojanek
Removed code was dead because it could only be executed when
Back_End_Inlining is True and that flag is always false in
GNATprove_Mode.
gcc/ada/
* inline.adb (Cannot_Inline): Cleanup use of 'Length; remove
dead code.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/inline.adb | 15 ++-
1 file changed, 2 insertions(+), 13 deletions(-)
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index cc2bc3ac18a..f6bed4d26e3 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -1983,9 +1983,9 @@ package body Inline is
then
declare
Len1 : constant Positive :=
- String (String'("cannot inline"))'Length;
+ String'("cannot inline")'Length;
Len2 : constant Positive :=
- String (String'("info: no contextual analysis of"))'Length;
+ String'("info: no contextual analysis of")'Length;
New_Msg : String (1 .. Msg'Length + Len2 - Len1);
@@ -2044,17 +2044,6 @@ package body Inline is
Error_Msg_NE (Msg (Msg'First .. Msg'Last - 1), N, Subp);
- -- In GNATprove mode, issue an info message when -gnatd_f is set and
- -- Suppress_Info is False, and indicate that the subprogram is not
- -- always inlined by setting flag Is_Inlined_Always to False.
-
- elsif GNATprove_Mode then
- Set_Is_Inlined_Always (Subp, False);
-
- if Debug_Flag_Underscore_F and not Suppress_Info then
-Error_Msg_NE (Msg, N, Subp);
- end if;
-
else
-- Do not emit warning if this is a predefined unit which is not
--
2.43.0
[COMMITTED] ada: Fix limited_with in Check_Scil; allow for <> in pp of aggregate
From: Tucker Taft Check_Scil failed due to not handling a type that came from a package that was mentioned in a limited-with clause. Also, an aggregate with an uninitialized component was not being pretty-printed properly. gcc/ada/ * pprint.adb (List_Name): Check for "Box_Present" when displaying a list, and emit "<>" if returns True. * sem_scil.adb (Check_SCIL_Node): Handle case when the type of a parameter is from a package that was mentioned in a limited with clause, and make no further checks, since this check routine does not have all the logic to check such a usage. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/pprint.adb | 6 +- gcc/ada/sem_scil.adb | 1 + 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/gcc/ada/pprint.adb b/gcc/ada/pprint.adb index 3843ec203b0..2a8f2f653f7 100644 --- a/gcc/ada/pprint.adb +++ b/gcc/ada/pprint.adb @@ -130,7 +130,11 @@ package body Pprint is end loop; end; Append (Buf, " => "); - Append (Buf, Expr_Name (Expression (Elmt))); + if Box_Present (Elmt) then + Append (Buf, "<>"); + else + Append (Buf, Expr_Name (Expression (Elmt))); + end if; -- Print parameter_association as "x => 12345" diff --git a/gcc/ada/sem_scil.adb b/gcc/ada/sem_scil.adb index d7679d8b50f..d720386c6af 100644 --- a/gcc/ada/sem_scil.adb +++ b/gcc/ada/sem_scil.adb @@ -98,6 +98,7 @@ package body Sem_SCIL is -- Interface types are unsupported. if Is_Interface (Ctrl_Typ) + or else From_Limited_With (Ctrl_Typ) or else Is_RTE (Ctrl_Typ, RE_Interface_Tag) or else (Is_Access_Type (Ctrl_Typ) and then -- 2.43.0
[COMMITTED] ada: Fix internal error on class-wide allocator inside if-expression
From: Eric Botcazou The problem is that the freeze node for the class-wide subtype built for the expression of the allocator escapes from the dependent expression instead of being stored in its list of actions. gcc/ada/ * freeze.adb (Freeze_Expression.Has_Decl_In_List): Deal specifically with itypes that are class-wide subtypes. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/freeze.adb | 13 +++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 26b5589a020..468d6ee6dbe 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -8141,10 +8141,19 @@ package body Freeze is Decl_Node : Node_Id; begin - -- If E is an itype, pretend that it is declared in N + -- If E is an itype, pretend that it is declared in N except for a + -- class-wide subtype with an equivalent type, because this latter + -- type comes with a bona-fide declaration node. if Is_Itype (E) then -Decl_Node := N; +if Ekind (E) = E_Class_Wide_Subtype + and then Present (Equivalent_Type (E)) +then + Decl_Node := Declaration_Node (Equivalent_Type (E)); +else + Decl_Node := N; +end if; + else Decl_Node := Declaration_Node (E); end if; -- 2.43.0
[COMMITTED] ada: Remove dead detection of recursive inlined subprograms
From: Piotr Trojanek
Inlining of subprogram calls happens in routine Expand_Inlined_Call
which calls Establish_Actual_Mapping_For_Inlined_Call. Both routines
had detection of recursive calls. The detection in the second routine
was dead code.
gcc/ada/
* inline.adb (Establish_Actual_Mapping_For_Inlined_Call):
Remove detection of recursive calls.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/inline.adb | 19 ---
1 file changed, 19 deletions(-)
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index f6bed4d26e3..dffd6293394 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -2988,25 +2988,6 @@ package body Inline is
F := First_Formal (Subp);
A := First_Actual (N);
while Present (F) loop
- if Present (Renamed_Object (F)) then
-
--- If expander is active, it is an error to try to inline a
--- recursive subprogram. In GNATprove mode, just indicate that the
--- inlining will not happen, and mark the subprogram as not always
--- inlined.
-
-if GNATprove_Mode then
- Cannot_Inline
- ("cannot inline call to recursive subprogram?", N, Subp);
- Set_Is_Inlined_Always (Subp, False);
-else
- Error_Msg_N
- ("cannot inline call to recursive subprogram", N);
-end if;
-
-return;
- end if;
-
-- Reset Last_Assignment for any parameters of mode out or in out, to
-- prevent spurious warnings about overwriting for assignments to the
-- formal in the inlined code.
--
2.43.0
[COMMITTED] ada: Preliminary cleanup in aliasing support code
From: Eric Botcazou
This declares an explicit temporary for the fields of the fat pointer type
in gnat_to_gnu_entity and removes the GNU_ prefix of the parameters of the
relate_alias_sets routine for the sake of brevity. No functional changes.
gcc/ada/
* gcc-interface/decl.cc (gnat_to_gnu_entity) : Use a
separate FLD local variable to hold the first field of the fat
pointer type being built.
* gcc-interface/gigi.h (relate_alias_sets): Remove GNU_ prefix on
the first two parameters.
* gcc-interface/utils.cc (relate_alias_sets): Likewise and adjust.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/gcc-interface/decl.cc | 27 +--
gcc/ada/gcc-interface/gigi.h | 4 +--
gcc/ada/gcc-interface/utils.cc | 48 --
3 files changed, 38 insertions(+), 41 deletions(-)
diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
index 89a374fab1a..221baebb554 100644
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -2111,7 +2111,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr,
bool definition)
tree *gnu_index_types = XALLOCAVEC (tree, ndim);
tree *gnu_temp_fields = XALLOCAVEC (tree, ndim);
tree gnu_max_size = size_one_node;
- tree comp_type, tem, obj;
+ tree comp_type, fld, tem, obj;
Entity_Id gnat_index;
alias_set_type ptr_set = -1;
int index;
@@ -2184,11 +2184,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree
gnu_expr, bool definition)
if the FIELD_DECLs are distinct as objects. */
if (COMPLETE_TYPE_P (gnu_fat_type))
{
- tem = TYPE_FIELDS (gnu_fat_type);
- if (TYPE_ALIAS_SET_KNOWN_P (TREE_TYPE (tem)))
- ptr_set = TYPE_ALIAS_SET (TREE_TYPE (tem));
- TREE_TYPE (tem) = ptr_type_node;
- TREE_TYPE (DECL_CHAIN (tem)) = gnu_ptr_template;
+ fld = TYPE_FIELDS (gnu_fat_type);
+ if (TYPE_ALIAS_SET_KNOWN_P (TREE_TYPE (fld)))
+ ptr_set = TYPE_ALIAS_SET (TREE_TYPE (fld));
+ TREE_TYPE (fld) = ptr_type_node;
+ TREE_TYPE (DECL_CHAIN (fld)) = gnu_ptr_template;
TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (gnu_fat_type)) = 0;
for (tree t = gnu_fat_type; t; t = TYPE_NEXT_VARIANT (t))
SET_TYPE_UNCONSTRAINED_ARRAY (t, gnu_type);
@@ -2197,15 +2197,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree
gnu_expr, bool definition)
{
/* We make the fields addressable for the sake of compatibility
with languages for which the regular fields are addressable. */
- tem
+ fld
= create_field_decl (get_identifier ("P_ARRAY"),
ptr_type_node, gnu_fat_type,
NULL_TREE, NULL_TREE, 0, 1);
- DECL_CHAIN (tem)
+ DECL_CHAIN (fld)
= create_field_decl (get_identifier ("P_BOUNDS"),
gnu_ptr_template, gnu_fat_type,
NULL_TREE, NULL_TREE, 0, 1);
- finish_fat_pointer_type (gnu_fat_type, tem);
+ finish_fat_pointer_type (gnu_fat_type, fld);
SET_TYPE_UNCONSTRAINED_ARRAY (gnu_fat_type, gnu_type);
}
@@ -2230,7 +2230,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr,
bool definition)
fields once we build them. */
tem = build3 (COMPONENT_REF, gnu_ptr_template,
build0 (PLACEHOLDER_EXPR, gnu_fat_type),
- DECL_CHAIN (TYPE_FIELDS (gnu_fat_type)), NULL_TREE);
+ DECL_CHAIN (fld), NULL_TREE);
gnu_template_reference
= build_unary_op (INDIRECT_REF, gnu_template_type, tem);
TREE_READONLY (gnu_template_reference) = 1;
@@ -2413,12 +2413,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree
gnu_expr, bool definition)
type since the implementation type may vary between constrained
subtypes and unconstrained base type. */
if (Present (PAT))
- TREE_TYPE (TYPE_FIELDS (gnu_fat_type))
- = build_pointer_type_for_mode (tem, ptr_mode, true);
+ TREE_TYPE (fld) = build_pointer_type_for_mode (tem, ptr_mode, true);
else
- TREE_TYPE (TYPE_FIELDS (gnu_fat_type)) = build_pointer_type (tem);
+ TREE_TYPE (fld) = build_pointer_type (tem);
if (ptr_set != -1)
- TYPE_ALIAS_SET (TREE_TYPE (TYPE_FIELDS (gnu_fat_type))) = ptr_set;
+ TYPE_ALIAS_SET (TREE_TYPE (fld)) = ptr_set;
/* If the maximum size doesn't overflow, use it. */
if (gnu_max_size
diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
index 2a7320f0a4b..c1bc237e68e 100644
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/gcc/ada/gcc-interface/gigi.h
@@ -158,14 +158,14 @@ enum alias_set_op
ALIAS_SET_SUPERSET
};
[COMMITTED] ada: More aggressive inlining of subprogram calls in GNATprove mode
From: Piotr Trojanek Previously if a subprogram call could not be inlined in GNATprove mode, then all subsequent calls to the same subprogram were not inlined either (because a failed attempt to inline clears flag Is_Inlined_Always and we tested this flag when attempting to inline subsequent calls). Now a failure in inlining of a particular call does not prevent inlining of subsequent calls to the same subprogram, except when inlining failed because the subprogram was detected to be recursive (which clears the Is_Inlined flag that we now examine). This change allows more checks to be proved and reduces interactions between inlining and SPARK legality checks. gcc/ada/ * sem_ch6.adb (Analyze_Subprogram_Specification): Set Is_Inlined flag by default in GNATprove mode. * sem_res.adb (Resolve_Call): Only look at flag which is cleared when inlined subprogram is detected to be recursive. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_ch6.adb | 5 - gcc/ada/sem_res.adb | 11 +++ 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index da6f6c40c92..bdfe446d014 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -5325,10 +5325,13 @@ package body Sem_Ch6 is -- Flag Is_Inlined_Always is True by default, and reversed to False for -- those subprograms which could be inlined in GNATprove mode (because - -- Body_To_Inline is non-Empty) but should not be inlined. + -- Body_To_Inline is non-Empty) but should not be inlined. Flag + -- Is_Inlined is True by default and reversed to False when inlining + -- fails because the subprogram is detected to be recursive. if GNATprove_Mode then Set_Is_Inlined_Always (Designator); + Set_Is_Inlined (Designator); end if; -- Introduce new scope for analysis of the formals and the return type diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index d81a5af9032..cfcbb94af89 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -7193,7 +7193,7 @@ package body Sem_Res is -- In GNATprove mode, expansion is disabled, but we want to inline some -- subprograms to facilitate formal verification. Indirect calls through -- a subprogram type or within a generic cannot be inlined. Inlining is - -- performed only for calls subject to SPARK_Mode on. + -- performed only for calls subject to SPARK_Mode => On. elsif GNATprove_Mode and then SPARK_Mode = On @@ -7206,10 +7206,13 @@ package body Sem_Res is if Nkind (Nam_Decl) = N_Subprogram_Declaration then Body_Id := Corresponding_Body (Nam_Decl); --- Nothing to do if the subprogram is not eligible for inlining in --- GNATprove mode, or inlining is disabled with switch -gnatdm +-- Nothing to do if the subprogram is not inlined (because it is +-- recursive, directly or indirectly), or is not eligible for +-- inlining GNATprove mode (because of properties of the +-- subprogram itself), or inlining has been disabled with switch +-- -gnatdm. -if not Is_Inlined_Always (Nam_UA) +if not Is_Inlined (Nam_UA) or else not Can_Be_Inlined_In_GNATprove_Mode (Nam_UA, Body_Id) or else Debug_Flag_M then -- 2.43.0
[COMMITTED] ada: Remove unused runtime entity
From: Eric Botcazou The compiler has not generated direct attachments for a long time. gcc/ada/ * rtsfind.ads (RE_Id): Remove RE_Attach. (RE_Unit_Table): Likewise. * libgnat/s-finmas.ads (Attach): Delete. * libgnat/s-finmas.adb (Attach): Likewise. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnat/s-finmas.adb | 14 -- gcc/ada/libgnat/s-finmas.ads | 4 gcc/ada/rtsfind.ads | 2 -- 3 files changed, 20 deletions(-) diff --git a/gcc/ada/libgnat/s-finmas.adb b/gcc/ada/libgnat/s-finmas.adb index 30927a4fb21..a231b6bd874 100644 --- a/gcc/ada/libgnat/s-finmas.adb +++ b/gcc/ada/libgnat/s-finmas.adb @@ -70,20 +70,6 @@ package body System.Finalization_Masters is return System.Storage_Elements."+" (Addr, Offset); end Add_Offset_To_Address; - - -- Attach -- - - - procedure Attach (N : not null FM_Node_Ptr; L : not null FM_Node_Ptr) is - begin - Lock_Task.all; - Attach_Unprotected (N, L); - Unlock_Task.all; - - -- Note: No need to unlock in case of an exception because the above - -- code can never raise one. - end Attach; - -- Attach_Unprotected -- diff --git a/gcc/ada/libgnat/s-finmas.ads b/gcc/ada/libgnat/s-finmas.ads index 45faf45b02e..404b67171c2 100644 --- a/gcc/ada/libgnat/s-finmas.ads +++ b/gcc/ada/libgnat/s-finmas.ads @@ -71,10 +71,6 @@ package System.Finalization_Masters is type Finalization_Master_Ptr is access all Finalization_Master; for Finalization_Master_Ptr'Storage_Size use 0; - procedure Attach (N : not null FM_Node_Ptr; L : not null FM_Node_Ptr); - -- Compiler interface, do not call from within the run-time. Prepend a - -- node to a specific finalization master. - procedure Attach_Unprotected (N : not null FM_Node_Ptr; L : not null FM_Node_Ptr); diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 669f6df79cb..33e8472ae06 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -918,7 +918,6 @@ package Rtsfind is RE_Attr_Long_Long_Float,-- System.Fat_LLF RE_Add_Offset_To_Address, -- System.Finalization_Masters - RE_Attach, -- System.Finalization_Masters RE_Base_Pool, -- System.Finalization_Masters RE_Finalization_Master, -- System.Finalization_Masters RE_Finalization_Master_Ptr, -- System.Finalization_Masters @@ -2563,7 +2562,6 @@ package Rtsfind is RE_Attr_Long_Long_Float => System_Fat_LLF, RE_Add_Offset_To_Address=> System_Finalization_Masters, - RE_Attach => System_Finalization_Masters, RE_Base_Pool=> System_Finalization_Masters, RE_Finalization_Master => System_Finalization_Masters, RE_Finalization_Master_Ptr => System_Finalization_Masters, -- 2.43.0
[COMMITTED] ada: Allow passing private types to generic formal incomplete types
From: Bob Duff
It is legal to pass a private type, or a type with a component whose
type is private, as a generic actual type if the formal is a generic
formal incomplete type. This patch fixes a bug in which the compiler
would give an error in some such cases.
Also misc cleanup.
gcc/ada/
* sem_ch12.adb (Instantiate_Type): Make the relevant error message
conditional upon "Ekind (A_Gen_T) /= E_Incomplete_Type". Misc
cleanup.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_ch12.adb | 156 +--
1 file changed, 76 insertions(+), 80 deletions(-)
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 5bddb5a8556..1d17cfacec3 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -14186,124 +14186,120 @@ package body Sem_Ch12 is
if Get_Instance_Of (A_Gen_T) /= A_Gen_T then
Error_Msg_N ("duplicate instantiation of generic type", Actual);
return New_List (Error);
+ end if;
- elsif not Is_Entity_Name (Actual)
+ if not Is_Entity_Name (Actual)
or else not Is_Type (Entity (Actual))
then
Error_Msg_NE
("expect valid subtype mark to instantiate &", Actual, Gen_T);
Abandon_Instantiation (Actual);
+ end if;
- else
- Act_T := Entity (Actual);
+ Act_T := Entity (Actual);
- -- Ada 2005 (AI-216): An Unchecked_Union subtype shall only be passed
- -- as a generic actual parameter if the corresponding formal type
- -- does not have a known_discriminant_part, or is a formal derived
- -- type that is an Unchecked_Union type.
+ -- Ada 2005 (AI-216): An Unchecked_Union subtype shall only be passed
+ -- as a generic actual parameter if the corresponding formal type
+ -- does not have a known_discriminant_part, or is a formal derived
+ -- type that is an Unchecked_Union type.
- if Is_Unchecked_Union (Base_Type (Act_T)) then
-if not Has_Discriminants (A_Gen_T)
- or else (Is_Derived_Type (A_Gen_T)
-and then Is_Unchecked_Union (A_Gen_T))
-then
- null;
-else
- Error_Msg_N ("unchecked union cannot be the actual for a "
-& "discriminated formal type", Act_T);
+ if Is_Unchecked_Union (Base_Type (Act_T)) then
+ if not Has_Discriminants (A_Gen_T)
+ or else (Is_Derived_Type (A_Gen_T)
+ and then Is_Unchecked_Union (A_Gen_T))
+ then
+null;
+ else
+Error_Msg_N ("unchecked union cannot be the actual for a "
+ & "discriminated formal type", Act_T);
-end if;
end if;
+ end if;
- -- Deal with fixed/floating restrictions
+ -- Deal with fixed/floating restrictions
- if Is_Floating_Point_Type (Act_T) then
-Check_Restriction (No_Floating_Point, Actual);
- elsif Is_Fixed_Point_Type (Act_T) then
-Check_Restriction (No_Fixed_Point, Actual);
- end if;
+ if Is_Floating_Point_Type (Act_T) then
+ Check_Restriction (No_Floating_Point, Actual);
+ elsif Is_Fixed_Point_Type (Act_T) then
+ Check_Restriction (No_Fixed_Point, Actual);
+ end if;
- -- Deal with error of using incomplete type as generic actual.
- -- This includes limited views of a type, even if the non-limited
- -- view may be available.
+ -- Deal with error of using incomplete type as generic actual.
+ -- This includes limited views of a type, even if the non-limited
+ -- view may be available.
- if Ekind (Act_T) = E_Incomplete_Type
- or else (Is_Class_Wide_Type (Act_T)
- and then Ekind (Root_Type (Act_T)) = E_Incomplete_Type)
- then
--- If the formal is an incomplete type, the actual can be
--- incomplete as well, but if an actual incomplete type has
--- a full view, then we'll retrieve that.
+ if Ekind (Act_T) = E_Incomplete_Type
+or else (Is_Class_Wide_Type (Act_T)
+ and then Ekind (Root_Type (Act_T)) = E_Incomplete_Type)
+ then
+ -- If the formal is an incomplete type, the actual can be
+ -- incomplete as well, but if an actual incomplete type has
+ -- a full view, then we'll retrieve that.
-if Ekind (A_Gen_T) = E_Incomplete_Type
- and then No (Full_View (Act_T))
-then
- null;
+ if Ekind (A_Gen_T) = E_Incomplete_Type
+ and then No (Full_View (Act_T))
+ then
+null;
-elsif Is_Class_Wide_Type (Act_T)
- or else No (Full_View (Act_T))
-then
- Error_Msg_N ("premature use of incomplete type", Actual);
- Abandon_In
[COMMITTED] ada: Do not count comparison of addresses as a modification
From: Viljar Indus In some extended code we generate comparisons between the Addresses of some variables. This causes those variables to be considered modified. Whereas in this particular scenario the variables are just referenced. gcc/ada/ * sem_attr.adb: avoid marking a use of the Address attribute as a modification of its prefix. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_attr.adb | 8 ++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index a194360a601..f52103f28dd 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -12133,9 +12133,13 @@ package body Sem_Attr is | Attribute_Code_Address => -- To be safe, assume that if the address of a variable is taken, --- it may be modified via this address, so note modification. +-- it may be modified via this address, so note modification, +-- unless the address is compared directly, which should not be +-- considered a modification. -if Is_Variable (P) then +if Is_Variable (P) + and then Nkind (Parent (N)) not in N_Op_Compare +then Note_Possible_Modification (P, Sure => False); end if; -- 2.43.0
[COMMITTED] ada: Fix bogus Constraint_Error on allocator for access to array of access type
From: Eric Botcazou
This occurs because the access element type is not its own TYPE_CANONICAL,
which creates a discrepancy between the aliasing support code, which deals
with types directly, and the middle-end which looks at TYPE_CANONICAL only.
gcc/ada/
* gcc-interface/decl.cc (gnat_to_gnu_entity) : Use the
TYPE_CANONICAL of types when it comes to aliasing.
* gcc-interface/utils.cc (relate_alias_sets): Likewise.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/gcc-interface/decl.cc | 6 +++---
gcc/ada/gcc-interface/utils.cc | 3 ++-
2 files changed, 5 insertions(+), 4 deletions(-)
diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
index 221baebb554..93cfcb74fbf 100644
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -2185,8 +2185,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr,
bool definition)
if (COMPLETE_TYPE_P (gnu_fat_type))
{
fld = TYPE_FIELDS (gnu_fat_type);
- if (TYPE_ALIAS_SET_KNOWN_P (TREE_TYPE (fld)))
- ptr_set = TYPE_ALIAS_SET (TREE_TYPE (fld));
+ if (TYPE_ALIAS_SET_KNOWN_P (TYPE_CANONICAL (TREE_TYPE (fld
+ ptr_set = TYPE_ALIAS_SET (TYPE_CANONICAL (TREE_TYPE (fld)));
TREE_TYPE (fld) = ptr_type_node;
TREE_TYPE (DECL_CHAIN (fld)) = gnu_ptr_template;
TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (gnu_fat_type)) = 0;
@@ -2417,7 +2417,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr,
bool definition)
else
TREE_TYPE (fld) = build_pointer_type (tem);
if (ptr_set != -1)
- TYPE_ALIAS_SET (TREE_TYPE (fld)) = ptr_set;
+ TYPE_ALIAS_SET (TYPE_CANONICAL (TREE_TYPE (fld))) = ptr_set;
/* If the maximum size doesn't overflow, use it. */
if (gnu_max_size
diff --git a/gcc/ada/gcc-interface/utils.cc b/gcc/ada/gcc-interface/utils.cc
index bc063c20387..b3aae5bda52 100644
--- a/gcc/ada/gcc-interface/utils.cc
+++ b/gcc/ada/gcc-interface/utils.cc
@@ -1867,7 +1867,8 @@ relate_alias_sets (tree new_type, tree old_type, enum
alias_set_op op)
&& TYPE_NONALIASED_COMPONENT (new_type)
!= TYPE_NONALIASED_COMPONENT (old_type)));
- TYPE_ALIAS_SET (new_type) = get_alias_set (old_type);
+ /* The alias set always lives on the TYPE_CANONICAL. */
+ TYPE_ALIAS_SET (TYPE_CANONICAL (new_type)) = get_alias_set (old_type);
break;
case ALIAS_SET_SUBSET:
--
2.43.0
[COMMITTED] ada: Document new SPARK aspect and pragma Always_Terminates
From: Piotr Trojanek Add description of a recently added SPARK contract. gcc/ada/ * doc/gnat_rm/implementation_defined_aspects.rst, doc/gnat_rm/implementation_defined_pragmas.rst: Add sections for Always_Terminates. * gnat-style.texi: Regenerate. * gnat_rm.texi: Regenerate. * gnat_ugn.texi: Regenerate. --- .../doc/gnat_rm/implementation_defined_aspects.rst | 6 ++ .../doc/gnat_rm/implementation_defined_pragmas.rst | 14 ++ 2 files changed, 20 insertions(+) diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_aspects.rst b/gcc/ada/doc/gnat_rm/implementation_defined_aspects.rst index 3d90ad5b210..d58119b5fbc 100644 --- a/gcc/ada/doc/gnat_rm/implementation_defined_aspects.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_aspects.rst @@ -66,6 +66,12 @@ Aspect Abstract_State This aspect is equivalent to :ref:`pragma Abstract_State`. +Aspect Always_Terminates + +.. index:: Always_Terminates + +This boolean aspect is equivalent to :ref:`pragma Always_Terminates`. + Aspect Annotate === diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst index bfaa1cff407..9fc334354ac 100644 --- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst @@ -329,6 +329,20 @@ this pragma serves no purpose but is ignored rather than rejected to allow common sets of sources to be used in the two situations. +.. _Pragma-Always_Terminates: + +Pragma Always_Terminates + + +Syntax: + +.. code-block:: ada + + pragma Always_Terminates [ (boolean_EXPRESSION) ]; + +For the semantics of this pragma, see the entry for aspect ``Always_Terminates`` +in the SPARK 2014 Reference Manual, section 7.1.2. + .. _Pragma-Annotate: Pragma Annotate -- 2.43.0
[COMMITTED] ada: Ignore defered compile time errors without backend
From: Viljar Indus We defer some compile time warnings and errors until the backend has added the extra information needed. However it is not guaranteed that the backend has run by this point. Avoid checking these errors if the backend has not been activated and no code has been generated. gcc/ada/ * sem_prag.adb (Validate_Compile_Time_Warning_Errors): Avoid checking compile time warnings and errors if backend has not been activated. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_prag.adb | 10 ++ 1 file changed, 10 insertions(+) diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 02f6f29c8a8..bd1d9d3d59b 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -33972,6 +33972,16 @@ package body Sem_Prag is -- Start of processing for Validate_Compile_Time_Warning_Errors begin + + -- These error/warning messages were deferred because they could not be + -- evaluated in the front-end and they needed additional information + -- from the back-end. There is no reason to run these checks again if + -- the back-end was not activated by this point. + + if not Generating_Code then + return; + end if; + Expander_Mode_Save_And_Set (False); In_Compile_Time_Warning_Or_Error := True; -- 2.42.0
[COMMITTED] ada: Support Put_Image for types in user-defined instances of predefined generics.
From: Steve Baird Predefined units do not generally support the Put_Image attribute. There are good reasons for this in most cases. But if a user-defined instantiation of a predefined generic occurs in Ada 2022 code, then Put_Image can be supported for types declared therein. Add this support. gcc/ada/ * exp_put_image.adb (Put_Image_Enabled): Return True in more cases. In particular, when testing to see if a type occurs in a predefined unit, test the type's code unit (obtained by calling Get_Code_Unit). In the case of type within a user-defined instance of a predefined generic, Is_Predefined_Unit will return True for the type and False for the type's code unit. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_put_image.adb | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb index 6684d4178e6..a30f609cfac 100644 --- a/gcc/ada/exp_put_image.adb +++ b/gcc/ada/exp_put_image.adb @@ -1023,7 +1023,7 @@ package body Exp_Put_Image is null; elsif Is_Derived_Type (Typ) then return Put_Image_Enabled (Etype (Base_Type (Typ))); - elsif In_Predefined_Unit (Typ) then + elsif Is_Predefined_Unit (Get_Code_Unit (Typ)) then return False; end if; end if; -- 2.42.0
[COMMITTED] ada: Rework fix for wrong finalization of qualified aggregate in allocator
From: Eric Botcazou The problem is that there is no easy method to insert an action after an arbitrary node in the tree, so the original fix does not correctly work when the allocator is nested in another expression. Therefore this moves the burden of the insertion from Apply_Predicate_Check to Expand_Allocator_Expression and restricts the new processing to the case where it is really required. gcc/ada/ * checks.ads (Apply_Predicate_Check): Add Deref boolean parameter. * checks.adb (Apply_Predicate_Check): Revert latest change. Use Loc local variable to hold the source location. Use a common code path for the generic processing and make a dereference if Deref is True. * exp_ch4.adb (Expand_Allocator_Expression): Compute Aggr_In_Place earlier. If it is true, do not call Apply_Predicate_Check on the expression on entry but on the temporary on exit with a dereference. * sem_res.adb (Resolve_Actuals): Add explicit parameter association in call to Apply_Predicate_Check. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/checks.adb | 87 - gcc/ada/checks.ads | 13 +++ gcc/ada/exp_ch4.adb | 24 + gcc/ada/sem_res.adb | 2 +- 4 files changed, 63 insertions(+), 63 deletions(-) diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 14e82f2adc6..d59d44fd6ab 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -2720,15 +2720,20 @@ package body Checks is --- procedure Apply_Predicate_Check - (N : Node_Id; - Typ : Entity_Id; - Fun : Entity_Id := Empty) + (N : Node_Id; + Typ : Entity_Id; + Deref : Boolean := False; + Fun : Entity_Id := Empty) is - Par : Node_Id; - S : Entity_Id; + Loc: constant Source_Ptr := Sloc (N); + Check_Disabled : constant Boolean := +not Predicate_Enabled (Typ) + or else not Predicate_Check_In_Scope (N); + + Expr : Node_Id; + Par : Node_Id; + S: Entity_Id; - Check_Disabled : constant Boolean := not Predicate_Enabled (Typ) -or else not Predicate_Check_In_Scope (N); begin S := Current_Scope; while Present (S) and then not Is_Subprogram (S) loop @@ -2757,7 +2762,7 @@ package body Checks is if not Check_Disabled then Insert_Action (N, - Make_Raise_Storage_Error (Sloc (N), + Make_Raise_Storage_Error (Loc, Reason => SE_Infinite_Recursion)); return; end if; @@ -2824,19 +2829,9 @@ package body Checks is Par := Parent (Par); end if; - -- For an entity of the type, generate a call to the predicate - -- function, unless its type is an actual subtype, which is not - -- visible outside of the enclosing subprogram. - - if Is_Entity_Name (N) -and then not Is_Actual_Subtype (Typ) - then - Insert_Action (N, - Make_Predicate_Check - (Typ, New_Occurrence_Of (Entity (N), Sloc (N; - return; + -- Try to avoid creating a temporary if the expression is an aggregate - elsif Nkind (N) in N_Aggregate | N_Extension_Aggregate then + if Nkind (N) in N_Aggregate | N_Extension_Aggregate then -- If the expression is an aggregate in an assignment, apply the -- check to the LHS after the assignment, rather than create a @@ -2851,27 +2846,6 @@ package body Checks is (Typ, Duplicate_Subexpr (Name (Par; return; - -- Similarly, if the expression is a qualified aggregate in an - -- allocator, apply the check to the dereference of the access - -- value, rather than create a temporary. This is necessary for - -- inherently limited types, for which the temporary is illegal. - - elsif Nkind (Par) = N_Allocator then -declare - Deref : constant Node_Id := - Make_Explicit_Dereference (Sloc (N), - Prefix => Duplicate_Subexpr (Par)); - -begin - -- This is required by Predicate_Check_In_Scope ??? - - Preserve_Comes_From_Source (Deref, N); - - Insert_Action_After (Parent (Par), - Make_Predicate_Check (Typ, Deref)); - return; -end; - -- Similarly, if the expression is an aggregate in an object -- declaration, apply it to the object after the declaration. @@ -2892,21 +2866,36 @@ package body Checks is then Insert_Action_After (Par, Make_Predicate_Check (Typ, -New_Occurrence_Of (Defining_Identifier (Par), Sloc (N; +New_Occurrence_Of (Defining_Identifier (Par), Loc))); return;
[COMMITTED] ada: Remove SPARK legality checks
From: Yannick Moy SPARK legality checks apply only to code with SPARK_Mode On, and are performed again in GNATprove for detecting SPARK-compatible declarations in code with SPARK_Mode Auto. Remove this duplication, to only perform SPARK legality checking in GNATprove. After this patch, only a few special SPARK legality checks are performed in the frontend, which could be moved to GNATprove later. gcc/ada/ * contracts.adb (Analyze_Entry_Or_Subprogram_Body_Contract): Remove checking on volatility. Remove handling of SPARK_Mode, not needed anymore. (Analyze_Entry_Or_Subprogram_Contract): Remove checking on volatility. (Check_Type_Or_Object_External_Properties): Same. (Analyze_Object_Contract): Same. * freeze.adb (Freeze_Record_Type): Same. Also remove checking on synchronized types and ghost types. * sem_ch12.adb (Instantiate_Object): Remove checking on volatility. (Instantiate_Type): Same. * sem_ch3.adb (Access_Type_Declaration): Same. (Derived_Type_Declaration): Remove checking related to untagged partial view. (Process_Discriminants): Remove checking on volatility. * sem_ch5.adb (Analyze_Loop_Parameter_Specification): Same. * sem_ch6.adb (Analyze_Procedure_Call): Fix use of SPARK_Mode where GNATprove_Mode was intended. * sem_disp.adb (Inherited_Subprograms): Protect against Empty node. * sem_prag.adb (Analyze_Global_In_Decl_Part): Remove checking on volatility. (Analyze_Pragma): Same. * sem_res.adb (Flag_Effectively_Volatile_Objects): Remove. (Resolve_Actuals): Remove checking on volatility. (Resolve_Entity_Name): Same. * sem_util.adb (Check_Nonvolatile_Function_Profile): Remove. (Check_Volatility_Compatibility): Remove. * sem_util.ads: Same. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/contracts.adb | 163 ++ gcc/ada/freeze.adb| 71 -- gcc/ada/sem_ch12.adb | 37 -- gcc/ada/sem_ch3.adb | 56 --- gcc/ada/sem_ch5.adb | 8 --- gcc/ada/sem_ch6.adb | 4 +- gcc/ada/sem_disp.adb | 1 + gcc/ada/sem_prag.adb | 80 - gcc/ada/sem_res.adb | 95 gcc/ada/sem_util.adb | 124 +--- gcc/ada/sem_util.ads | 19 + 11 files changed, 13 insertions(+), 645 deletions(-) diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb index b6e756fbf77..fa0d59a246a 100644 --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -590,10 +590,6 @@ package body Contracts is Items : constant Node_Id := Contract (Body_Id); Spec_Id : constant Entity_Id := Unique_Defining_Entity (Body_Decl); - Saved_SM : constant SPARK_Mode_Type := SPARK_Mode; - Saved_SMP : constant Node_Id := SPARK_Mode_Pragma; - -- Save the SPARK_Mode-related data to restore on exit - begin -- When a subprogram body declaration is illegal, its defining entity is -- left unanalyzed. There is nothing left to do in this case because the @@ -628,39 +624,11 @@ package body Contracts is Analyze_Entry_Or_Subprogram_Contract (Corresponding_Spec (Body_Decl)); end if; - -- Due to the timing of contract analysis, delayed pragmas may be - -- subject to the wrong SPARK_Mode, usually that of the enclosing - -- context. To remedy this, restore the original SPARK_Mode of the - -- related subprogram body. - - Set_SPARK_Mode (Body_Id); - -- Ensure that the contract cases or postconditions mention 'Result or -- define a post-state. Check_Result_And_Post_State (Body_Id); - -- A stand-alone nonvolatile function body cannot have an effectively - -- volatile formal parameter or return type (SPARK RM 7.1.3(9)). This - -- check is relevant only when SPARK_Mode is on, as it is not a standard - -- legality rule. The check is performed here because Volatile_Function - -- is processed after the analysis of the related subprogram body. The - -- check only applies to source subprograms and not to generated TSS - -- subprograms. - - if SPARK_Mode = On -and then Ekind (Body_Id) in E_Function | E_Generic_Function -and then Comes_From_Source (Spec_Id) -and then not Is_Volatile_Function (Body_Id) - then - Check_Nonvolatile_Function_Profile (Body_Id); - end if; - - -- Restore the SPARK_Mode of the enclosing context after all delayed - -- pragmas have been analyzed. - - Restore_SPARK_Mode (Saved_SM, Saved_SMP); - -- Capture all global references in a generic subprogram body now that -- the contract has been analyzed. @@ -865,20 +833,6 @@ package body Contracts is Check_Result_And_Post_State (Subp_I
Re: [PATCH] ada: Fix Ada bootstrap on macOS
Rainer Orth writes:
> The recent warning changes broke Ada bootstrap on macOS:
>
> adaint.c: In function '__gnat_copy_attribs':
> adaint.c:3336:10: error: implicit declaration of function 'utimes'; did you
> mean 'utime'? [-Wimplicit-function-declaration]
> 3336 | if (utimes (to, tbuf) == -1) {
> | ^~
> | utime
> adaint.c: In function '__gnat_kill':
> adaint.c:3597:3: error: implicit declaration of function 'kill'
> [-Wimplicit-function-declaration]
> 3597 | kill (pid, sig);
> | ^~~~
> terminals.c: In function 'allocate_pty_desc':
> terminals.c:1196:12: error: implicit declaration of function 'openpty'; did
> you mean 'openat'? [-Wimplicit-function-declaration]
> 1196 | status = openpty (&master_fd, &slave_fd, NULL, NULL, NULL);
> |^~~
> |openat
> terminals.c: In function '__gnat_setup_winsize':
> terminals.c:1392:6: error: implicit declaration of function 'kill'
> [-Wimplicit-function-declaration]
> 1392 | kill (desc->child_pid, SIGWINCH);
> | ^~~~
>
> This patch fixes this by including the necessary headers:
> for utimes, for kill, and for openpty. With those
> changes, the build completed on x86_64-apple-darwin2[0-3] (make check
> still running).
>
> Ok for trunk?
Ok!
Thanks,
Marc
Re: [PATCH] testsuite: refine gcc.dg/analyzer/fd-4.c test for newlib
Marc Poulhiès writes:
> Contrary to glibc, including stdio.h from newlib defines mode_t which
> conflicts with the test's type definition.
>
> .../gcc/testsuite/gcc.dg/analyzer/fd-4.c:19:3: error: redefinition of typedef
> 'mode_t' with different type
> ...
> .../include/sys/types.h:189:25: note: previous declaration of 'mode_t' with
> type 'mode_t' {aka 'unsigned int'}
>
> Defining _MODE_T_DECLARED skips the type definition.
>
> gcc/testsuite/ChangeLog:
>
> * gcc.dg/analyzer/fd-4.c: Fix for newlib.
> ---
> Tested on x86_64-linux and x86_64-elf.
>
> Ok for master?
>
> gcc/testsuite/gcc.dg/analyzer/fd-4.c | 1 +
> 1 file changed, 1 insertion(+)
>
> diff --git a/gcc/testsuite/gcc.dg/analyzer/fd-4.c
> b/gcc/testsuite/gcc.dg/analyzer/fd-4.c
> index 994bad84342..e4a834ade30 100644
> --- a/gcc/testsuite/gcc.dg/analyzer/fd-4.c
> +++ b/gcc/testsuite/gcc.dg/analyzer/fd-4.c
> @@ -1,3 +1,4 @@
> +/* { dg-additional-options "-D_MODE_T_DECLARED=1" { target newlib } } */
> #ifdef _AIX
> #define _MODE_T
> #endif
Ping ?
Thanks,
Marc
Re: [PATCH] testsuite: require avx_runtime for some tests
Marc Poulhiès writes:
> These 3 tests fails parsing the 'vect' dump when not using -mavx. Make
> the dependency explicit.
>
> gcc/testsuite/ChangeLog:
>
> * gcc.dg/vect/vect-ifcvt-18.c: Add dep on avx_runtime.
> * gcc.dg/vect/vect-simd-clone-16f.c: Likewise.
> * gcc.dg/vect/vect-simd-clone-18f.c: Likewise.
> ---
> Tested on x86_64-linux and x86_64-elf.
>
> Ok for master?
>
> gcc/testsuite/gcc.dg/vect/vect-ifcvt-18.c | 3 ++-
> gcc/testsuite/gcc.dg/vect/vect-simd-clone-16f.c | 4 ++--
> gcc/testsuite/gcc.dg/vect/vect-simd-clone-18f.c | 4 ++--
> 3 files changed, 6 insertions(+), 5 deletions(-)
>
> diff --git a/gcc/testsuite/gcc.dg/vect/vect-ifcvt-18.c
> b/gcc/testsuite/gcc.dg/vect/vect-ifcvt-18.c
> index c1d3c27d819..607194496e9 100644
> --- a/gcc/testsuite/gcc.dg/vect/vect-ifcvt-18.c
> +++ b/gcc/testsuite/gcc.dg/vect/vect-ifcvt-18.c
> @@ -1,6 +1,7 @@
> /* { dg-require-effective-target vect_condition } */
> /* { dg-require-effective-target vect_float } */
> -/* { dg-additional-options "-Ofast -mavx" { target avx_runtime } } */
> +/* { dg-require-effective-target avx_runtime } */
> +/* { dg-additional-options "-Ofast -mavx" } */
>
>
> int A0[4] = {36,39,42,45};
> diff --git a/gcc/testsuite/gcc.dg/vect/vect-simd-clone-16f.c
> b/gcc/testsuite/gcc.dg/vect/vect-simd-clone-16f.c
> index 7cd29e894d0..c6615dc626d 100644
> --- a/gcc/testsuite/gcc.dg/vect/vect-simd-clone-16f.c
> +++ b/gcc/testsuite/gcc.dg/vect/vect-simd-clone-16f.c
> @@ -1,6 +1,6 @@
> /* { dg-require-effective-target vect_simd_clones } */
> -/* { dg-additional-options "-fopenmp-simd --param vect-epilogues-nomask=0" }
> */
> -/* { dg-additional-options "-mavx" { target avx_runtime } } */
> +/* { dg-additional-options "-fopenmp-simd --param vect-epilogues-nomask=0
> -mavx" } */
> +/* { dg-require-effective-target avx_runtime } */
> /* { dg-additional-options "-mno-avx512f" { target { { i?86*-*-* x86_64-*-*
> } && { ! lp64 } } } } */
>
> #define TYPE __INT64_TYPE__
> diff --git a/gcc/testsuite/gcc.dg/vect/vect-simd-clone-18f.c
> b/gcc/testsuite/gcc.dg/vect/vect-simd-clone-18f.c
> index 4dd51381d73..787b918d0c4 100644
> --- a/gcc/testsuite/gcc.dg/vect/vect-simd-clone-18f.c
> +++ b/gcc/testsuite/gcc.dg/vect/vect-simd-clone-18f.c
> @@ -1,6 +1,6 @@
> /* { dg-require-effective-target vect_simd_clones } */
> -/* { dg-additional-options "-fopenmp-simd --param vect-epilogues-nomask=0" }
> */
> -/* { dg-additional-options "-mavx" { target avx_runtime } } */
> +/* { dg-additional-options "-fopenmp-simd --param vect-epilogues-nomask=0
> -mavx" } */
> +/* { dg-require-effective-target avx_runtime } */
> /* { dg-additional-options "-mno-avx512f" { target { { i?86*-*-* x86_64-*-*
> } && { ! lp64 } } } } */
>
> #define TYPE __INT64_TYPE__
Ping.
Thanks,
Marc
Re: [PATCH] testsuite: skip gcc.target/i386/pr106910-1.c test when using newlib
Marc Poulhiès writes:
> Using newlib produces a different codegen because the support for c99
> differs (see libc_has_function hook).
>
> gcc/testsuite/ChangeLog:
>
> * gcc.target/i386/pr106910-1.c: Disable for newlib.
> ---
> Tested on x86_64-linux and x86_64-elf.
>
> OK for master?
>
> gcc/testsuite/gcc.target/i386/pr106910-1.c | 2 ++
> 1 file changed, 2 insertions(+)
>
> diff --git a/gcc/testsuite/gcc.target/i386/pr106910-1.c
> b/gcc/testsuite/gcc.target/i386/pr106910-1.c
> index c7685a32183..00c93f444b6 100644
> --- a/gcc/testsuite/gcc.target/i386/pr106910-1.c
> +++ b/gcc/testsuite/gcc.target/i386/pr106910-1.c
> @@ -1,4 +1,6 @@
> +
> /* { dg-do compile { target { ! ia32 } } } */
> +/* { dg-skip-if "newlib libc math causes different codegen" { newlib } } */
> /* { dg-options "-msse4.1 -O2 -Ofast" } */
> /* { dg-final { scan-assembler-times "roundps" 9 } } */
> /* { dg-final { scan-assembler-times "cvtps2dq" 1 } } */
Ping.
Thanks,
Marc
[PATCH] testsuite: add missing dg-require ifunc in pr105554.c
The 'target_clones' attribute depends on the ifunc support.
gcc/testsuite/ChangeLog:
* gcc.target/i386/pr105554.c: Add dg-require ifunc.
---
Tested on x86_64-linux and x86_64-elf.
Ok for master?
gcc/testsuite/gcc.target/i386/pr105554.c | 1 +
1 file changed, 1 insertion(+)
diff --git a/gcc/testsuite/gcc.target/i386/pr105554.c
b/gcc/testsuite/gcc.target/i386/pr105554.c
index e9ef494270a..420987e5df8 100644
--- a/gcc/testsuite/gcc.target/i386/pr105554.c
+++ b/gcc/testsuite/gcc.target/i386/pr105554.c
@@ -2,6 +2,7 @@
/* { dg-do compile } */
/* { dg-require-ifunc "" } */
/* { dg-options "-O2 -Wno-psabi -mno-sse3" } */
+/* { dg-require-ifunc "" } */
typedef long long v4di __attribute__((__vector_size__(32)));
--
2.43.0
[PATCH] testsuite: adjust call to abort in excess-precision-12
abort() is not always available, using the builtin as done in other tests. gcc/testsuite/ChangeLog: * g++.target/i386/excess-precision-12.C: call builtin_abort instead of abort. --- Tested on x86_64-linux and x86_64-elf. Ok for master? gcc/testsuite/g++.target/i386/excess-precision-12.C | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gcc/testsuite/g++.target/i386/excess-precision-12.C b/gcc/testsuite/g++.target/i386/excess-precision-12.C index dff48c07c8b..e59f7c3b1fb 100644 --- a/gcc/testsuite/g++.target/i386/excess-precision-12.C +++ b/gcc/testsuite/g++.target/i386/excess-precision-12.C @@ -13,8 +13,8 @@ main (void) unsigned long long int u = (1ULL << 63) + 1; if ((f <=> u) >= 0) -abort (); +__builtin_abort (); if ((u <=> f) <= 0) -abort (); +__builtin_abort (); } -- 2.43.0
[PATCH] testsuite: require avx_runtime for vect-simd-clone-17f
The test fails parsing the 'vect' dump when not using -mavx. Make the
dependency explicit.
gcc/testsuite/ChangeLog:
* gcc.dg/vect/vect-simd-clone-17f.c: Add dep on avx_runtime.
---
Tested on x86_64-linux and x86_64-elf.
Ok for master?
gcc/testsuite/gcc.dg/vect/vect-simd-clone-17f.c | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/gcc/testsuite/gcc.dg/vect/vect-simd-clone-17f.c
b/gcc/testsuite/gcc.dg/vect/vect-simd-clone-17f.c
index 177521dc445..eb2b149981f 100644
--- a/gcc/testsuite/gcc.dg/vect/vect-simd-clone-17f.c
+++ b/gcc/testsuite/gcc.dg/vect/vect-simd-clone-17f.c
@@ -1,6 +1,7 @@
/* { dg-require-effective-target vect_simd_clones } */
+/* { dg-require-effective-target avx_runtime } */
/* { dg-additional-options "-fopenmp-simd --param vect-epilogues-nomask=0" } */
-/* { dg-additional-options "-mavx" { target avx_runtime } } */
+/* { dg-additional-options "-mavx" } */
/* { dg-additional-options "-mno-avx512f" { target { { i?86*-*-* x86_64-*-* }
&& { ! lp64 } } } } */
#define TYPE __INT64_TYPE__
--
2.43.0
Re: [PATCH] testsuite: add missing dg-require ifunc in pr105554.c
Jakub Jelinek writes:
> On Thu, Dec 07, 2023 at 05:25:39PM +0100, Marc Poulhiès wrote:
>> The 'target_clones' attribute depends on the ifunc support.
>>
>> gcc/testsuite/ChangeLog:
>> * gcc.target/i386/pr105554.c: Add dg-require ifunc.
>> ---
>> Tested on x86_64-linux and x86_64-elf.
>>
>> Ok for master?
>>
>> gcc/testsuite/gcc.target/i386/pr105554.c | 1 +
>> 1 file changed, 1 insertion(+)
>>
>> diff --git a/gcc/testsuite/gcc.target/i386/pr105554.c
>> b/gcc/testsuite/gcc.target/i386/pr105554.c
>> index e9ef494270a..420987e5df8 100644
>> --- a/gcc/testsuite/gcc.target/i386/pr105554.c
>> +++ b/gcc/testsuite/gcc.target/i386/pr105554.c
>> @@ -2,6 +2,7 @@
>> /* { dg-do compile } */
>> /* { dg-require-ifunc "" } */
>> /* { dg-options "-O2 -Wno-psabi -mno-sse3" } */
>> +/* { dg-require-ifunc "" } */
>
> That is 2 lines above this already...
Oh right, sorry about that. I didn't catch this when rebasing.
Marc
Re: [PATCH] testsuite: require avx_runtime for vect-simd-clone-17f
Jakub Jelinek writes: > This looks wrong, then it won't be tested at all on non-x86 targets. Right, I'll look for a better fix. Should I revert r14-6272 that has the same issue of disabling the modified tests on non-x86? Marc
Re: [PATCH] testsuite: require avx_runtime for some tests
Thomas Schwinge writes: > Hi Marc! > > On 2023-11-06T11:59:18+0100, Marc Poulhiès wrote: >> These 3 tests fails parsing the 'vect' dump when not using -mavx. Make >> the dependency explicit. > > But that means that the tests are now enabled *only* for > effective-target 'avx_runtime', so, for example, on GCN I see: > > -PASS: gcc.dg/vect/vect-ifcvt-18.c (test for excess errors) > -PASS: gcc.dg/vect/vect-ifcvt-18.c execution test > +UNSUPPORTED: gcc.dg/vect/vect-ifcvt-18.c > > -PASS: gcc.dg/vect/vect-simd-clone-16f.c (test for excess errors) > -PASS: gcc.dg/vect/vect-simd-clone-16f.c execution test > -PASS: gcc.dg/vect/vect-simd-clone-16f.c scan-tree-dump-times vect > "[\\n\\r] [^\\n]* = foo\\.simdclone" 2 > +UNSUPPORTED: gcc.dg/vect/vect-simd-clone-16f.c > > -PASS: gcc.dg/vect/vect-simd-clone-18f.c (test for excess errors) > -PASS: gcc.dg/vect/vect-simd-clone-18f.c execution test > -PASS: gcc.dg/vect/vect-simd-clone-18f.c scan-tree-dump-times vect > "[\\n\\r] [^\\n]* = foo\\.simdclone" 2 > +UNSUPPORTED: gcc.dg/vect/vect-simd-clone-18f.c > > ..., which was not the intention, I suppose? Hello Thomas, No, that was an oversight, Jakub also spotted that in another patch. I'll revert it now. Sorry for the inconvenience, Marc
Re: [PATCH] testsuite: require avx_runtime for vect-simd-clone-17f
Marc Poulhiès writes: > Should I revert r14-6272 that has the same issue of disabling the > modified tests on non-x86? I've reverted the r14-6272. Marc
Re: [PATCH] ada: Fix Ada bootstrap on FreeBSD
Rainer Orth writes: > Ada bootstrap on FreeBSD/amd64 was also broken by the recent warning > changes: > > terminals.c: In function 'allocate_pty_desc': > terminals.c:1200:12: error: implicit declaration of function 'openpty'; did > you > mean 'openat'? [-Wimplicit-function-declaration] > 1200 | status = openpty (&master_fd, &slave_fd, NULL, NULL, NULL); > |^~~ > |openat > > terminals.c: At top level: > terminals.c:1268:9: warning: "TABDLY" redefined > 1268 | #define TABDLY 0 > | ^~ > In file included from /usr/include/termios.h:38, > from terminals.c:1109: > /usr/include/sys/_termios.h:111:9: note: this is the location of the previous > definition > 111 | #define TABDLY 0x0004 /* tab delay mask */ > | ^~ > make[7]: *** [../gcc-interface/Makefile:302: terminals.o] Error 1 > > Fixed by including the necessary header and guarding the fallback > definition of TABDLY. > > This allowed a 64-bit-only bootstrap on x86_64-unknown-freebsd14.0 to > complete successfully. Multilibbed bootstrap is still broken for > unrelated reasons, cf. PR ada/ada/112958. Hello Rainer, > Ok for trunk? OK ! Thanks, Marc
Re: [PATCH] testsuite: adjust call to abort in excess-precision-12
Hello, > Why wouldn't they have abort and what else does __builtin_abort () expand > to? It expands to abort but works around the "abort is undeclared" error. > There are 2000+ other tests in gcc.target/i386/ which call abort (), > not __builtin_abort (), after including directly or indirectly > or declaring it themselves. This test in particular includes > > Does whatever target you are running this into provide just std::abort () > and not abort (); from ? If so, perhaps it should call > std::abort (); instead of abort (). You are correct, std::abort() is a better solution. cstdlib does not include stdlib.h because I'm on a non-hosted target. I'll send a refreshed patch. Thanks, Marc
[PATCH v2] testsuite: adjust call to abort in excess-precision-12
On non-hosted targets, cstdlib may not be sufficient to have abort defined, but it should be for std::abort. gcc/testsuite/ChangeLog: * g++.target/i386/excess-precision-12.C: call std::abort instead of abort. --- Changed from calling __builtin_abort to std::abort, as advised. Ok for master? Thanks, Marc gcc/testsuite/g++.target/i386/excess-precision-12.C | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gcc/testsuite/g++.target/i386/excess-precision-12.C b/gcc/testsuite/g++.target/i386/excess-precision-12.C index dff48c07c8b..7cfd15d6136 100644 --- a/gcc/testsuite/g++.target/i386/excess-precision-12.C +++ b/gcc/testsuite/g++.target/i386/excess-precision-12.C @@ -13,8 +13,8 @@ main (void) unsigned long long int u = (1ULL << 63) + 1; if ((f <=> u) >= 0) -abort (); +std::abort (); if ((u <=> f) <= 0) -abort (); +std::abort (); } -- 2.43.0
[COMMITTED] ada: Fix internal error on address of element of packed array component
From: Eric Botcazou This occurs when the component is part of a discriminated type and its offset depends on a discriminant, the problem being that the front-end generates an incomplete Bit_Position attribute reference. gcc/ada/ * exp_pakd.adb (Get_Base_And_Bit_Offset): Use the full component reference instead of just the selector name for 'Bit_Position. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_pakd.adb | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index c3908a54538..ad12aec1e23 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -2112,8 +2112,8 @@ package body Exp_Pakd is -- We build up an expression serially that has the form - --linear-subscript * component_size for each array reference - -- + field'Bit_Position for each record field + --linear-subscript * component_size for each array component ref + -- + pref.component'Bit_Position for each record component ref -- + ... loop @@ -2135,7 +2135,7 @@ package body Exp_Pakd is elsif Nkind (Base) = N_Selected_Component then Term := Make_Attribute_Reference (Loc, -Prefix => Selector_Name (Base), +Prefix => Base, Attribute_Name => Name_Bit_Position); else -- 2.42.0
[COMMITTED] ada: Fix scope of semantic style_check pragmas
From: Viljar Indus Restore the original state of Style_Check pragmas before analyzing each compilation unit to avoid Style_Check pragmas from unit affecting the style checks of a different unit. gcc/ada/ * sem_ch10.adb: (Analyze_Compilation_Unit): Restore the orignal state of style check pragmas at the end of the analysis. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_ch10.adb | 10 ++ 1 file changed, 10 insertions(+) diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index ba4beae2851..90d2f3c6c74 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -638,6 +638,7 @@ package body Sem_Ch10 is Par_Spec_Name : Unit_Name_Type; Spec_Id : Entity_Id; Unum : Unit_Number_Type; + Options : Style_Check_Options; -- Start of processing for Analyze_Compilation_Unit @@ -717,6 +718,11 @@ package body Sem_Ch10 is Set_Context_Pending (N); end if; + -- Store the style check options before analyzing context pragmas that + -- might change them for this compilation unit. + + Save_Style_Check_Options (Options); + Analyze_Context (N); Set_Context_Pending (N, False); @@ -1395,6 +1401,10 @@ package body Sem_Ch10 is Pop_Scope; end if; + -- Finally restore all the original style check options + + Set_Style_Check_Options (Options); + -- If No_Elaboration_Code_All was encountered, this is where we do the -- transitive test of with'ed units to make sure they have the aspect. -- This is delayed till the end of analyzing the compilation unit to -- 2.42.0
[COMMITTED] ada: Simplify code for Ignore_Style_Checks_Pragmas
From: Viljar Indus gcc/ada/ * sem_prag.adb: (Analyze_Pragma): Reduce the number of nested if statements. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_prag.adb | 26 +++--- 1 file changed, 11 insertions(+), 15 deletions(-) diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index b7655759d31..c391e2779bf 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -25109,6 +25109,10 @@ package body Sem_Prag is else Check_Arg_Count (1); + if Ignore_Style_Checks_Pragmas then + return; + end if; + if Nkind (A) = N_String_Literal then S := Strval (A); @@ -25129,9 +25133,7 @@ package body Sem_Prag is -- them in the parser. if J = Slen then - if not Ignore_Style_Checks_Pragmas then - Set_Style_Check_Options (Options); - end if; + Set_Style_Check_Options (Options); exit; end if; @@ -25142,23 +25144,17 @@ package body Sem_Prag is elsif Nkind (A) = N_Identifier then if Chars (A) = Name_All_Checks then - if not Ignore_Style_Checks_Pragmas then -if GNAT_Mode then - Set_GNAT_Style_Check_Options; -else - Set_Default_Style_Check_Options; -end if; + if GNAT_Mode then +Set_GNAT_Style_Check_Options; + else +Set_Default_Style_Check_Options; end if; elsif Chars (A) = Name_On then - if not Ignore_Style_Checks_Pragmas then -Style_Check := True; - end if; + Style_Check := True; elsif Chars (A) = Name_Off then - if not Ignore_Style_Checks_Pragmas then -Style_Check := False; - end if; + Style_Check := False; end if; end if; end if; -- 2.42.0
[COMMITTED] ada: Cleanup getting of actual subtypes
From: Piotr Trojanek Avoid potentially unnecessary call to Etype. gcc/ada/ * sem_util.adb (Get_Actual_Subtype_If_Available): Only call Etype when necessary. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_util.adb | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index da531e53466..d5df05b88e1 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -10218,8 +10218,6 @@ package body Sem_Util is - function Get_Actual_Subtype_If_Available (N : Node_Id) return Entity_Id is - Typ : constant Entity_Id := Etype (N); - begin -- If what we have is an identifier that references a subprogram -- formal, or a variable or constant object, then we get the actual @@ -10245,7 +10243,7 @@ package body Sem_Util is -- Otherwise the Etype of N is returned unchanged else - return Typ; + return Etype (N); end if; end Get_Actual_Subtype_If_Available; -- 2.42.0
[COMMITTED] ada: Fix style in declaration of routine for expansion of packed arrays
From: Piotr Trojanek Style cleanup. gcc/ada/ * exp_pakd.adb (Setup_Inline_Packed_Array_Reference): Remove extra whitespace from the list of parameters. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_pakd.adb | 20 ++-- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index ad12aec1e23..2d3abbd349d 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -153,11 +153,11 @@ package body Exp_Pakd is -- reference the corresponding packed array type. procedure Setup_Inline_Packed_Array_Reference - (N : Node_Id; - Atyp : Entity_Id; - Obj: in out Node_Id; - Cmask : out Uint; - Shift : out Node_Id); + (N : Node_Id; + Atyp : Entity_Id; + Obj : in out Node_Id; + Cmask : out Uint; + Shift : out Node_Id); -- This procedure performs common processing on the N_Indexed_Component -- parameter given as N, whose prefix is a reference to a packed array. -- This is used for the get and set when the component size is 1, 2, 4, @@ -2472,11 +2472,11 @@ package body Exp_Pakd is - procedure Setup_Inline_Packed_Array_Reference - (N : Node_Id; - Atyp : Entity_Id; - Obj: in out Node_Id; - Cmask : out Uint; - Shift : out Node_Id) + (N : Node_Id; + Atyp : Entity_Id; + Obj : in out Node_Id; + Cmask : out Uint; + Shift : out Node_Id) is Loc : constant Source_Ptr := Sloc (N); PAT : Entity_Id; -- 2.42.0
[COMMITTED] ada: Fix handling of actual subtypes for expanded names
From: Piotr Trojanek gcc/ada/ * sem_util.adb (Get_Actual_Subtype,Get_Actual_Subtype_If_Available): Fix handling of expanded names. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_util.adb | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 5440c6ae0aa..da531e53466 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -10104,7 +10104,7 @@ package body Sem_Util is -- formal, or a variable or constant object, then we get the actual -- subtype from the referenced entity if one has been built. - if Nkind (N) = N_Identifier + if Nkind (N) in N_Identifier | N_Expanded_Name and then (Is_Formal (Entity (N)) or else Ekind (Entity (N)) = E_Constant @@ -10225,7 +10225,7 @@ package body Sem_Util is -- formal, or a variable or constant object, then we get the actual -- subtype from the referenced entity if one has been built. - if Nkind (N) = N_Identifier + if Nkind (N) in N_Identifier | N_Expanded_Name and then (Is_Formal (Entity (N)) or else Ekind (Entity (N)) = E_Constant -- 2.42.0
[COMMITTED] ada: Error in prefix-notation call
From: Bob Duff The compiler gives a wrong error for a call of the form X.Y(...) when Y is inherited indirectly via an interface. gcc/ada/ * sem_ch4.adb (Is_Private_Overriding): Return True in the case where a primitive operation is publicly inherited but privately overridden. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_ch4.adb | 10 -- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 50ba6c9c847..2f3dfe71590 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -10223,9 +10223,15 @@ package body Sem_Ch4 is elsif not Comes_From_Source (Visible_Op) and then Alias (Visible_Op) = Op - and then not Is_Hidden (Visible_Op) then - return True; + -- If Visible_Op or what it overrides is not hidden, then we + -- have found what we're looking for. + + if not Is_Hidden (Visible_Op) +or else not Is_Hidden (Overridden_Operation (Op)) + then + return True; + end if; end if; Visible_Op := Homonym (Visible_Op); -- 2.42.0
[COMMITTED] ada: Change local variables to constants in expansion of packed arrays
From: Piotr Trojanek Cleanup; semantics is unaffected. gcc/ada/ * exp_pakd.adb (Expand_Bit_Packed_Element_Set): Change local Decl object from variable to constant. (Setup_Inline_Packed_Array_Reference): Likewise for Csiz. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_pakd.adb | 10 +++--- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index 2d3abbd349d..1641e8a51c2 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -1137,14 +1137,12 @@ package body Exp_Pakd is if Nkind (Rhs) = N_String_Literal then declare -Decl : Node_Id; - begin -Decl := +Decl : constant Node_Id := Make_Object_Declaration (Loc, Defining_Identifier => Make_Temporary (Loc, 'T', Rhs), Object_Definition => New_Occurrence_Of (Ctyp, Loc), Expression => New_Copy_Tree (Rhs)); - + begin Insert_Actions (N, New_List (Decl)); Rhs := New_Occurrence_Of (Defining_Identifier (Decl), Loc); end; @@ -2481,12 +2479,10 @@ package body Exp_Pakd is Loc : constant Source_Ptr := Sloc (N); PAT : Entity_Id; Otyp : Entity_Id; - Csiz : Uint; + Csiz : constant Uint := Component_Size (Atyp); Osiz : Uint; begin - Csiz := Component_Size (Atyp); - Convert_To_PAT_Type (Obj); PAT := Etype (Obj); -- 2.42.0
[COMMITTED] ada: Avoid extra conversion in expansion of packed array assignments
From: Piotr Trojanek Expansion of assignments to packed array objects with string literals on the right-hand side, created an unnecessary conversion, i.e.: ... := component_type (declare temp : component_type := "string_literal"; begin temp) Now the expansion omits the outer type conversion. Cleanup; behavior is unaffected. gcc/ada/ * exp_pakd.adb (Expand_Bit_Packed_Element_Set): Simplify handling of assignments with string literals. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_pakd.adb | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index ef0ec1e0014..e197211736a 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -1143,9 +1143,10 @@ package body Exp_Pakd is Insert_Actions (N, New_List (Decl)); Rhs := New_Occurrence_Of (Defining_Identifier (Decl), Loc); end; + else + Rhs := Convert_To (Ctyp, Rhs); end if; - Rhs := Convert_To (Ctyp, Rhs); Set_Parent (Rhs, N); -- If we are building the initialization procedure for a packed array, -- 2.42.0
[COMMITTED] ada: Fix expansion of type aspects with handling of aspects
From: Piotr Trojanek The new handling of aspects stores the aspect expression as the Expression_Copy of the aspect and not as the Entity of the aspect identified. This has been changed for most of the aspects, but not for Type_Invariant and Default_Initial_Condition, which have custom expansion. Apparently this change only affects GNATprove and not GNAT. gcc/ada/ * exp_util.adb (Add_Own_DIC, Add_Own_Invariants): Store the aspect expression in Expression_Copy. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_util.adb | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 3e8d5997949..730889cae3e 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -1893,7 +1893,7 @@ package body Exp_Util is -- routines. if Present (DIC_Asp) then -Set_Entity (Identifier (DIC_Asp), New_Copy_Tree (Expr)); +Set_Expression_Copy (DIC_Asp, New_Copy_Tree (Expr)); end if; -- Once the DIC assertion expression is fully processed, add a check @@ -3153,7 +3153,7 @@ package body Exp_Util is -- Check_Aspect_At_xxx routines. if Present (Prag_Asp) then - Set_Entity (Identifier (Prag_Asp), New_Copy_Tree (Expr)); + Set_Expression_Copy (Prag_Asp, New_Copy_Tree (Expr)); end if; Add_Invariant_Check (Prag, Expr, Checks); -- 2.42.0
[COMMITTED] ada: Simplify expansion of packed array assignments
From: Piotr Trojanek When expanding assignment to a packed array object, e.g. a formal parameter with mode OUT that might have unconstrained type, we took the component type and component size from the constrained actual subtype. It is simpler to take these properties from the nominal type of the assigned object. Semantics is unaffected, because constraining the array doesn't change the type or size of the array components. gcc/ada/ * exp_pakd.adb (Expand_Bit_Packed_Element_Set): Change Ctyp and Csiz from variables to constants and compute them using the nominal type of the assigned array object. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_pakd.adb | 8 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index 68f0db3d56d..2b92c467187 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -1059,10 +1059,12 @@ package body Exp_Pakd is Obj : Node_Id; Atyp : Entity_Id; PAT : Entity_Id; - Ctyp : Entity_Id; - Csiz : Int; Cmask : Uint; + Arr_Typ : constant Entity_Id := Etype (Prefix (Lhs)); + Ctyp: constant Entity_Id := Component_Type (Arr_Typ); + Csiz: constant Int := UI_To_Int (Component_Size (Arr_Typ)); + Shift : Node_Id; -- The expression for the shift value that is required @@ -,8 +1113,6 @@ package body Exp_Pakd is Convert_To_Actual_Subtype (Obj); Atyp := Etype (Obj); PAT := Packed_Array_Impl_Type (Atyp); - Ctyp := Component_Type (Atyp); - Csiz := UI_To_Int (Component_Size (Atyp)); -- We remove side effects, in case the rhs modifies the lhs, because we -- are about to transform the rhs into an expression that first READS -- 2.42.0
[COMMITTED] ada: Simplify handling of known values in expansion of packed arrays
From: Piotr Trojanek If an expression value is not known at compile time, it can be represented with No_Uint and doesn't require a dedicated flag. Code cleanup; behavior is unaffected. gcc/ada/ * exp_pakd.adb (Expand_Bit_Packed_Element_Set): Remove Rhs_Val_Known; represent unknown value by assigning Rhs_Val with No_Uint. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_pakd.adb | 26 ++ 1 file changed, 10 insertions(+), 16 deletions(-) diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index 1641e8a51c2..ef0ec1e0014 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -1073,12 +1073,9 @@ package body Exp_Pakd is New_Lhs : Node_Id; New_Rhs : Node_Id; - Rhs_Val_Known : Boolean; - Rhs_Val : Uint; + Rhs_Val : Uint; -- If the value of the right hand side as an integer constant is - -- known at compile time, Rhs_Val_Known is set True, and Rhs_Val - -- contains the value. Otherwise Rhs_Val_Known is set False, and - -- the Rhs_Val is undefined. + -- known at compile time, Rhs_Val contains the value. function Get_Shift return Node_Id; -- Function used to get the value of Shift, making sure that it @@ -1230,8 +1227,7 @@ package body Exp_Pakd is -- Determine if right side is all 0 bits or all 1 bits if Compile_Time_Known_Value (Rhs) then -Rhs_Val := Expr_Rep_Value (Rhs); -Rhs_Val_Known := True; +Rhs_Val := Expr_Rep_Value (Rhs); -- The following test catches the case of an unchecked conversion of -- an integer literal. This results from optimizing aggregates of @@ -1240,19 +1236,17 @@ package body Exp_Pakd is elsif Nkind (Rhs) = N_Unchecked_Type_Conversion and then Compile_Time_Known_Value (Expression (Rhs)) then -Rhs_Val := Expr_Rep_Value (Expression (Rhs)); -Rhs_Val_Known := True; +Rhs_Val := Expr_Rep_Value (Expression (Rhs)); else -Rhs_Val := No_Uint; -Rhs_Val_Known := False; +Rhs_Val := No_Uint; end if; -- Some special checks for the case where the right hand value is -- known at compile time. Basically we have to take care of the -- implicit conversion to the subtype of the component object. - if Rhs_Val_Known then + if Present (Rhs_Val) then -- If we have a biased component type then we must manually do the -- biasing, since we are taking responsibility in this case for @@ -1289,7 +1283,7 @@ package body Exp_Pakd is -- First we deal with the "and" - if not Rhs_Val_Known or else Rhs_Val /= Cmask then + if No (Rhs_Val) or else Rhs_Val /= Cmask then declare Mask1 : Node_Id; Lit : Node_Id; @@ -1319,7 +1313,7 @@ package body Exp_Pakd is -- Then deal with the "or" - if not Rhs_Val_Known or else Rhs_Val /= 0 then + if No (Rhs_Val) or else Rhs_Val /= 0 then declare Or_Rhs : Node_Id; @@ -1359,7 +1353,7 @@ package body Exp_Pakd is end Fixup_Rhs; begin - if Rhs_Val_Known + if Present (Rhs_Val) and then Compile_Time_Known_Value (Get_Shift) then Or_Rhs := @@ -1387,7 +1381,7 @@ package body Exp_Pakd is -- which will be properly retyped when we analyze and -- resolve the expression. - elsif Rhs_Val_Known then + elsif Present (Rhs_Val) then -- Note that Rhs_Val has already been normalized to -- be an unsigned value with the proper number of bits. -- 2.42.0
[COMMITTED] ada: Fix incorrect resolution of overloaded function call in instance
From: Eric Botcazou The problem occurs when the function call is the operand of an equality operator, the type used to do the comparison is declared outside of the generic construct but visible inside it, and this generic construct also declares two functions with the same profile except for the result type, one result type being the aforementioned type, the other being derived from this type but not visible inside the generic construct. When the second operand is either a literal or also overloaded, the call may be resolved to the second function instead of the first in instances. gcc/ada/ * gen_il-fields.ads (Opt_Field_Enum): Add Compare_Type. * gen_il-gen-gen_nodes.adb (N_Op_Eq): Likewise. (N_Op_Ge): Likewise. (N_Op_Gt): Likewise. (N_Op_Le): Likewise. (N_Op_Lt): Likewise. (N_Op_Ne): Likewise. * sinfo.ads (Compare_Type): Document new field. * sem_ch4.adb (Analyze_Comparison_Equality_Op): If the entity is already present, set the Compare_Type on overloaded operands if it is present on the node. * sem_ch12.adb (Check_Private_View): Look into the Compare_Type instead of the Etype for comparison operators. (Copy_Generic_Node): Remove obsolete code for comparison operators. (Save_Global_References.Save_References): Do not walk into the descendants of N_Implicit_Label_Declaration nodes. (Save_Global_References.Set_Global_Type): Look into the Compare_Type instead of the Etype for comparison operators. * sem_res.adb (Resolve_Comparison_Op): Set Compare_Type. (Resolve_Equality_Op): Likewise. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/gen_il-fields.ads| 1 + gcc/ada/gen_il-gen-gen_nodes.adb | 18 +--- gcc/ada/sem_ch12.adb | 72 ++-- gcc/ada/sem_ch4.adb | 15 +-- gcc/ada/sem_res.adb | 2 + gcc/ada/sinfo.ads| 20 + 6 files changed, 87 insertions(+), 41 deletions(-) diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads index 1b40cd9472e..a0bfb398ebb 100644 --- a/gcc/ada/gen_il-fields.ads +++ b/gcc/ada/gen_il-fields.ads @@ -99,6 +99,7 @@ package Gen_IL.Fields is Comes_From_Check_Or_Contract, Comes_From_Extended_Return_Statement, Comes_From_Iterator, + Compare_Type, Compile_Time_Known_Aggregate, Component_Associations, Component_Clauses, diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb index fdf928d60a3..996d8d78aea 100644 --- a/gcc/ada/gen_il-gen-gen_nodes.adb +++ b/gcc/ada/gen_il-gen-gen_nodes.adb @@ -267,32 +267,38 @@ begin -- Gen_IL.Gen.Gen_Nodes Cc (N_Op_Eq, N_Op_Compare, (Sm (Chars, Name_Id), Sy (Left_Opnd, Node_Id), -Sy (Right_Opnd, Node_Id))); +Sy (Right_Opnd, Node_Id), +Sm (Compare_Type, Node_Id))); Cc (N_Op_Ge, N_Op_Compare, (Sm (Chars, Name_Id), Sy (Left_Opnd, Node_Id), -Sy (Right_Opnd, Node_Id))); +Sy (Right_Opnd, Node_Id), +Sm (Compare_Type, Node_Id))); Cc (N_Op_Gt, N_Op_Compare, (Sm (Chars, Name_Id), Sy (Left_Opnd, Node_Id), -Sy (Right_Opnd, Node_Id))); +Sy (Right_Opnd, Node_Id), +Sm (Compare_Type, Node_Id))); Cc (N_Op_Le, N_Op_Compare, (Sm (Chars, Name_Id), Sy (Left_Opnd, Node_Id), -Sy (Right_Opnd, Node_Id))); +Sy (Right_Opnd, Node_Id), +Sm (Compare_Type, Node_Id))); Cc (N_Op_Lt, N_Op_Compare, (Sm (Chars, Name_Id), Sy (Left_Opnd, Node_Id), -Sy (Right_Opnd, Node_Id))); +Sy (Right_Opnd, Node_Id), +Sm (Compare_Type, Node_Id))); Cc (N_Op_Ne, N_Op_Compare, (Sm (Chars, Name_Id), Sy (Left_Opnd, Node_Id), -Sy (Right_Opnd, Node_Id))); +Sy (Right_Opnd, Node_Id), +Sm (Compare_Type, Node_Id))); Cc (N_Op_Or, N_Op_Boolean, (Sm (Chars, Name_Id), diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 582940da74b..f73e1b53b0e 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -7685,7 +7685,9 @@ package body Sem_Ch12 is procedure Check_Private_View (N : Node_Id) is - Typ : constant Entity_Id := Etype (N); + Comparison : constant Boolean := Nkind (N) in N_Op_Compare; + Typ: constant Entity_Id := +(if Comparison then Compare_Type (N) else Etype (N)); procedure Check_Private_Type (T : Entity_Id; Private_View : Boolean); -- Check that the available view of T matches Private_View and, if not, @@ -7749,10 +7751,16 @@ package body Sem_Ch12 is and then (not In_Open_Scopes (Scope (Typ)) or else Nkind (Parent (N)) = N_Subtype_Declaration) then --- In the generic, only the private declaration wa
[COMMITTED] ada: Fix extra whitespace after END keywords
From: Piotr Trojanek
Style cleanup.
gcc/ada/
* exp_pakd.adb, libgnarl/s-osinte__android.ads,
libgnarl/s-osinte__linux.ads, libgnarl/s-osinte__qnx.ads,
libgnarl/s-osinte__rtems.ads, libgnat/s-gearop.adb,
libgnat/s-poosiz.adb, sem_util.adb: Fix style.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_pakd.adb | 2 +-
gcc/ada/libgnarl/s-osinte__android.ads | 2 +-
gcc/ada/libgnarl/s-osinte__linux.ads | 2 +-
gcc/ada/libgnarl/s-osinte__qnx.ads | 2 +-
gcc/ada/libgnarl/s-osinte__rtems.ads | 2 +-
gcc/ada/libgnat/s-gearop.adb | 2 +-
gcc/ada/libgnat/s-poosiz.adb | 2 +-
gcc/ada/sem_util.adb | 2 +-
8 files changed, 8 insertions(+), 8 deletions(-)
diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb
index e197211736a..68f0db3d56d 100644
--- a/gcc/ada/exp_pakd.adb
+++ b/gcc/ada/exp_pakd.adb
@@ -2203,7 +2203,7 @@ package body Exp_Pakd is
end loop;
return False;
- end In_Partially_Packed_Record;
+ end In_Partially_Packed_Record;
-- Start of processing for Known_Aligned_Enough
diff --git a/gcc/ada/libgnarl/s-osinte__android.ads
b/gcc/ada/libgnarl/s-osinte__android.ads
index fb4310a1a43..04b0a68 100644
--- a/gcc/ada/libgnarl/s-osinte__android.ads
+++ b/gcc/ada/libgnarl/s-osinte__android.ads
@@ -622,7 +622,7 @@ private
type pthread_mutexattr_t is record
Data : char_array (1 .. OS_Constants.PTHREAD_MUTEXATTR_SIZE);
- end record;
+ end record;
pragma Convention (C, pthread_mutexattr_t);
for pthread_mutexattr_t'Alignment use Interfaces.C.int'Alignment;
diff --git a/gcc/ada/libgnarl/s-osinte__linux.ads
b/gcc/ada/libgnarl/s-osinte__linux.ads
index a5e645d334d..adf040e9fc9 100644
--- a/gcc/ada/libgnarl/s-osinte__linux.ads
+++ b/gcc/ada/libgnarl/s-osinte__linux.ads
@@ -652,7 +652,7 @@ private
type pthread_mutexattr_t is record
Data : char_array (1 .. OS_Constants.PTHREAD_MUTEXATTR_SIZE);
- end record;
+ end record;
pragma Convention (C, pthread_mutexattr_t);
for pthread_mutexattr_t'Alignment use Interfaces.C.int'Alignment;
diff --git a/gcc/ada/libgnarl/s-osinte__qnx.ads
b/gcc/ada/libgnarl/s-osinte__qnx.ads
index 3282abe8869..320a71dfece 100644
--- a/gcc/ada/libgnarl/s-osinte__qnx.ads
+++ b/gcc/ada/libgnarl/s-osinte__qnx.ads
@@ -597,7 +597,7 @@ private
type pthread_mutexattr_t is record
Data : char_array (1 .. OS_Constants.PTHREAD_MUTEXATTR_SIZE);
- end record;
+ end record;
pragma Convention (C, pthread_mutexattr_t);
for pthread_mutexattr_t'Alignment use Interfaces.C.int'Alignment;
diff --git a/gcc/ada/libgnarl/s-osinte__rtems.ads
b/gcc/ada/libgnarl/s-osinte__rtems.ads
index 6572bc4e472..43d137f2068 100644
--- a/gcc/ada/libgnarl/s-osinte__rtems.ads
+++ b/gcc/ada/libgnarl/s-osinte__rtems.ads
@@ -617,7 +617,7 @@ private
type pthread_mutexattr_t is record
Data : char_array (1 .. OS_Constants.PTHREAD_MUTEXATTR_SIZE);
- end record;
+ end record;
pragma Convention (C, pthread_mutexattr_t);
for pthread_mutexattr_t'Alignment use Interfaces.C.int'Alignment;
diff --git a/gcc/ada/libgnat/s-gearop.adb b/gcc/ada/libgnat/s-gearop.adb
index e735bb0036a..000e59ccf69 100644
--- a/gcc/ada/libgnat/s-gearop.adb
+++ b/gcc/ada/libgnat/s-gearop.adb
@@ -901,7 +901,7 @@ is
(for all KK in R'Range (2) => R (J, KK)'Initialized);
end loop;
end return;
- end Matrix_Matrix_Product;
+ end Matrix_Matrix_Product;
-- Matrix_Vector_Solution --
diff --git a/gcc/ada/libgnat/s-poosiz.adb b/gcc/ada/libgnat/s-poosiz.adb
index e5e6d0ff77b..0b2baec2d5a 100644
--- a/gcc/ada/libgnat/s-poosiz.adb
+++ b/gcc/ada/libgnat/s-poosiz.adb
@@ -408,5 +408,5 @@ package body System.Pool_Size is
pragma Warnings (On);
end Size;
- end Variable_Size_Management;
+ end Variable_Size_Management;
end System.Pool_Size;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index d5df05b88e1..cfd8b88a26e 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -10045,7 +10045,7 @@ package body Sem_Util is
("value of discriminant & is out of range", Discrim_Value, Discrim);
Report_Errors := True;
return;
- end if;
+ end if;
-- If we have found the corresponding choice, recursively add its
-- components to the Into list. The nested components are part of
--
2.42.0
[COMMITTED] ada: Fix debug info for aliased packed array with unconstrained nominal subtype
From: Eric Botcazou
The front-end now rewrites it as a renaming when it is initialized with a
function call and the same processing must be applied in the renaming case
as in the regular case for this kind of special objects.
gcc/ada/
* gcc-interface/decl.cc (gnat_to_gnu_entity) : Apply the
specific rewriting done for an aliased object with an unconstrained
array nominal subtype in the renaming case too.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/gcc-interface/decl.cc | 12
1 file changed, 12 insertions(+)
diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
index 20ab185d577..95fa508c559 100644
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -1145,6 +1145,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree
gnu_expr, bool definition)
the entity as indirect reference to the renamed object. */
if (Materialize_Entity (gnat_entity))
{
+ /* If this is an aliased object with an unconstrained array
+ nominal subtype, we make its type a thin reference, i.e.
+ the reference counterpart of a thin pointer, exactly as
+ we would have done in the non-renaming case below. */
+ if (Is_Constr_Subt_For_UN_Aliased (gnat_type)
+ && Is_Array_Type (gnat_und_type)
+ && !type_annotate_only)
+ {
+ tree gnu_array
+ = gnat_to_gnu_type (Base_Type (gnat_type));
+ gnu_type = TYPE_OBJECT_RECORD_TYPE (gnu_array);
+ }
gnu_type = build_reference_type (gnu_type);
const_flag = true;
volatile_flag = false;
--
2.42.0
