[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Tue, 20 Oct 2015 10:20:37 +0000 (12:20 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Tue, 20 Oct 2015 10:20:37 +0000 (12:20 +0200)
2015-10-20  Bob Duff  <duff@adacore.com>

* a-contai.adb, a-coinve.ads, a-contai.ads, a-conhel.adb, a-conhel.ads,
Makefile.rtl, a-convec.ads: Move helper code from Ada.Containers to a
new package Ada.Containers.Helpers, because otherwise it's not
visible everywhere it needs to be (e.g. in the package
Ada.Containers.Red_Black_Trees, Generic_Tree_Types wants to have
a component of type Tamper_Counts).

2015-10-20  Ed Schonberg  <schonberg@adacore.com>

* sem_type.adb (Intersect_Types): Specialize error message when
one operand is a limited view which is a priori incompatible
with all other named types.
* sem_prag.adb: minor fix in comment
* sem_ch13.adb: Code clean up.

2015-10-20  Eric Botcazou  <ebotcazou@adacore.com>

* sem_ch12.adb (Need_Subprogram_Instance_Body): Also return true
for a subprogram nested in an inlined subprogram.

From-SVN: r229040

12 files changed:
gcc/ada/ChangeLog
gcc/ada/Makefile.rtl
gcc/ada/a-coinve.ads
gcc/ada/a-conhel.adb [new file with mode: 0644]
gcc/ada/a-conhel.ads [new file with mode: 0644]
gcc/ada/a-contai.adb [deleted file]
gcc/ada/a-contai.ads
gcc/ada/a-convec.ads
gcc/ada/sem_ch12.adb
gcc/ada/sem_ch13.adb
gcc/ada/sem_prag.adb
gcc/ada/sem_type.adb

index a7a11174cb989d62458a3d1838065619a669f0fe..773b6a128f0ea39c52012d169881acf42a1178ac 100644 (file)
@@ -1,3 +1,25 @@
+2015-10-20  Bob Duff  <duff@adacore.com>
+
+       * a-contai.adb, a-coinve.ads, a-contai.ads, a-conhel.adb, a-conhel.ads,
+       Makefile.rtl, a-convec.ads: Move helper code from Ada.Containers to a
+       new package Ada.Containers.Helpers, because otherwise it's not
+       visible everywhere it needs to be (e.g. in the package
+       Ada.Containers.Red_Black_Trees, Generic_Tree_Types wants to have
+       a component of type Tamper_Counts).
+
+2015-10-20  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_type.adb (Intersect_Types): Specialize error message when
+       one operand is a limited view which is a priori incompatible
+       with all other named types.
+       * sem_prag.adb: minor fix in comment
+       * sem_ch13.adb: Code clean up.
+
+2015-10-20  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * sem_ch12.adb (Need_Subprogram_Instance_Body): Also return true
+       for a subprogram nested in an inlined subprogram.
+
 2015-10-20  Bob Duff  <duff@adacore.com>
 
        * a-coinve.adb, a-contai.adb: Update comments.
index 5b71295dfa5768499ad8e071370bf4dbd897e641..68d8dc708cd02a27d6f8a7de628a9cf715966bf8 100644 (file)
@@ -148,6 +148,7 @@ GNATRTL_NONTASKING_OBJS= \
   a-colire$(objext) \
   a-comlin$(objext) \
   a-comutr$(objext) \
+  a-conhel$(objext) \
   a-contai$(objext) \
   a-convec$(objext) \
   a-coorma$(objext) \
index 978b49a455ae9755f4abf107ba0015ddc08de7a7..5cb97d53ddbbf6a07b1aa64ab02744fa541f3295 100644 (file)
@@ -33,6 +33,7 @@
 
 with Ada.Iterator_Interfaces;
 
+private with Ada.Containers.Helpers;
 private with Ada.Finalization;
 private with Ada.Streams;
 
@@ -357,6 +358,7 @@ private
    pragma Inline (Next);
    pragma Inline (Previous);
 
+   use Ada.Containers.Helpers;
    package Implementation is new Generic_Implementation;
    use Implementation;
 
diff --git a/gcc/ada/a-conhel.adb b/gcc/ada/a-conhel.adb
new file mode 100644 (file)
index 0000000..11fe035
--- /dev/null
@@ -0,0 +1,186 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--               A D A . C O N T A I N E R S . H E L P E R S                --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--             Copyright (C) 2015, 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+------------------------------------------------------------------------------
+
+package body Ada.Containers.Helpers is
+
+   package body Generic_Implementation is
+
+      use SAC;
+
+      ------------
+      -- Adjust --
+      ------------
+
+      procedure Adjust (Control : in out Reference_Control_Type) is
+         pragma Warnings (Off);
+         --  GNAT warns here if checks are turned off, but assertions on
+         pragma Assert (T_Check); -- not called if check suppressed
+         pragma Warnings (On);
+      begin
+         if Control.T_Counts /= null then
+            Lock (Control.T_Counts.all);
+         end if;
+      end Adjust;
+
+      ----------
+      -- Busy --
+      ----------
+
+      procedure Busy (T_Counts : in out Tamper_Counts) is
+      begin
+         if T_Check then
+            Increment (T_Counts.Busy);
+         end if;
+      end Busy;
+
+      --------------
+      -- Finalize --
+      --------------
+
+      procedure Finalize (Control : in out Reference_Control_Type) is
+         pragma Warnings (Off);
+         pragma Assert (T_Check); -- not called if check suppressed
+         pragma Warnings (On);
+      begin
+         if Control.T_Counts /= null then
+            Unlock (Control.T_Counts.all);
+            Control.T_Counts := null;
+         end if;
+      end Finalize;
+
+      --  No need to protect against double Finalize here, because these types
+      --  are limited.
+
+      procedure Finalize (Busy : in out With_Busy) is
+         pragma Warnings (Off);
+         pragma Assert (T_Check); -- not called if check suppressed
+         pragma Warnings (On);
+      begin
+         Unbusy (Busy.T_Counts.all);
+      end Finalize;
+
+      procedure Finalize (Lock : in out With_Lock) is
+         pragma Warnings (Off);
+         pragma Assert (T_Check); -- not called if check suppressed
+         pragma Warnings (On);
+      begin
+         Unlock (Lock.T_Counts.all);
+      end Finalize;
+
+      ----------------
+      -- Initialize --
+      ----------------
+
+      procedure Initialize (Busy : in out With_Busy) is
+         pragma Warnings (Off);
+         pragma Assert (T_Check); -- not called if check suppressed
+         pragma Warnings (On);
+      begin
+         Generic_Implementation.Busy (Busy.T_Counts.all);
+      end Initialize;
+
+      procedure Initialize (Lock : in out With_Lock) is
+         pragma Warnings (Off);
+         pragma Assert (T_Check); -- not called if check suppressed
+         pragma Warnings (On);
+      begin
+         Generic_Implementation.Lock (Lock.T_Counts.all);
+      end Initialize;
+
+      ----------
+      -- Lock --
+      ----------
+
+      procedure Lock (T_Counts : in out Tamper_Counts) is
+      begin
+         if T_Check then
+            Increment (T_Counts.Lock);
+            Increment (T_Counts.Busy);
+         end if;
+      end Lock;
+
+      --------------
+      -- TC_Check --
+      --------------
+
+      procedure TC_Check (T_Counts : Tamper_Counts) is
+      begin
+         if T_Check and then T_Counts.Busy > 0 then
+            raise Program_Error with
+              "attempt to tamper with cursors";
+         end if;
+      end TC_Check;
+
+      --------------
+      -- TE_Check --
+      --------------
+
+      procedure TE_Check (T_Counts : Tamper_Counts) is
+      begin
+         if T_Check and then T_Counts.Lock > 0 then
+            raise Program_Error with
+              "attempt to tamper with elements";
+         end if;
+      end TE_Check;
+
+      ------------
+      -- Unbusy --
+      ------------
+
+      procedure Unbusy (T_Counts : in out Tamper_Counts) is
+      begin
+         if T_Check then
+            Decrement (T_Counts.Busy);
+         end if;
+      end Unbusy;
+
+      ------------
+      -- Unlock --
+      ------------
+
+      procedure Unlock (T_Counts : in out Tamper_Counts) is
+      begin
+         if T_Check then
+            Decrement (T_Counts.Lock);
+            Decrement (T_Counts.Busy);
+         end if;
+      end Unlock;
+
+      -----------------
+      -- Zero_Counts --
+      -----------------
+
+      procedure Zero_Counts (T_Counts : out Tamper_Counts) is
+      begin
+         if T_Check then
+            T_Counts := (others => <>);
+         end if;
+      end Zero_Counts;
+
+   end Generic_Implementation;
+
+end Ada.Containers.Helpers;
diff --git a/gcc/ada/a-conhel.ads b/gcc/ada/a-conhel.ads
new file mode 100644 (file)
index 0000000..e48c03b
--- /dev/null
@@ -0,0 +1,160 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--               A D A . C O N T A I N E R S . H E L P E R S                --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--             Copyright (C) 2015, 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+------------------------------------------------------------------------------
+
+with Ada.Finalization;
+with System.Atomic_Counters;
+
+package Ada.Containers.Helpers is
+   pragma Pure;
+
+   --  Miscellaneous helpers shared among various containers
+
+   package SAC renames System.Atomic_Counters;
+
+   Count_Type_Last : constant := Count_Type'Last;
+   --  Count_Type'Last as a universal_integer, so we can compare Index_Type
+   --  values against this without type conversions that might overflow.
+
+   type Tamper_Counts is record
+      Busy : aliased SAC.Atomic_Unsigned := 0;
+      Lock : aliased SAC.Atomic_Unsigned := 0;
+   end record;
+
+   --  Busy is positive when tampering with cursors is prohibited. Busy and
+   --  Lock are both positive when tampering with elements is prohibited.
+
+   type Tamper_Counts_Access is access all Tamper_Counts;
+   for Tamper_Counts_Access'Storage_Size use 0;
+
+   generic
+   package Generic_Implementation is
+
+      --  Generic package used in the implementation of containers.
+      --  ???????????????????Currently used by Vectors; not yet by all other
+      --  containers.
+
+      --  This needs to be generic so that the 'Enabled attribute will return
+      --  the value that is relevant at the point where a container generic is
+      --  instantiated. For example:
+      --
+      --     pragma Suppress (Container_Checks);
+      --     package My_Vectors is new Ada.Containers.Vectors (...);
+      --
+      --  should suppress all container-related checks within the instance
+      --  My_Vectors.
+
+      --  Shorthands for "checks enabled" and "tampering checks enabled". Note
+      --  that suppressing either Container_Checks or Tampering_Check disables
+      --  tampering checks. Note that this code needs to be in a generic
+      --  package, because we want to take account of check suppressions at the
+      --  instance. We use these flags, along with pragma Inline, to ensure
+      --  that the compiler can optimize away the checks, as well as the
+      --  tampering check machinery, when checks are suppressed.
+
+      Checks : constant Boolean := Container_Checks'Enabled;
+      T_Check : constant Boolean :=
+        Container_Checks'Enabled and Tampering_Check'Enabled;
+
+      --  Reference_Control_Type is used as a component of reference types, to
+      --  prohibit tampering with elements so long as references exist.
+
+      type Reference_Control_Type is
+         new Finalization.Controlled with record
+            T_Counts : Tamper_Counts_Access;
+         end record
+           with Disable_Controlled => not T_Check;
+
+      overriding procedure Adjust (Control : in out Reference_Control_Type);
+      pragma Inline (Adjust);
+
+      overriding procedure Finalize (Control : in out Reference_Control_Type);
+      pragma Inline (Finalize);
+
+      procedure Zero_Counts (T_Counts : out Tamper_Counts);
+      pragma Inline (Zero_Counts);
+      --  Set Busy and Lock to zero
+
+      procedure Busy (T_Counts : in out Tamper_Counts);
+      pragma Inline (Busy);
+      --  Prohibit tampering with cursors
+
+      procedure Unbusy (T_Counts : in out Tamper_Counts);
+      pragma Inline (Unbusy);
+      --  Allow tampering with cursors
+
+      procedure Lock (T_Counts : in out Tamper_Counts);
+      pragma Inline (Lock);
+      --  Prohibit tampering with elements
+
+      procedure Unlock (T_Counts : in out Tamper_Counts);
+      pragma Inline (Unlock);
+      --  Allow tampering with elements
+
+      procedure TC_Check (T_Counts : Tamper_Counts);
+      pragma Inline (TC_Check);
+      --  Tampering-with-cursors check
+
+      procedure TE_Check (T_Counts : Tamper_Counts);
+      pragma Inline (TE_Check);
+      --  Tampering-with-elements check
+
+      -----------------
+      --  RAII Types --
+      -----------------
+
+      --  Initialize of With_Busy increments the Busy count, and Finalize
+      --  decrements it. Thus, to prohibit tampering with elements within a
+      --  given scope, declare an object of type With_Busy. The Busy count
+      --  will be correctly decremented in case of exception or abort.
+
+      --  With_Lock is the same as With_Busy, except it increments/decrements
+      --  BOTH Busy and Lock, thus prohibiting tampering with cursors.
+
+      type With_Busy (T_Counts : not null access Tamper_Counts) is
+        new Finalization.Limited_Controlled with null record
+          with Disable_Controlled => not T_Check;
+      overriding procedure Initialize (Busy : in out With_Busy);
+      overriding procedure Finalize (Busy : in out With_Busy);
+
+      type With_Lock (T_Counts : not null access Tamper_Counts) is
+        new Finalization.Limited_Controlled with null record
+          with Disable_Controlled => not T_Check;
+      overriding procedure Initialize (Lock : in out With_Lock);
+      overriding procedure Finalize (Lock : in out With_Lock);
+
+      --  Variables of type With_Busy and With_Lock are declared only for the
+      --  effects of Initialize and Finalize, so they are not referenced;
+      --  disable warnings about that. Note that all variables of these types
+      --  have names starting with "Busy" or "Lock". These pragmas need to be
+      --  present wherever these types are used.
+
+      pragma Warnings (Off, "variable ""Busy*"" is not referenced");
+      pragma Warnings (Off, "variable ""Lock*"" is not referenced");
+
+   end Generic_Implementation;
+
+end Ada.Containers.Helpers;
diff --git a/gcc/ada/a-contai.adb b/gcc/ada/a-contai.adb
deleted file mode 100644 (file)
index dc7c4be..0000000
+++ /dev/null
@@ -1,186 +0,0 @@
-------------------------------------------------------------------------------
---                                                                          --
---                         GNAT LIBRARY COMPONENTS                          --
---                                                                          --
---                       A D A . C O N T A I N E R S                        --
---                                                                          --
---                                 B o d y                                  --
---                                                                          --
---            Copyright (C) 2015, 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- --
--- ware  Foundation;  either version 3,  or (at your option) any later ver- --
--- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
---                                                                          --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception,   --
--- version 3.1, as published by the Free Software Foundation.               --
---                                                                          --
--- You should have received a copy of the GNU General Public License and    --
--- a copy of the GCC Runtime Library Exception along with this program;     --
--- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
--- <http://www.gnu.org/licenses/>.                                          --
-------------------------------------------------------------------------------
-
-package body Ada.Containers is
-
-   package body Generic_Implementation is
-
-      use SAC;
-
-      ------------
-      -- Adjust --
-      ------------
-
-      procedure Adjust (Control : in out Reference_Control_Type) is
-         pragma Warnings (Off);
-         --  GNAT warns here if checks are turned off, but assertions on
-         pragma Assert (T_Check); -- not called if check suppressed
-         pragma Warnings (On);
-      begin
-         if Control.T_Counts /= null then
-            Lock (Control.T_Counts.all);
-         end if;
-      end Adjust;
-
-      ----------
-      -- Busy --
-      ----------
-
-      procedure Busy (T_Counts : in out Tamper_Counts) is
-      begin
-         if T_Check then
-            Increment (T_Counts.Busy);
-         end if;
-      end Busy;
-
-      --------------
-      -- Finalize --
-      --------------
-
-      procedure Finalize (Control : in out Reference_Control_Type) is
-         pragma Warnings (Off);
-         pragma Assert (T_Check); -- not called if check suppressed
-         pragma Warnings (On);
-      begin
-         if Control.T_Counts /= null then
-            Unlock (Control.T_Counts.all);
-            Control.T_Counts := null;
-         end if;
-      end Finalize;
-
-      --  No need to protect against double Finalize here, because these types
-      --  are limited.
-
-      procedure Finalize (Busy : in out With_Busy) is
-         pragma Warnings (Off);
-         pragma Assert (T_Check); -- not called if check suppressed
-         pragma Warnings (On);
-      begin
-         Unbusy (Busy.T_Counts.all);
-      end Finalize;
-
-      procedure Finalize (Lock : in out With_Lock) is
-         pragma Warnings (Off);
-         pragma Assert (T_Check); -- not called if check suppressed
-         pragma Warnings (On);
-      begin
-         Unlock (Lock.T_Counts.all);
-      end Finalize;
-
-      ----------------
-      -- Initialize --
-      ----------------
-
-      procedure Initialize (Busy : in out With_Busy) is
-         pragma Warnings (Off);
-         pragma Assert (T_Check); -- not called if check suppressed
-         pragma Warnings (On);
-      begin
-         Generic_Implementation.Busy (Busy.T_Counts.all);
-      end Initialize;
-
-      procedure Initialize (Lock : in out With_Lock) is
-         pragma Warnings (Off);
-         pragma Assert (T_Check); -- not called if check suppressed
-         pragma Warnings (On);
-      begin
-         Generic_Implementation.Lock (Lock.T_Counts.all);
-      end Initialize;
-
-      ----------
-      -- Lock --
-      ----------
-
-      procedure Lock (T_Counts : in out Tamper_Counts) is
-      begin
-         if T_Check then
-            Increment (T_Counts.Lock);
-            Increment (T_Counts.Busy);
-         end if;
-      end Lock;
-
-      --------------
-      -- TC_Check --
-      --------------
-
-      procedure TC_Check (T_Counts : Tamper_Counts) is
-      begin
-         if T_Check and then T_Counts.Busy > 0 then
-            raise Program_Error with
-              "attempt to tamper with cursors";
-         end if;
-      end TC_Check;
-
-      --------------
-      -- TE_Check --
-      --------------
-
-      procedure TE_Check (T_Counts : Tamper_Counts) is
-      begin
-         if T_Check and then T_Counts.Lock > 0 then
-            raise Program_Error with
-              "attempt to tamper with elements";
-         end if;
-      end TE_Check;
-
-      ------------
-      -- Unbusy --
-      ------------
-
-      procedure Unbusy (T_Counts : in out Tamper_Counts) is
-      begin
-         if T_Check then
-            Decrement (T_Counts.Busy);
-         end if;
-      end Unbusy;
-
-      ------------
-      -- Unlock --
-      ------------
-
-      procedure Unlock (T_Counts : in out Tamper_Counts) is
-      begin
-         if T_Check then
-            Decrement (T_Counts.Lock);
-            Decrement (T_Counts.Busy);
-         end if;
-      end Unlock;
-
-      -----------------
-      -- Zero_Counts --
-      -----------------
-
-      procedure Zero_Counts (T_Counts : out Tamper_Counts) is
-      begin
-         if T_Check then
-            T_Counts := (others => <>);
-         end if;
-      end Zero_Counts;
-
-   end Generic_Implementation;
-
-end Ada.Containers;
index 4b0b7953141893b5564b74ea58507eeb540eb9a9..5ae53ff875da38be065ed8a30b3353d712283f7a 100644 (file)
@@ -22,9 +22,6 @@ pragma Check_Name (Tampering_Check);
 --  Tampering_Check as well as all the other (not-so-expensive) containers
 --  checks.
 
-private with Ada.Finalization;
-with System.Atomic_Counters;
-
 package Ada.Containers is
    pragma Pure;
 
@@ -33,129 +30,4 @@ package Ada.Containers is
 
    Capacity_Error : exception;
 
-private
-
-   package SAC renames System.Atomic_Counters;
-
-   Count_Type_Last : constant := Count_Type'Last;
-   --  Count_Type'Last as a universal_integer, so we can compare Index_Type
-   --  values against this without type conversions that might overflow.
-
-   type Tamper_Counts is record
-      Busy : aliased SAC.Atomic_Unsigned := 0;
-      Lock : aliased SAC.Atomic_Unsigned := 0;
-   end record;
-
-   --  Busy is positive when tampering with cursors is prohibited. Busy and
-   --  Lock are both positive when tampering with elements is prohibited.
-
-   type Tamper_Counts_Access is access all Tamper_Counts;
-   for Tamper_Counts_Access'Storage_Size use 0;
-
-   generic
-   package Generic_Implementation is
-
-      --  Generic package used in the implementation of containers.
-      --  ???Currently used by Vectors; not yet by all other containers.
-
-      --  This needs to be generic so that the 'Enabled attribute will return
-      --  the value that is relevant at the point where a container generic is
-      --  instantiated. For example:
-      --
-      --     pragma Suppress (Container_Checks);
-      --     package My_Vectors is new Ada.Containers.Vectors (...);
-      --
-      --  should suppress all container-related checks within the instance
-      --  My_Vectors.
-
-      --  Shorthands for "checks enabled" and "tampering checks enabled". Note
-      --  that suppressing either Container_Checks or Tampering_Check disables
-      --  tampering checks. Note that this code needs to be in a generic
-      --  package, because we want to take account of check suppressions at the
-      --  instance. We use these flags, along with pragma Inline, to ensure
-      --  that the compiler can optimize away the checks, as well as the
-      --  tampering check machinery, when checks are suppressed.
-
-      Checks : constant Boolean := Container_Checks'Enabled;
-      T_Check : constant Boolean :=
-        Container_Checks'Enabled and Tampering_Check'Enabled;
-
-      --  Reference_Control_Type is used as a component of reference types, to
-      --  prohibit tampering with elements so long as references exist.
-
-      type Reference_Control_Type is
-         new Finalization.Controlled with record
-            T_Counts : Tamper_Counts_Access;
-         end record
-           with Disable_Controlled => not T_Check;
-
-      overriding procedure Adjust (Control : in out Reference_Control_Type);
-      pragma Inline (Adjust);
-
-      overriding procedure Finalize (Control : in out Reference_Control_Type);
-      pragma Inline (Finalize);
-
-      procedure Zero_Counts (T_Counts : out Tamper_Counts);
-      pragma Inline (Zero_Counts);
-      --  Set Busy and Lock to zero
-
-      procedure Busy (T_Counts : in out Tamper_Counts);
-      pragma Inline (Busy);
-      --  Prohibit tampering with cursors
-
-      procedure Unbusy (T_Counts : in out Tamper_Counts);
-      pragma Inline (Unbusy);
-      --  Allow tampering with cursors
-
-      procedure Lock (T_Counts : in out Tamper_Counts);
-      pragma Inline (Lock);
-      --  Prohibit tampering with elements
-
-      procedure Unlock (T_Counts : in out Tamper_Counts);
-      pragma Inline (Unlock);
-      --  Allow tampering with elements
-
-      procedure TC_Check (T_Counts : Tamper_Counts);
-      pragma Inline (TC_Check);
-      --  Tampering-with-cursors check
-
-      procedure TE_Check (T_Counts : Tamper_Counts);
-      pragma Inline (TE_Check);
-      --  Tampering-with-elements check
-
-      -----------------
-      --  RAII Types --
-      -----------------
-
-      --  Initialize of With_Busy increments the Busy count, and Finalize
-      --  decrements it. Thus, to prohibit tampering with elements within a
-      --  given scope, declare an object of type With_Busy. The Busy count
-      --  will be correctly decremented in case of exception or abort.
-
-      --  With_Lock is the same as With_Busy, except it increments/decrements
-      --  BOTH Busy and Lock, thus prohibiting tampering with cursors.
-
-      type With_Busy (T_Counts : not null access Tamper_Counts) is
-        new Finalization.Limited_Controlled with null record
-          with Disable_Controlled => not T_Check;
-      overriding procedure Initialize (Busy : in out With_Busy);
-      overriding procedure Finalize (Busy : in out With_Busy);
-
-      type With_Lock (T_Counts : not null access Tamper_Counts) is
-        new Finalization.Limited_Controlled with null record
-          with Disable_Controlled => not T_Check;
-      overriding procedure Initialize (Lock : in out With_Lock);
-      overriding procedure Finalize (Lock : in out With_Lock);
-
-      --  Variables of type With_Busy and With_Lock are declared only for the
-      --  effects of Initialize and Finalize, so they are not referenced;
-      --  disable warnings about that. Note that all variables of these types
-      --  have names starting with "Busy" or "Lock". These pragmas need to be
-      --  present wherever these types are used.
-
-      pragma Warnings (Off, "variable ""Busy*"" is not referenced");
-      pragma Warnings (Off, "variable ""Lock*"" is not referenced");
-
-   end Generic_Implementation;
-
 end Ada.Containers;
index f19af2e0311f7f7899d6eb5faf7a5fb26be25e6c..bf5232908878dde630b58f075bfd21004644f116 100644 (file)
@@ -33,6 +33,7 @@
 
 with Ada.Iterator_Interfaces;
 
+private with Ada.Containers.Helpers;
 private with Ada.Finalization;
 private with Ada.Streams;
 
@@ -366,6 +367,7 @@ private
    pragma Inline (Next);
    pragma Inline (Previous);
 
+   use Ada.Containers.Helpers;
    package Implementation is new Generic_Implementation;
    use Implementation;
 
index d546a48e7ee3667a4cd7167c8c9eb6c673b4c9d0..ba0daa9f3ac09e80686536c23380892346130caa 100644 (file)
@@ -4676,12 +4676,41 @@ package body Sem_Ch12 is
      (N    : Node_Id;
       Subp : Entity_Id) return Boolean
    is
+
+      function Is_Inlined_Or_Child_Of_Inlined (E : Entity_Id) return Boolean;
+      --  Return True if E is an inlined subprogram, an inlined renaming or a
+      --  subprogram nested in an inlined subprogram. The inlining machinery
+      --  totally disregards nested subprograms since it considers that they
+      --  will always be compiled if the parent is (see Inline.Is_Nested).
+
+      ------------------------------------
+      -- Is_Inlined_Or_Child_Of_Inlined --
+      ------------------------------------
+
+      function Is_Inlined_Or_Child_Of_Inlined (E : Entity_Id) return Boolean is
+         Scop : Entity_Id;
+
+      begin
+         if Is_Inlined (E) or else Is_Inlined (Alias (E)) then
+            return True;
+         end if;
+
+         Scop := Scope (E);
+         while Scop /= Standard_Standard loop
+            if Ekind (Scop) in Subprogram_Kind and then Is_Inlined (Scop) then
+               return True;
+            end if;
+
+            Scop := Scope (Scop);
+         end loop;
+
+         return False;
+      end Is_Inlined_Or_Child_Of_Inlined;
+
    begin
-      --  Must be inlined (or inlined renaming)
+      --  Must be in the main unit or inlined (or child of inlined)
 
-      if (Is_In_Main_Unit (N)
-           or else Is_Inlined (Subp)
-           or else Is_Inlined (Alias (Subp)))
+      if (Is_In_Main_Unit (N) or else Is_Inlined_Or_Child_Of_Inlined (Subp))
 
         --  Must be generating code or analyzing code in ASIS/GNATprove mode
 
index 0c3ff289ef67333bb98dff1bdf2054c214b917f7..9ba25d5e0de16ca44e8cd158a658abde180ede21 100644 (file)
@@ -12458,7 +12458,7 @@ package body Sem_Ch13 is
             end case;
          end if;
 
-         Next (ASN);
+         ASN := Next_Rep_Item (ASN);
       end loop;
    end Resolve_Aspect_Expressions;
 
index 56c9bd7003075c6b825df3cc0e03c761c3352305..dabacf576df7e43b68a803cd4e349af33d3aed15 100644 (file)
@@ -9264,7 +9264,7 @@ package body Sem_Prag is
       --------------------------
 
       --  The Rational profile includes Implicit_Packing, Use_Vads_Size, and
-      --  and extension to the semantics of renaming declarations.
+      --  extension to the semantics of renaming declarations.
 
       procedure Set_Rational_Profile is
       begin
index 06833fd9957a77f3111b3d272c3eb77821499761..64f019bde32a7969a684718f1a35c8872c00543a 100644 (file)
@@ -2711,6 +2711,17 @@ package body Sem_Type is
          then
             Error_Msg_NE ("(Ada 2005) does not implement interface }",
                           L, Etype (Class_Wide_Type (Etype (R))));
+
+         --  Specialize message if one operand is a limited view, a priori
+         --  unrelated to all other types.
+
+         elsif From_Limited_With (Etype (R)) then
+            Error_Msg_NE ("limited view of& not compatible with context",
+                           R, Etype (R));
+
+         elsif From_Limited_With (Etype (L)) then
+            Error_Msg_NE ("limited view of& not compatible with context",
+                           L, Etype (L));
          else
             Error_Msg_N ("incompatible types", Parent (L));
          end if;