procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2015-11-12  Philippe Gil  <gil@adacore.com>

	* g-debpoo.adb (Print_Address): print address in hexadecimal as
	in previous GNAT version (without secondary stack use)
	(Deallocate): Deallocate calling once Unlock_Task.all when it
	raise exception.

2015-11-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Analyze_Subtype_Declaration): Remove redundant
	copying of dimensions from parent type to subtype. This is
	properly done in Analyze_Dimension.
	* sem_dim.adb (Analyze_Dimension_Subtype_Declaration): Add entity
	to error message, so that reference to entity can be formatted
	properly.
	* opt.ads: Fix typo.

From-SVN: r230254
This commit is contained in:
Arnaud Charlet 2015-11-12 14:28:05 +01:00
parent aff557c74c
commit aef44df1e3
5 changed files with 59 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
gcc/ada/ChangeLog
View file

@ -1,3 +1,20 @@
2015-11-12 Philippe Gil <gil@adacore.com>
* g-debpoo.adb (Print_Address): print address in hexadecimal as
in previous GNAT version (without secondary stack use)
(Deallocate): Deallocate calling once Unlock_Task.all when it
raise exception.
2015-11-12 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Analyze_Subtype_Declaration): Remove redundant
copying of dimensions from parent type to subtype. This is
properly done in Analyze_Dimension.
* sem_dim.adb (Analyze_Dimension_Subtype_Declaration): Add entity
to error message, so that reference to entity can be formatted
properly.
* opt.ads: Fix typo.
2015-11-12 Bob Duff <duff@adacore.com>
* impunit.adb, lib-xref.ads, restrict.ads, scos.ads, sem_attr.ads,

37
gcc/ada/g-debpoo.adb
View file

@ -482,8 +482,34 @@ package body GNAT.Debug_Pools is
type My_Address is mod Memory_Size;
function To_My_Address is new Ada.Unchecked_Conversion
(System.Address, My_Address);
Address_To_Print : My_Address := To_My_Address (Addr);
type Hexadecimal_Element is range 0 .. 15;
Hexadecimal_Characters : constant array
(Hexadecimal_Element) of Character :=
('0', '1', '2', '3', '4', '5', '6', '7',
'8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
pragma Warnings
(Off, "types for unchecked conversion have different sizes");
function To_Hexadecimal_Element is new Ada.Unchecked_Conversion
(My_Address, Hexadecimal_Element);
pragma Warnings
(On, "types for unchecked conversion have different sizes");
Number_Of_Hexadecimal_Characters_In_Address : constant Natural :=
Standard'Address_Size / 4;
type Hexadecimal_Elements_Range is
range 1 .. Number_Of_Hexadecimal_Characters_In_Address;
Hexadecimal_Elements : array (Hexadecimal_Elements_Range) of
Hexadecimal_Element;
begin
Put (File, My_Address'Image (To_My_Address (Addr)));
for Index in Hexadecimal_Elements_Range loop
Hexadecimal_Elements (Index) :=
To_Hexadecimal_Element (Address_To_Print mod 16);
Address_To_Print := Address_To_Print / 16;
end loop;
Put (File, "0x");
for Index in reverse Hexadecimal_Elements_Range loop
Put (File, Hexadecimal_Characters (Hexadecimal_Elements (Index)));
end loop;
end Print_Address;
--------------
@ -1406,6 +1432,7 @@ package body GNAT.Debug_Pools is
is
pragma Unreferenced (Alignment);
Unlock_Task_Required : Boolean := False;
Header : constant Allocation_Header_Access :=
Header_Of (Storage_Address);
Valid : Boolean;
@ -1414,9 +1441,11 @@ package body GNAT.Debug_Pools is
begin
<<Deallocate_Label>>
Lock_Task.all;
Unlock_Task_Required := True;
Valid := Is_Valid (Storage_Address);
if not Valid then
Unlock_Task_Required := False;
Unlock_Task.all;
if Storage_Address = System.Null_Address then
@ -1453,6 +1482,7 @@ package body GNAT.Debug_Pools is
end if;
elsif Header.Block_Size < 0 then
Unlock_Task_Required := False;
Unlock_Task.all;
if Pool.Raise_Exceptions then
raise Freeing_Deallocated_Storage;
@ -1574,12 +1604,15 @@ package body GNAT.Debug_Pools is
-- Do not physically release the memory here, but in Alloc.
-- See comment there for details.
Unlock_Task_Required := False;
Unlock_Task.all;
end if;
exception
when others =>
Unlock_Task.all;
if Unlock_Task_Required then
Unlock_Task.all;
end if;
raise;
end Deallocate;

4
gcc/ada/opt.ads
View file

@ -1376,7 +1376,7 @@ package Opt is
Style_Check_Main : Boolean := False;
-- GNAT
-- Set True if Style_Check was set for the main unit. This is used to
-- renable style checks for units in the mail extended source that get
-- enable style checks for units in the main extended source that get
-- with'ed indirectly. It is set True by use of either the -gnatg or
-- -gnaty switches, but not by use of the Style_Checks pragma.
@ -2058,7 +2058,7 @@ package Opt is
-- unit. This affects setting of the assert/debug pragma switches, which
-- are normally set false by default for an internal unit, except when the
-- internal unit is the main unit, in which case we use the command line
-- settings).
-- settings.
procedure Restore_Opt_Config_Switches (Save : Config_Switches_Type);
-- This procedure restores a set of switch values previously saved by a

4
gcc/ada/sem_ch3.adb
View file

@ -4833,7 +4833,9 @@ package body Sem_Ch3 is
Set_Scalar_Range (Id, Scalar_Range (T));
Set_Digits_Value (Id, Digits_Value (T));
Set_Is_Constrained (Id, Is_Constrained (T));
Copy_Dimensions (From => T, To => Id);
-- If the floating point type has dimensions, these will be
-- inherited subsequently when Analyze_Dimensions is called.
when Signed_Integer_Kind =>
Set_Ekind (Id, E_Signed_Integer_Subtype);

4
gcc/ada/sem_dim.adb
View file

@ -2227,8 +2227,8 @@ package body Sem_Dim is
-- it cannot inherit a dimension from its subtype.
if Exists (Dims_Of_Id) then
Error_Msg_N
("subtype& already" & Dimensions_Msg_Of (Id, True), N);
Error_Msg_NE
("subtype& already " & Dimensions_Msg_Of (Id, True), N, Id);
else
Set_Dimensions (Id, Dims_Of_Etyp);
Set_Symbol (Id, Symbol_Of (Etyp));