From 497a660d21f75362b8b6c7e4f4463a2ffbdeb38e Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 22 Jun 2016 12:48:33 +0200 Subject: [multiple changes] 2016-06-22 Hristian Kirtchev * sem_ch3.adb, sem_type.adb, sem.adb, freeze.adb, sem_util.adb, s-htable.adb, exp_ch11.adb, s-secsta.adb, restrict.adb, exp_disp.adb, sem_ch8.adb, s-tpobop.adb, exp_aggr.ads, sem_ch13.adb: Minor reformatting. 2016-06-22 Yannick Moy * lib-xref-spark_specific.adb (Collect_SPARK_Xrefs): Inverse order of treatments so that files without compilation unit are simply skipped before more elaborate treatments. 2016-06-22 Bob Duff * s-memory.ads: Minor typo fixes in comments. * s-memory.adb: Code cleanup. From-SVN: r237697 --- gcc/ada/ChangeLog | 18 +++++++ gcc/ada/exp_aggr.ads | 3 +- gcc/ada/exp_ch11.adb | 3 +- gcc/ada/exp_disp.adb | 4 +- gcc/ada/freeze.adb | 17 ++++--- gcc/ada/lib-xref-spark_specific.adb | 97 +++++++++++++++++++------------------ gcc/ada/restrict.adb | 3 +- gcc/ada/s-htable.adb | 4 +- gcc/ada/s-memory.adb | 23 +++++---- gcc/ada/s-memory.ads | 8 +-- gcc/ada/s-secsta.adb | 38 +++++++-------- gcc/ada/s-tpobop.adb | 12 ++--- gcc/ada/sem.adb | 2 +- gcc/ada/sem_ch13.adb | 2 +- gcc/ada/sem_ch3.adb | 4 +- gcc/ada/sem_ch8.adb | 10 ++-- gcc/ada/sem_type.adb | 7 +-- gcc/ada/sem_util.adb | 4 +- 18 files changed, 142 insertions(+), 117 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 518b70e..80d03e0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2016-06-22 Hristian Kirtchev + + * sem_ch3.adb, sem_type.adb, sem.adb, freeze.adb, sem_util.adb, + s-htable.adb, exp_ch11.adb, s-secsta.adb, restrict.adb, exp_disp.adb, + sem_ch8.adb, s-tpobop.adb, exp_aggr.ads, sem_ch13.adb: Minor + reformatting. + +2016-06-22 Yannick Moy + + * lib-xref-spark_specific.adb (Collect_SPARK_Xrefs): Inverse order of + treatments so that files without compilation unit are simply skipped + before more elaborate treatments. + +2016-06-22 Bob Duff + + * s-memory.ads: Minor typo fixes in comments. + * s-memory.adb: Code cleanup. + 2016-05-22 Olivier Hainque * vxworks-crtbe-link.spec: Removed, no longer used. diff --git a/gcc/ada/exp_aggr.ads b/gcc/ada/exp_aggr.ads index 5d14f1d..912f546 100644 --- a/gcc/ada/exp_aggr.ads +++ b/gcc/ada/exp_aggr.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -62,4 +62,5 @@ package Exp_Aggr is -- are compile-time known constants, rewrite N as a purely positional -- aggregate, to be use to initialize variables and components of the type -- without generating elaboration code. + end Exp_Aggr; diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index 0c788de..1a507ef 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -440,7 +440,6 @@ package body Exp_Ch11 is -- expansion as described above. procedure Expand_Local_Exception_Handlers is - procedure Add_Exception_Label (H : Node_Id); -- H is an exception handler. First check for an Exception_Label -- already allocated for H. If none, allocate one, set the field in diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 62328d5..03c4558 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -3942,8 +3942,8 @@ package body Exp_Disp is if Present (Thunk_Id) then Append_To (Result, Thunk_Code); - Prim_Table (UI_To_Int (DT_Position (Prim))) - := Thunk_Id; + Prim_Table (UI_To_Int (DT_Position (Prim))) := + Thunk_Id; end if; end if; end if; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index a0277c8..037ba2f 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -108,6 +108,14 @@ package body Freeze is -- Comp_ADC_Present is set True if the component has a Scalar_Storage_Order -- attribute definition clause. + procedure Check_Debug_Info_Needed (T : Entity_Id); + -- As each entity is frozen, this routine is called to deal with the + -- setting of Debug_Info_Needed for the entity. This flag is set if + -- the entity comes from source, or if we are in Debug_Generated_Code + -- mode or if the -gnatdV debug flag is set. However, it never sets + -- the flag if Debug_Info_Off is set. This procedure also ensures that + -- subsidiary entities have the flag set as required. + procedure Check_Expression_Function (N : Node_Id; Nam : Entity_Id); -- When an expression function is frozen by a use of it, the expression -- itself is frozen. Check that the expression does not include references @@ -186,14 +194,6 @@ package body Freeze is -- the default component alignment from the scope stack values if the -- alignment is otherwise not specified. - procedure Check_Debug_Info_Needed (T : Entity_Id); - -- As each entity is frozen, this routine is called to deal with the - -- setting of Debug_Info_Needed for the entity. This flag is set if - -- the entity comes from source, or if we are in Debug_Generated_Code - -- mode or if the -gnatdV debug flag is set. However, it never sets - -- the flag if Debug_Info_Off is set. This procedure also ensures that - -- subsidiary entities have the flag set as required. - procedure Set_SSO_From_Default (T : Entity_Id); -- T is a record or array type that is being frozen. If it is a base type, -- and if SSO_Set_Low/High_By_Default is set, then Reverse_Storage order @@ -2458,6 +2458,7 @@ package body Freeze is -- Bit packing is never needed for 8, 16, 32, 64 if Addressable (Csiz) then + -- If the Esize of the component is known and equal to -- the component size then even packing is not needed. diff --git a/gcc/ada/lib-xref-spark_specific.adb b/gcc/ada/lib-xref-spark_specific.adb index 28b167c..95056e0 100644 --- a/gcc/ada/lib-xref-spark_specific.adb +++ b/gcc/ada/lib-xref-spark_specific.adb @@ -931,74 +931,77 @@ package body SPARK_Specific is Sdep := 1; while Sdep <= Num_Sdep loop + -- Skip dependencies with no entity node, e.g. configuration files + -- with pragmas (.adc) or target description (.atp), since they + -- present no interest for SPARK cross references. + + if No (Cunit_Entity (Sdep_Table (Sdep))) then + Sdep_Next := Sdep + 1; + -- For library-level instantiation of a generic, two consecutive -- units refer to the same compilation unit node and entity (one to -- body, one to spec). In that case, treat them as a single unit for -- the sake of SPARK cross references by passing to Add_SPARK_File. - if Sdep < Num_Sdep - and then Cunit_Entity (Sdep_Table (Sdep)) = - Cunit_Entity (Sdep_Table (Sdep + 1)) - then - declare - Cunit1 : Node_Id renames Cunit (Sdep_Table (Sdep)); - Cunit2 : Node_Id renames Cunit (Sdep_Table (Sdep + 1)); - - begin - -- Both Cunit point to compilation unit nodes + else + if Sdep < Num_Sdep + and then Cunit_Entity (Sdep_Table (Sdep)) = + Cunit_Entity (Sdep_Table (Sdep + 1)) + then + declare + Cunit1 : Node_Id renames Cunit (Sdep_Table (Sdep)); + Cunit2 : Node_Id renames Cunit (Sdep_Table (Sdep + 1)); - pragma Assert - (Nkind (Cunit1) = N_Compilation_Unit - and then Nkind (Cunit2) = N_Compilation_Unit); + begin + -- Both Cunits point to compilation unit nodes - -- Do not depend on the sorting order, which is based on - -- Unit_Name and for library-level instances of nested - -- generic-packages they are equal. + pragma Assert + (Nkind (Cunit1) = N_Compilation_Unit + and then Nkind (Cunit2) = N_Compilation_Unit); - -- If declaration comes before the body + -- Do not depend on the sorting order, which is based on + -- Unit_Name, and for library-level instances of nested + -- generic packages they are equal. - if Nkind (Unit (Cunit1)) = N_Package_Declaration - and then Nkind (Unit (Cunit2)) = N_Package_Body - then - Uspec := Sdep_Table (Sdep); - Ubody := Sdep_Table (Sdep + 1); + -- If declaration comes before the body - Sdep_File := Sdep + 1; + if Nkind (Unit (Cunit1)) = N_Package_Declaration + and then Nkind (Unit (Cunit2)) = N_Package_Body + then + Uspec := Sdep_Table (Sdep); + Ubody := Sdep_Table (Sdep + 1); - -- If body comes before declaration + Sdep_File := Sdep + 1; - elsif Nkind (Unit (Cunit1)) = N_Package_Body - and then Nkind (Unit (Cunit2)) = N_Package_Declaration - then - Uspec := Sdep_Table (Sdep + 1); - Ubody := Sdep_Table (Sdep); + -- If body comes before declaration - Sdep_File := Sdep; + elsif Nkind (Unit (Cunit1)) = N_Package_Body + and then Nkind (Unit (Cunit2)) = N_Package_Declaration + then + Uspec := Sdep_Table (Sdep + 1); + Ubody := Sdep_Table (Sdep); - -- Otherwise it is an error + Sdep_File := Sdep; - else - raise Program_Error; - end if; + -- Otherwise it is an error - Sdep_Next := Sdep + 2; - end; + else + raise Program_Error; + end if; - -- ??? otherwise? + Sdep_Next := Sdep + 2; + end; - else - Uspec := Sdep_Table (Sdep); - Ubody := No_Unit; + -- ??? otherwise? - Sdep_File := Sdep; - Sdep_Next := Sdep + 1; - end if; + else + Uspec := Sdep_Table (Sdep); + Ubody := No_Unit; - -- Skip dependencies with no entity node, e.g. configuration files - -- with pragmas (.adc) or target description (.atp), since they - -- present no interest for SPARK cross references. + Sdep_File := Sdep; + Sdep_Next := Sdep + 1; + end if; - if Present (Cunit_Entity (Uspec)) then Add_SPARK_File (Uspec => Uspec, Ubody => Ubody, diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index 6cc308f..c56c2e0 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.adb @@ -1113,8 +1113,7 @@ package body Restrict is -- Note: body of this function must be coordinated with list of renaming -- declarations in System.Rident. - function Process_Restriction_Synonyms (N : Node_Id) return Name_Id - is + function Process_Restriction_Synonyms (N : Node_Id) return Name_Id is Old_Name : constant Name_Id := Chars (N); New_Name : Name_Id; diff --git a/gcc/ada/s-htable.adb b/gcc/ada/s-htable.adb index 2d6a3c6..ba956fc 100644 --- a/gcc/ada/s-htable.adb +++ b/gcc/ada/s-htable.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1995-2015, AdaCore -- +-- Copyright (C) 1995-2016, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -258,7 +258,7 @@ package body System.HTable is -- Get -- --------- - function Get (K : Key) return Element is + function Get (K : Key) return Element is Tmp : constant Elmt_Ptr := Tab.Get (K); begin if Tmp = null then diff --git a/gcc/ada/s-memory.adb b/gcc/ada/s-memory.adb index 48e3a3d..4c43766 100644 --- a/gcc/ada/s-memory.adb +++ b/gcc/ada/s-memory.adb @@ -67,8 +67,17 @@ package body System.Memory is function Alloc (Size : size_t) return System.Address is Result : System.Address; - begin + -- A previous version moved the check for size_t'Last below, into the + -- "if Result = System.Null_Address...". So malloc(size_t'Last) should + -- return Null_Address, and then we can check for that special value. + -- However, that doesn't work on VxWorks, because malloc(size_t'Last) + -- prints an unwanted warning message before returning Null_Address. + + if Size = size_t'Last then + raise Storage_Error with "object too large"; + end if; + if Parameters.No_Abort then Result := c_malloc (System.CRTL.size_t (Size)); else @@ -98,10 +107,6 @@ package body System.Memory is return Alloc (1); end if; - if Size = size_t'Last then - raise Storage_Error with "object too large"; - end if; - raise Storage_Error with "heap exhausted"; end if; @@ -134,6 +139,10 @@ package body System.Memory is is Result : System.Address; begin + if Size = size_t'Last then + raise Storage_Error with "object too large"; + end if; + if Parameters.No_Abort then Result := c_realloc (Ptr, System.CRTL.size_t (Size)); else @@ -143,10 +152,6 @@ package body System.Memory is end if; if Result = System.Null_Address then - if Size = size_t'Last then - raise Storage_Error with "object too large"; - end if; - raise Storage_Error with "heap exhausted"; end if; diff --git a/gcc/ada/s-memory.ads b/gcc/ada/s-memory.ads index 87a129a..a8c1251 100644 --- a/gcc/ada/s-memory.ads +++ b/gcc/ada/s-memory.ads @@ -56,10 +56,10 @@ package System.Memory is -- memory. The implementation of this routine is guaranteed to be -- task safe, and also aborts are deferred if necessary. -- - -- If size_t is set to size_t'Last on entry, then a Storage_Error + -- If Size is set to size_t'Last on entry, then a Storage_Error -- exception is raised with a message "object too large". -- - -- If size_t is set to zero on entry, then a minimal (but non-zero) + -- If Size is set to zero on entry, then a minimal (but non-zero) -- size block is allocated. -- -- Note: this is roughly equivalent to the standard C malloc call @@ -87,10 +87,10 @@ package System.Memory is -- routine is guaranteed to be task safe, and also aborts are -- deferred as necessary. -- - -- If size_t is set to size_t'Last on entry, then a Storage_Error + -- If Size is set to size_t'Last on entry, then a Storage_Error -- exception is raised with a message "object too large". -- - -- If size_t is set to zero on entry, then a minimal (but non-zero) + -- If Size is set to zero on entry, then a minimal (but non-zero) -- size block is allocated. -- -- Note: this is roughly equivalent to the standard C realloc call diff --git a/gcc/ada/s-secsta.adb b/gcc/ada/s-secsta.adb index f8142fb..30e03de 100644 --- a/gcc/ada/s-secsta.adb +++ b/gcc/ada/s-secsta.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -80,20 +80,20 @@ package body System.Secondary_Stack is -- | | First (101) -- +------------------+ -- +----------> | | | - -- | +----------+-------+ + -- | +--------- | ------+ + -- | ^ | -- | | | - -- | ^ V - -- | | | - -- | +-------+----------+ + -- | | V + -- | +------ | ---------+ -- | | | | -- | +------------------+ -- | | | Last (100) -- | | C | -- | | H | - -- +-----------------+ | +-------->| U | - -- | Current_Chunk -|--+ | | N | - -- +-----------------+ | | K | - -- | Top -|-----+ | | First (1) + -- +-----------------+ | +------->| U | + -- | Current_Chunk ----+ | | N | + -- +-----------------+ | | K | + -- | Top --------+ | | First (1) -- +-----------------+ +------------------+ -- | Default_Size | | Prev | -- +-----------------+ +------------------+ @@ -178,10 +178,10 @@ package body System.Secondary_Stack is (Addr : out Address; Storage_Size : SSE.Storage_Count) is - Max_Align : constant SS_Ptr := SS_Ptr (Standard'Maximum_Alignment); - Max_Size : constant SS_Ptr := - ((SS_Ptr (Storage_Size) + Max_Align - 1) / Max_Align) - * Max_Align; + Max_Align : constant SS_Ptr := SS_Ptr (Standard'Maximum_Alignment); + Max_Size : constant SS_Ptr := + ((SS_Ptr (Storage_Size) + Max_Align - 1) / Max_Align) * + Max_Align; begin -- Case of fixed allocation secondary stack @@ -227,7 +227,7 @@ package body System.Secondary_Stack is Chunk := Stack.Current_Chunk; -- The Current_Chunk may not be the good one if a lot of release - -- operations have taken place. So go down the stack if necessary + -- operations have taken place. Go down the stack if necessary. while Chunk.First > Stack.Top loop Chunk := Chunk.Prev; @@ -250,8 +250,8 @@ package body System.Secondary_Stack is Free (To_Be_Released_Chunk); end if; - -- Create new chunk of default size unless it is not - -- sufficient to satisfy the current request. + -- Create new chunk of default size unless it is not sufficient + -- to satisfy the current request. elsif SSE.Storage_Count (Max_Size) <= Stack.Default_Size then Chunk.Next := @@ -261,7 +261,7 @@ package body System.Secondary_Stack is Chunk.Next.Prev := Chunk; - -- Otherwise create new chunk of requested size + -- Otherwise create new chunk of requested size else Chunk.Next := @@ -500,8 +500,8 @@ package body System.Secondary_Stack is Chunk : aliased Chunk_Id (1, Static_Secondary_Stack_Size); for Chunk'Alignment use Standard'Maximum_Alignment; - -- Default chunk used, unless gnatbind -D is specified with a value - -- greater than Static_Secondary_Stack_Size + -- Default chunk used, unless gnatbind -D is specified with a value greater + -- than Static_Secondary_Stack_Size. begin declare diff --git a/gcc/ada/s-tpobop.adb b/gcc/ada/s-tpobop.adb index aaf1820..e242bb0 100644 --- a/gcc/ada/s-tpobop.adb +++ b/gcc/ada/s-tpobop.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2016, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -345,14 +345,12 @@ package body System.Tasking.Protected_Objects.Operations is elsif Entry_Call.Mode /= Conditional_Call or else not Entry_Call.With_Abort then - if Run_Time_Restrictions.Set (Max_Entry_Queue_Length) - and then - Run_Time_Restrictions.Value (Max_Entry_Queue_Length) <= - Queuing.Count_Waiting (Object.Entry_Queues (E)) + and then Run_Time_Restrictions.Value (Max_Entry_Queue_Length) <= + Queuing.Count_Waiting (Object.Entry_Queues (E)) then - -- This violates the Max_Entry_Queue_Length restriction, - -- raise Program_Error. + -- This violates the Max_Entry_Queue_Length restriction, raise + -- Program_Error. Entry_Call.Exception_To_Raise := Program_Error'Identity; diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index ea5f474..7a86644 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -205,7 +205,7 @@ package body Sem is when N_Entry_Declaration => Analyze_Entry_Declaration (N); - when N_Entry_Index_Specification => + when N_Entry_Index_Specification => Analyze_Entry_Index_Specification (N); when N_Enumeration_Representation_Clause => diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 6896dac..b631b9c 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -12367,7 +12367,7 @@ package body Sem_Ch13 is if Chars (N) /= TName then if Present (Current_Entity (N)) - and then Is_Type (Current_Entity (N)) + and then Is_Type (Current_Entity (N)) then Freeze_Before (Freeze_Node (T), Current_Entity (N)); end if; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index d34db02..be0fa8f 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -2436,8 +2436,8 @@ package body Sem_Ch3 is null; elsif L /= Visible_Declarations (Parent (L)) - or else No (Private_Declarations (Parent (L))) - or else Is_Empty_List (Private_Declarations (Parent (L))) + or else No (Private_Declarations (Parent (L))) + or else Is_Empty_List (Private_Declarations (Parent (L))) then Adjust_Decl; Freeze_All (First_Entity (Current_Scope), Decl); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 0c5860b..0f43ecf 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -4812,9 +4812,9 @@ package body Sem_Ch8 is or else Name_Buffer (3 .. 5) = "aux"; - -- If not an internal file, then entity is definitely known, - -- even if it is in a private part (the message generated will - -- note that it is in a private part) + -- If not an internal file, then entity is definitely known, even if + -- it is in a private part (the message generated will note that it + -- is in a private part). else return True; @@ -6104,8 +6104,8 @@ package body Sem_Ch8 is null; else Error_Msg_N - ("limited withed package can only be used to access " - & "incomplete types", N); + ("limited withed package can only be used to access incomplete " + & "types", N); end if; end if; diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 5aaaa60..2879c3c 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -638,8 +638,9 @@ package body Sem_Type is H := Current_Entity (Ent); while Present (H) loop - exit when (not Is_Overloadable (H)) - and then Is_Immediately_Visible (H); + exit when + not Is_Overloadable (H) + and then Is_Immediately_Visible (H); if Is_Immediately_Visible (H) and then H /= Ent then diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 8ff3535..0c4f9eb 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -16273,9 +16273,9 @@ package body Sem_Util is function New_Copy_Tree (Source : Node_Id; - Map : Elist_Id := No_Elist; + Map : Elist_Id := No_Elist; New_Sloc : Source_Ptr := No_Location; - New_Scope : Entity_Id := Empty) return Node_Id + New_Scope : Entity_Id := Empty) return Node_Id is Actual_Map : Elist_Id := Map; -- This is the actual map for the copy. It is initialized with the -- cgit v1.1