[multiple changes]

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 987642714892fff5e681a30565a8547b162fd42f..de1a91da2fe1acb8bb76360ab53b5eb31f9e6632 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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,

diff --git a/gcc/ada/g-debpoo.adb b/gcc/ada/g-debpoo.adb
index d51ae903c2bcc4aee13c8be4149f3f0623509996..98243fd76c42fdc61ffc0b39f77127f12e046aff 100644 (file)
--- a/gcc/ada/g-debpoo.adb
+++ b/gcc/ada/g-debpoo.adb
@@ -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;
 

diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 9e0acdc317ea4e9c924074c1637e48c180259ca2..f9e45540ea69dfabf53e3aec1305f30e2a805484 100644 (file)
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -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

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 31f6bd2a1f74fb92387209abb36b6c15029b57c8..26ed179296ff82fd34735f4650224bb047afaa0d 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -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);

diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb
index b859b14af74e8aaf45b6330bdd11e472f7b56cc4..506769873678c749dea74c8c310dfa9d9e0572fb 100644 (file)
--- a/gcc/ada/sem_dim.adb
+++ b/gcc/ada/sem_dim.adb
@@ -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));