From b7737d1d375636232744501175edef1ae3ff5e7d Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 20 Oct 2015 12:20:37 +0200 Subject: [PATCH] [multiple changes] 2015-10-20 Bob Duff * 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 * 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 * sem_ch12.adb (Need_Subprogram_Instance_Body): Also return true for a subprogram nested in an inlined subprogram. From-SVN: r229040 --- gcc/ada/ChangeLog | 22 ++++ gcc/ada/Makefile.rtl | 1 + gcc/ada/a-coinve.ads | 2 + gcc/ada/{a-contai.adb => a-conhel.adb} | 8 +- gcc/ada/a-conhel.ads | 160 +++++++++++++++++++++++++ gcc/ada/a-contai.ads | 128 -------------------- gcc/ada/a-convec.ads | 2 + gcc/ada/sem_ch12.adb | 37 +++++- gcc/ada/sem_ch13.adb | 2 +- gcc/ada/sem_prag.adb | 2 +- gcc/ada/sem_type.adb | 11 ++ 11 files changed, 237 insertions(+), 138 deletions(-) rename gcc/ada/{a-contai.adb => a-conhel.adb} (96%) create mode 100644 gcc/ada/a-conhel.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a7a11174cb9..773b6a128f0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2015-10-20 Bob Duff + + * 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 + + * 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 + + * sem_ch12.adb (Need_Subprogram_Instance_Body): Also return true + for a subprogram nested in an inlined subprogram. + 2015-10-20 Bob Duff * a-coinve.adb, a-contai.adb: Update comments. diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 5b71295dfa5..68d8dc708cd 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -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) \ diff --git a/gcc/ada/a-coinve.ads b/gcc/ada/a-coinve.ads index 978b49a455a..5cb97d53ddb 100644 --- a/gcc/ada/a-coinve.ads +++ b/gcc/ada/a-coinve.ads @@ -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-contai.adb b/gcc/ada/a-conhel.adb similarity index 96% rename from gcc/ada/a-contai.adb rename to gcc/ada/a-conhel.adb index dc7c4bee96f..11fe035022a 100644 --- a/gcc/ada/a-contai.adb +++ b/gcc/ada/a-conhel.adb @@ -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 @@ -- . -- ------------------------------------------------------------------------------ -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; diff --git a/gcc/ada/a-conhel.ads b/gcc/ada/a-conhel.ads new file mode 100644 index 00000000000..e48c03bdd34 --- /dev/null +++ b/gcc/ada/a-conhel.ads @@ -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 -- +-- . -- +------------------------------------------------------------------------------ + +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.ads b/gcc/ada/a-contai.ads index 4b0b7953141..5ae53ff875d 100644 --- a/gcc/ada/a-contai.ads +++ b/gcc/ada/a-contai.ads @@ -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; diff --git a/gcc/ada/a-convec.ads b/gcc/ada/a-convec.ads index f19af2e0311..bf523290887 100644 --- a/gcc/ada/a-convec.ads +++ b/gcc/ada/a-convec.ads @@ -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; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index d546a48e7ee..ba0daa9f3ac 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -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 diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 0c3ff289ef6..9ba25d5e0de 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 56c9bd70030..dabacf576df 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -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 diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 06833fd9957..64f019bde32 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -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; -- 2.30.2