[multiple changes]
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
This commit is contained in:
parent
6fa8f71cf8
commit
b7737d1d37
|
@ -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.
|
||||
|
|
|
@ -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) \
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -2,11 +2,11 @@
|
|||
-- --
|
||||
-- GNAT LIBRARY COMPONENTS --
|
||||
-- --
|
||||
-- A D A . C O N T A I N E R S --
|
||||
-- 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. --
|
||||
-- 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- --
|
||||
|
@ -25,7 +25,7 @@
|
|||
-- <http://www.gnu.org/licenses/>. --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
package body Ada.Containers is
|
||||
package body Ada.Containers.Helpers is
|
||||
|
||||
package body Generic_Implementation is
|
||||
|
||||
|
@ -183,4 +183,4 @@ package body Ada.Containers is
|
|||
|
||||
end Generic_Implementation;
|
||||
|
||||
end Ada.Containers;
|
||||
end Ada.Containers.Helpers;
|
|
@ -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;
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -4676,12 +4676,41 @@ package body Sem_Ch12 is
|
|||
(N : Node_Id;
|
||||
Subp : Entity_Id) return Boolean
|
||||
is
|
||||
begin
|
||||
-- Must be inlined (or inlined renaming)
|
||||
|
||||
if (Is_In_Main_Unit (N)
|
||||
or else Is_Inlined (Subp)
|
||||
or else Is_Inlined (Alias (Subp)))
|
||||
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 in the main unit or inlined (or child of inlined)
|
||||
|
||||
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
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
|
Loading…
Reference in New Issue