+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.
a-colire$(objext) \
a-comlin$(objext) \
a-comutr$(objext) \
+ a-conhel$(objext) \
a-contai$(objext) \
a-convec$(objext) \
a-coorma$(objext) \
with Ada.Iterator_Interfaces;
+private with Ada.Containers.Helpers;
private with Ada.Finalization;
private with Ada.Streams;
pragma Inline (Next);
pragma Inline (Previous);
+ use Ada.Containers.Helpers;
package Implementation is new Generic_Implementation;
use Implementation;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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;
-- 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;
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;
with Ada.Iterator_Interfaces;
+private with Ada.Containers.Helpers;
private with Ada.Finalization;
private with Ada.Streams;
pragma Inline (Next);
pragma Inline (Previous);
+ use Ada.Containers.Helpers;
package Implementation is new Generic_Implementation;
use Implementation;
(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
end case;
end if;
- Next (ASN);
+ ASN := Next_Rep_Item (ASN);
end loop;
end Resolve_Aspect_Expressions;
--------------------------
-- 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
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;