OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2016-06-22  Hristian Kirtchev  <kirtchev@adacore.com>

	* 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  <moy@adacore.com>

	* 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  <duff@adacore.com>

	* s-memory.ads: Minor typo fixes in comments.
	* s-memory.adb: Code cleanup.

From-SVN: r237697
This commit is contained in:
Arnaud Charlet 2016-06-22 12:48:33 +02:00
parent 35484fc8b0
commit 497a660d21
18 changed files with 154 additions and 129 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
gcc/ada/ChangeLog
View File

@ -1,3 +1,21 @@
2016-06-22 Hristian Kirtchev <kirtchev@adacore.com>
* 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 <moy@adacore.com>
* 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 <duff@adacore.com>
* s-memory.ads: Minor typo fixes in comments.
* s-memory.adb: Code cleanup.
2016-05-22 Olivier Hainque <hainque@adacore.com>
* vxworks-crtbe-link.spec: Removed, no longer used.

3
gcc/ada/exp_aggr.ads
View File

@ -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;

3
gcc/ada/exp_ch11.adb
View File

@ -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

4
gcc/ada/exp_disp.adb
View File

@ -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;

17
gcc/ada/freeze.adb
View File

@ -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.

19
gcc/ada/lib-xref-spark_specific.adb
View File

@ -931,11 +931,19 @@ 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.
else
if Sdep < Num_Sdep
and then Cunit_Entity (Sdep_Table (Sdep)) =
Cunit_Entity (Sdep_Table (Sdep + 1))
@ -945,15 +953,15 @@ package body SPARK_Specific is
Cunit2 : Node_Id renames Cunit (Sdep_Table (Sdep + 1));
begin
-- Both Cunit point to compilation unit nodes
-- Both Cunits point to compilation unit nodes
pragma Assert
(Nkind (Cunit1) = N_Compilation_Unit
and then Nkind (Cunit2) = N_Compilation_Unit);
-- 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.
-- Unit_Name, and for library-level instances of nested
-- generic packages they are equal.
-- If declaration comes before the body
@ -994,11 +1002,6 @@ package body SPARK_Specific is
Sdep_Next := Sdep + 1;
end if;
-- 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 Present (Cunit_Entity (Uspec)) then
Add_SPARK_File
(Uspec => Uspec,
Ubody => Ubody,

3
gcc/ada/restrict.adb
View File

@ -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;

2
gcc/ada/s-htable.adb
View File

@ -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- --

23
gcc/ada/s-memory.adb
View File

@ -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;

8
gcc/ada/s-memory.ads
View File

@ -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

30
gcc/ada/s-secsta.adb
View File

@ -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 |
-- +-----------------+ | +------->| U |
-- | Current_Chunk ----+ | | N |
-- +-----------------+ | | K |
-- | Top -|-----+ | | First (1)
-- | Top --------+ | | First (1)
-- +-----------------+ +------------------+
-- | Default_Size | | Prev |
-- +-----------------+ +------------------+
@ -180,8 +180,8 @@ package body System.Secondary_Stack is
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;
((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 :=
@ -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

10
gcc/ada/s-tpobop.adb
View File

@ -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) <=
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;

10
gcc/ada/sem_ch8.adb
View File

@ -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;

5
gcc/ada/sem_type.adb
View File

@ -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,7 +638,8 @@ package body Sem_Type is
H := Current_Entity (Ent);
while Present (H) loop
exit when (not Is_Overloadable (H))
exit when
not Is_Overloadable (H)
and then Is_Immediately_Visible (H);
if Is_Immediately_Visible (H) and then H /= Ent then