diff options
30 files changed, 290 insertions, 53 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index db97339dda2..270e0bfec64 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,29 @@ 2011-09-06 Robert Dewar <dewar@adacore.com> + * a-cbprqu.ads, a-cbsyqu.ads, a-cuprqu.ads, a-cusyqu.ads, + a-intnam-aix.ads, a-intnam-darwin.ads, a-intnam-dummy.ads, + a-intnam-freebsd.ads, a-intnam-hpux.ads, a-intnam-irix.ads, + a-intnam-linux.ads, a-intnam-lynxos.ads, a-intnam-mingw.ads, + a-intnam-solaris.ads, a-intnam-tru64.ads, + a-intnam-vms.ads, a-intnam-vxworks.ads, a-intnam.ads, interfac.ads, + cstand.adb, s-maccod.ads: Mark all entities as Implementation_Defined + * einfo.ads, einfo.adb (Is_Implementation_Defined): New flag + * par-prag.adb: Add dummy entry for pragma Implementation_Defined + * s-rident.ads: Add new restriction No_Implementation_Identifiers + Add new profile No_Implementation_Extensions + * sem_prag.adb: Implement pragma Implementation_Defined Implement + profile No_Implementation_Extensions + * sem_util.adb: Minor reformatting (Set_Entity_With_Style_Check): + Check violation of restriction No_Implementation_Identifiers + * snames.ads-tmpl: Add entries for pragma Implementation_Defined + Add entry for Name_No_Implementation_Extensions + +2011-09-06 Robert Dewar <dewar@adacore.com> + + * impunit.ads: Minor reformatting. + +2011-09-06 Robert Dewar <dewar@adacore.com> + * ali.adb, sem_ch13.adb, lib-xref.adb: Minor reformatting. 2011-09-06 Pascal Obry <obry@adacore.com> diff --git a/gcc/ada/a-cbprqu.ads b/gcc/ada/a-cbprqu.ads index 9caef3482c2..589ee313894 100644 --- a/gcc/ada/a-cbprqu.ads +++ b/gcc/ada/a-cbprqu.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 2011, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -54,6 +54,10 @@ generic package Ada.Containers.Bounded_Priority_Queues is pragma Preelaborate; + -- All identifiers in this unit are implementation defined + + pragma Implementation_Defined; + package Implementation is type List_Type (Capacity : Count_Type) is tagged limited private; @@ -111,7 +115,6 @@ package Ada.Containers.Bounded_Priority_Queues is function Peak_Use return Count_Type; private - List : Implementation.List_Type (Capacity); end Queue; diff --git a/gcc/ada/a-cbsyqu.ads b/gcc/ada/a-cbsyqu.ads index 26e86bc1801..8d25359469d 100644 --- a/gcc/ada/a-cbsyqu.ads +++ b/gcc/ada/a-cbsyqu.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 2011, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -44,6 +44,10 @@ generic package Ada.Containers.Bounded_Synchronized_Queues is pragma Preelaborate; + -- All identifiers in this unit are implementation defined + + pragma Implementation_Defined; + package Implementation is type List_Type (Capacity : Count_Type) is tagged limited private; diff --git a/gcc/ada/a-cuprqu.ads b/gcc/ada/a-cuprqu.ads index ac5b19e5373..d31c8824458 100644 --- a/gcc/ada/a-cuprqu.ads +++ b/gcc/ada/a-cuprqu.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 2011, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -52,6 +52,10 @@ generic package Ada.Containers.Unbounded_Priority_Queues is pragma Preelaborate; + -- All identifiers in this unit are implementation defined + + pragma Implementation_Defined; + package Implementation is type List_Type is tagged limited private; diff --git a/gcc/ada/a-cusyqu.ads b/gcc/ada/a-cusyqu.ads index a8a2dda160c..98337a03587 100644 --- a/gcc/ada/a-cusyqu.ads +++ b/gcc/ada/a-cusyqu.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 2011, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -44,6 +44,10 @@ generic package Ada.Containers.Unbounded_Synchronized_Queues is pragma Preelaborate; + -- All identifiers in this unit are implementation defined + + pragma Implementation_Defined; + package Implementation is type List_Type is tagged limited private; diff --git a/gcc/ada/a-intnam-aix.ads b/gcc/ada/a-intnam-aix.ads index 8597c3b8fb5..308f55f82b5 100644 --- a/gcc/ada/a-intnam-aix.ads +++ b/gcc/ada/a-intnam-aix.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2011, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -52,6 +52,10 @@ with System.OS_Interface; package Ada.Interrupts.Names is + -- All identifiers in this unit are implementation defined + + pragma Implementation_Defined; + -- Beware that the mapping of names to signals may be many-to-one. There -- may be aliases. Also, for all signal names that are not supported on -- the current system the value of the corresponding constant will be zero. diff --git a/gcc/ada/a-intnam-darwin.ads b/gcc/ada/a-intnam-darwin.ads index c2b6b100834..4610876490f 100644 --- a/gcc/ada/a-intnam-darwin.ads +++ b/gcc/ada/a-intnam-darwin.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2011, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -46,6 +46,10 @@ with System.OS_Interface; package Ada.Interrupts.Names is + -- All identifiers in this unit are implementation defined + + pragma Implementation_Defined; + -- Beware that the mapping of names to signals may be many-to-one. There -- may be aliases. Also, for all signal names that are not supported on the -- current system the value of the corresponding constant will be zero. diff --git a/gcc/ada/a-intnam-dummy.ads b/gcc/ada/a-intnam-dummy.ads index 02602b3c618..6e71411de2e 100644 --- a/gcc/ada/a-intnam-dummy.ads +++ b/gcc/ada/a-intnam-dummy.ads @@ -7,7 +7,7 @@ -- S p e c -- -- (No Tasking Version) -- -- -- --- Copyright (C) 1991-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2011, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -40,6 +40,10 @@ package Ada.Interrupts.Names is + -- All identifiers in this unit are implementation defined + + pragma Implementation_Defined; + DUMMY_INTERRUPT_1 : constant Interrupt_ID := 1; DUMMY_INTERRUPT_2 : constant Interrupt_ID := 2; diff --git a/gcc/ada/a-intnam-freebsd.ads b/gcc/ada/a-intnam-freebsd.ads index dd432acf710..7362f9f156a 100644 --- a/gcc/ada/a-intnam-freebsd.ads +++ b/gcc/ada/a-intnam-freebsd.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2011, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -35,6 +35,10 @@ with System.OS_Interface; package Ada.Interrupts.Names is + -- All identifiers in this unit are implementation defined + + pragma Implementation_Defined; + -- Beware that the mapping of names to signals may be many-to-one. There -- may be aliases. Also, for all signal names that are not supported on -- the current system the value of the corresponding constant will be zero. diff --git a/gcc/ada/a-intnam-hpux.ads b/gcc/ada/a-intnam-hpux.ads index 366a2404c30..db061a96b5c 100644 --- a/gcc/ada/a-intnam-hpux.ads +++ b/gcc/ada/a-intnam-hpux.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2011, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -47,6 +47,10 @@ with System.OS_Interface; package Ada.Interrupts.Names is + -- All identifiers in this unit are implementation defined + + pragma Implementation_Defined; + -- Beware that the mapping of names to signals may be many-to-one. There -- may be aliases. Also, for all signal names that are not supported on -- the current system the value of the corresponding constant will be zero. diff --git a/gcc/ada/a-intnam-irix.ads b/gcc/ada/a-intnam-irix.ads index 9c1cd028022..65859c091cd 100644 --- a/gcc/ada/a-intnam-irix.ads +++ b/gcc/ada/a-intnam-irix.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2011, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -53,6 +53,10 @@ with System.OS_Interface; package Ada.Interrupts.Names is + -- All identifiers in this unit are implementation defined + + pragma Implementation_Defined; + -- Beware that the mapping of names to signals may be many-to-one. There -- may be aliases. Also, for all signal names that are not supported on -- the current system the value of the corresponding constant will be zero. diff --git a/gcc/ada/a-intnam-linux.ads b/gcc/ada/a-intnam-linux.ads index 0b33efe813d..5003c20461a 100644 --- a/gcc/ada/a-intnam-linux.ads +++ b/gcc/ada/a-intnam-linux.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2011, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -52,6 +52,10 @@ with System.OS_Interface; package Ada.Interrupts.Names is + -- All identifiers in this unit are implementation defined + + pragma Implementation_Defined; + -- Beware that the mapping of names to signals may be many-to-one. There -- may be aliases. Also, for all signal names that are not supported on the -- current system the value of the corresponding constant will be zero. diff --git a/gcc/ada/a-intnam-lynxos.ads b/gcc/ada/a-intnam-lynxos.ads index 13509e53fa0..c4e714c8696 100644 --- a/gcc/ada/a-intnam-lynxos.ads +++ b/gcc/ada/a-intnam-lynxos.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2011, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -44,6 +44,10 @@ with System.OS_Interface; package Ada.Interrupts.Names is + -- All identifiers in this unit are implementation defined + + pragma Implementation_Defined; + -- Beware that the mapping of names to signals may be many-to-one. There -- may be aliases. diff --git a/gcc/ada/a-intnam-mingw.ads b/gcc/ada/a-intnam-mingw.ads index 7b790a6b191..3a2bcdc179f 100644 --- a/gcc/ada/a-intnam-mingw.ads +++ b/gcc/ada/a-intnam-mingw.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1997-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1997-2011, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -38,6 +38,10 @@ with System.OS_Interface; package Ada.Interrupts.Names is + -- All identifiers in this unit are implementation defined + + pragma Implementation_Defined; + -- Beware that the mapping of names to signals may be many-to-one. There -- may be aliases. Also, for all signal names that are not supported on the -- current system the value of the corresponding constant will be zero. diff --git a/gcc/ada/a-intnam-solaris.ads b/gcc/ada/a-intnam-solaris.ads index 88d4e2721ea..3ed974e7d4c 100644 --- a/gcc/ada/a-intnam-solaris.ads +++ b/gcc/ada/a-intnam-solaris.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2011, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -49,6 +49,10 @@ with System.OS_Interface; package Ada.Interrupts.Names is + -- All identifiers in this unit are implementation defined + + pragma Implementation_Defined; + -- Beware that the mapping of names to signals may be many-to-one. There -- may be aliases. Also, for all signal names that are not supported on the -- current system the value of the corresponding constant will be zero. diff --git a/gcc/ada/a-intnam-tru64.ads b/gcc/ada/a-intnam-tru64.ads index 281260b5de5..3ea1a4afd7c 100644 --- a/gcc/ada/a-intnam-tru64.ads +++ b/gcc/ada/a-intnam-tru64.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2011, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -44,6 +44,10 @@ with System.OS_Interface; package Ada.Interrupts.Names is + -- All identifiers in this unit are implementation defined + + pragma Implementation_Defined; + -- Beware that the mapping of names to signals may be many-to-one. There -- may be aliases. Also, for all signal names that are not supported on the -- current system the value of the corresponding constant will be zero. diff --git a/gcc/ada/a-intnam-vms.ads b/gcc/ada/a-intnam-vms.ads index f9086cce826..30f98d33466 100644 --- a/gcc/ada/a-intnam-vms.ads +++ b/gcc/ada/a-intnam-vms.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2011, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -38,6 +38,10 @@ with System.OS_Interface; package Ada.Interrupts.Names is + -- All identifiers in this unit are implementation defined + + pragma Implementation_Defined; + package OS renames System.OS_Interface; Interrupt_ID_0 : constant Interrupt_ID := OS.Interrupt_ID_0; diff --git a/gcc/ada/a-intnam-vxworks.ads b/gcc/ada/a-intnam-vxworks.ads index 7a6e364a7ad..0c043f45a07 100644 --- a/gcc/ada/a-intnam-vxworks.ads +++ b/gcc/ada/a-intnam-vxworks.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1998-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2011, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -35,6 +35,10 @@ with System.OS_Interface; package Ada.Interrupts.Names is + -- All identifiers in this unit are implementation defined + + pragma Implementation_Defined; + subtype Hardware_Interrupts is Interrupt_ID range Interrupt_ID'First .. System.OS_Interface.Max_HW_Interrupt; -- Range of values that can be used for hardware interrupts diff --git a/gcc/ada/a-intnam.ads b/gcc/ada/a-intnam.ads index e055d6aa17e..f50c46a0df0 100644 --- a/gcc/ada/a-intnam.ads +++ b/gcc/ada/a-intnam.ads @@ -23,6 +23,10 @@ package Ada.Interrupts.Names is + -- All identifiers in this unit are implementation defined + + pragma Implementation_Defined; + DUMMY_INTERRUPT_1 : constant Interrupt_ID := 1; DUMMY_INTERRUPT_2 : constant Interrupt_ID := 2; diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index 650b86e5dee..ce46e0f2809 100644 --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -442,8 +442,10 @@ package body CStand is begin -- Create type definition nodes for predefined float types - Copy_Float_Type (Standard_Short_Float, - Find_Back_End_Float_Type ("float")); + Copy_Float_Type + (Standard_Short_Float, + Find_Back_End_Float_Type ("float")); + Set_Is_Implementation_Defined (Standard_Short_Float); Copy_Float_Type (Standard_Float, Standard_Short_Float); @@ -476,6 +478,7 @@ package body CStand is LLF := Standard_Long_Float; end if; + Set_Is_Implementation_Defined (Standard_Long_Long_Float); Copy_Float_Type (Standard_Long_Long_Float, LLF); Append_Elmt (Standard_Long_Long_Float, Predefined_Float_Types); @@ -670,9 +673,11 @@ package body CStand is Build_Signed_Integer_Type (Standard_Long_Long_Integer, Standard_Long_Long_Integer_Size); + Set_Is_Implementation_Defined (Standard_Long_Long_Integer); Create_Unconstrained_Base_Type (Standard_Short_Short_Integer, E_Signed_Integer_Subtype); + Set_Is_Implementation_Defined (Standard_Short_Short_Integer); Create_Unconstrained_Base_Type (Standard_Short_Integer, E_Signed_Integer_Subtype); @@ -685,6 +690,7 @@ package body CStand is Create_Unconstrained_Base_Type (Standard_Long_Long_Integer, E_Signed_Integer_Subtype); + Set_Is_Implementation_Defined (Standard_Short_Short_Integer); Create_Float_Types; diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 87777860820..4cbd4c5cb44 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -523,8 +523,7 @@ package body Einfo is -- Has_Implicit_Dereference Flag251 -- Is_Processed_Transient Flag252 -- Has_Anonymous_Master Flag253 - - -- (unused) Flag254 + -- Is_Implementation_Defined Flag254 ----------------------- -- Local subprograms -- @@ -1880,6 +1879,11 @@ package body Einfo is return Flag7 (Id); end Is_Immediately_Visible; + function Is_Implementation_Defined (Id : E) return B is + begin + return Flag254 (Id); + end Is_Implementation_Defined; + function Is_Imported (Id : E) return B is begin return Flag24 (Id); @@ -4408,6 +4412,11 @@ package body Einfo is Set_Flag7 (Id, V); end Set_Is_Immediately_Visible; + procedure Set_Is_Implementation_Defined (Id : E; V : B := True) is + begin + Set_Flag254 (Id, V); + end Set_Is_Implementation_Defined; + procedure Set_Is_Imported (Id : E; V : B := True) is begin Set_Flag24 (Id, V); @@ -7564,6 +7573,7 @@ package body Einfo is W ("Is_Hidden", Flag57 (Id)); W ("Is_Hidden_Open_Scope", Flag171 (Id)); W ("Is_Immediately_Visible", Flag7 (Id)); + W ("Is_Implementation_Defined", Flag254 (Id)); W ("Is_Imported", Flag24 (Id)); W ("Is_Inlined", Flag11 (Id)); W ("Is_Instantiated", Flag126 (Id)); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 871a2cf3951..c366e0274b3 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2292,6 +2292,12 @@ package Einfo is -- Present in all entities. Set if entity is immediately visible, i.e. -- is defined in some currently open scope (RM 8.3(4)). +-- Is_Implementation_Defined (Flag254) +-- Present in all entities. Set if a pragma Implementation_Defined is +-- applied to the pragma. Used to mark all implementation defined +-- identifiers in standard library packages, and to implement the +-- restriction No_Implementation_Identifiers. + -- Is_Imported (Flag24) -- Present in all entities. Set if the entity is imported. For now we -- only allow the import of exceptions, functions, procedures, packages. @@ -4804,6 +4810,7 @@ package Einfo is -- Is_Hidden (Flag57) -- Is_Hidden_Open_Scope (Flag171) -- Is_Immediately_Visible (Flag7) + -- Is_Implementation_Defined (Flag254) -- Is_Imported (Flag24) -- Is_Inlined (Flag11) -- Is_Internal (Flag17) @@ -6226,6 +6233,7 @@ package Einfo is function Is_Hidden (Id : E) return B; function Is_Hidden_Open_Scope (Id : E) return B; function Is_Immediately_Visible (Id : E) return B; + function Is_Implementation_Defined (Id : E) return B; function Is_Imported (Id : E) return B; function Is_Inlined (Id : E) return B; function Is_Interface (Id : E) return B; @@ -6820,6 +6828,7 @@ package Einfo is procedure Set_Is_Hidden (Id : E; V : B := True); procedure Set_Is_Hidden_Open_Scope (Id : E; V : B := True); procedure Set_Is_Immediately_Visible (Id : E; V : B := True); + procedure Set_Is_Implementation_Defined (Id : E; V : B := True); procedure Set_Is_Imported (Id : E; V : B := True); procedure Set_Is_Inlined (Id : E; V : B := True); procedure Set_Is_Interface (Id : E; V : B := True); @@ -7545,6 +7554,7 @@ package Einfo is pragma Inline (Is_Hidden); pragma Inline (Is_Hidden_Open_Scope); pragma Inline (Is_Immediately_Visible); + pragma Inline (Is_Implementation_Defined); pragma Inline (Is_Imported); pragma Inline (Is_Incomplete_Or_Private_Type); pragma Inline (Is_Incomplete_Type); @@ -7967,6 +7977,7 @@ package Einfo is pragma Inline (Set_Is_Hidden); pragma Inline (Set_Is_Hidden_Open_Scope); pragma Inline (Set_Is_Immediately_Visible); + pragma Inline (Set_Is_Implementation_Defined); pragma Inline (Set_Is_Imported); pragma Inline (Set_Is_Inlined); pragma Inline (Set_Is_Interface); diff --git a/gcc/ada/impunit.ads b/gcc/ada/impunit.ads index 621a034011f..5cce6435290 100644 --- a/gcc/ada/impunit.ads +++ b/gcc/ada/impunit.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2011, 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- -- @@ -23,10 +23,10 @@ -- -- ------------------------------------------------------------------------------ --- This package contains data and functions used to determine if a given --- unit is an internal unit intended only for use by the implementation --- and which should not be directly WITH'ed by user code. It also checks --- for Ada 05 units that should only be WITH'ed in Ada 05 mode. +-- This package contains data and functions used to determine if a given unit +-- is an internal unit intended only for use by the implementation and which +-- should not be directly WITH'ed by user code. It also checks for Ada 05 +-- units that should only be WITH'ed in Ada 05 mode. with Types; use Types; @@ -34,42 +34,42 @@ package Impunit is type Kind_Of_Unit is (Implementation_Unit, - -- Unit from predefined library intended to be used only by the - -- compiler generated code, or from the implementation of the run time. - -- Use of such a unit generates a warning unless the client is compiled - -- with the -gnatg switch. If we are being super strict, this should be - -- an error for the case of Ada units, but that seems over strenuous. + -- Unit from predefined library intended to be used only by the compiler + -- generated code, or from the implementation of the run time. Use of + -- such a unit generates a warning unless the client is compiled with + -- the -gnatg switch. If we are being super strict, this should be an + -- error for the case of Ada units, but that seems over strenuous. Not_Predefined_Unit, -- This is not a predefined unit, so no checks are needed Ada_95_Unit, - -- This unit is defined in the Ada 95 RM, and can be freely with'ed - -- in both Ada 95 mode and Ada 05 mode. Note that in Ada 83 mode, no - -- child units are allowed, so you can't even name such a unit. + -- This unit is defined in the Ada 95 RM, and can be freely with'ed in + -- both Ada 95 mode and Ada 05 mode. Note that in Ada 83 mode, no child + -- units are allowed, so you can't even name such a unit. Ada_2005_Unit, - -- This unit is defined in the Ada 2005 RM. Withing this unit from a + -- This unit is defined in the Ada 2005 RM. Withing this unit from an -- Ada 95 mode program will generate a warning (again, strictly speaking -- this should be an error, but that seems over-strenuous). Ada_2012_Unit); - -- This unit is defined in the Ada 2012 RM. Withing this unit from a Ada - -- 95 mode or Ada 2005 program will generate a warning (again, strictly + -- This unit is defined in the Ada 2012 RM. Withing this unit from an + -- Ada 95 or 2005 mode program will generate a warning (again, strictly -- speaking this should be an error, but that seems over-strenuous). function Get_Kind_Of_Unit (U : Unit_Number_Type) return Kind_Of_Unit; -- Given the unit number of a unit, this function determines the type -- of the unit, as defined above. If the result is Implementation_Unit, -- then the name of a possible atlernative equivalent unit is placed in - -- Error_Msg_String/Slen on return. If there is no alternative name, or - -- if the result is not Implementation_Unit, then Error_Msg_Slen is zero - -- on return, indicating that no alternative name was found. + -- Error_Msg_String/Slen on return. If there is no alternative name, or if + -- the result is not Implementation_Unit, then Error_Msg_Slen is zero on + -- return, indicating that no alternative name was found. function Is_Known_Unit (Nam : Node_Id) return Boolean; -- Nam is the possible name of a child unit, represented as a selected - -- component node. This function determines whether the name matches - -- one of the known library units, and if so, returns True. If the name - -- does not match any known library unit, False is returned. + -- component node. This function determines whether the name matches one of + -- the known library units, and if so, returns True. If the name does not + -- match any known library unit, False is returned. end Impunit; diff --git a/gcc/ada/interfac.ads b/gcc/ada/interfac.ads index d36b48f742c..810366d5763 100644 --- a/gcc/ada/interfac.ads +++ b/gcc/ada/interfac.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2002-2011, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -36,6 +36,10 @@ package Interfaces is pragma Pure; + -- All identifiers in this unit are implementation defined + + pragma Implementation_Defined; + type Integer_8 is range -2 ** 7 .. 2 ** 7 - 1; for Integer_8'Size use 8; diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 5ab9f94a4a8..5ed6553546f 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -1149,6 +1149,7 @@ begin Pragma_Finalize_Storage_Only | Pragma_Float_Representation | Pragma_Ident | + Pragma_Implementation_Defined | Pragma_Implemented | Pragma_Implicit_Packing | Pragma_Import | diff --git a/gcc/ada/s-maccod.ads b/gcc/ada/s-maccod.ads index c1bfbf1b81f..a95e319cb98 100644 --- a/gcc/ada/s-maccod.ads +++ b/gcc/ada/s-maccod.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, 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- -- @@ -36,6 +36,10 @@ package System.Machine_Code is pragma Pure; + -- All identifiers in this unit are implementation defined + + pragma Implementation_Defined; + type Asm_Input_Operand is private; type Asm_Output_Operand is private; -- These types are never used directly, they are declared only so that diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads index 6923b596996..df68e303ff8 100644 --- a/gcc/ada/s-rident.ads +++ b/gcc/ada/s-rident.ads @@ -126,6 +126,7 @@ package System.Rident is Immediate_Reclamation, -- (RM H.4(10)) No_Implementation_Attributes, -- Ada 2005 AI-257 + No_Implementation_Identifiers, -- Ada 2012 AI-246 No_Implementation_Pragmas, -- Ada 2005 AI-257 No_Implementation_Restrictions, -- GNAT No_Implicit_Aliasing, -- GNAT @@ -310,12 +311,21 @@ package System.Rident is -- Profile Definitions and Data -- ---------------------------------- - type Profile_Name is (No_Profile, Ravenscar, Restricted); + -- Note: to add a profile, modify the following declarations appropriately, + -- add Name_xxx to Snames, and add a branch to the conditions for pragmas + -- Profile and Profile_Warnings in the body of Sem_Prag. + + type Profile_Name is + (No_Profile, + No_Implementation_Extensions, + Ravenscar, + Restricted); -- Names of recognized profiles. No_Profile is used to indicate that a -- restriction came from pragma Restrictions[_Warning], as opposed to -- pragma Profile[_Warning]. - subtype Profile_Name_Actual is Profile_Name range Ravenscar .. Restricted; + subtype Profile_Name_Actual is Profile_Name + range No_Implementation_Extensions .. Restricted; -- Actual used profile names type Profile_Data is record @@ -334,9 +344,24 @@ package System.Rident is Profile_Info : constant array (Profile_Name_Actual) of Profile_Data := + (No_Implementation_Extensions => + -- Restrictions for Restricted profile + + (Set => + (No_Implementation_Attributes => True, + No_Implementation_Identifiers => True, + No_Implementation_Pragmas => True, + No_Implementation_Restrictions => True, + others => False), + + -- Value settings for Restricted profile (none + + Value => + (others => 0)), + -- Restricted Profile - (Restricted => + Restricted => -- Restrictions for Restricted profile diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 19818bd9e8a..0c204cd29cb 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -1052,6 +1052,7 @@ package body Sem_Prag is if Is_Compilation_Unit (Ent) then declare Decl : constant Node_Id := Unit_Declaration_Node (Ent); + begin -- Case of pragma placed immediately after spec @@ -4885,7 +4886,8 @@ package body Sem_Prag is -- For the pragma case, climb homonym chain. This is -- what implements allowing the pragma in the renaming - -- case, with the result applying to the ancestors. + -- case, with the result applying to the ancestors, and + -- also allows Inline to apply to all previous homonyms. if not From_Aspect_Specification (N) then while Present (Homonym (Subp)) @@ -9120,6 +9122,42 @@ package body Sem_Prag is end; end Ident; + ---------------------------- + -- Implementation_Defined -- + ---------------------------- + + -- pragma Implementation_Defined (local_NAME); + + -- Marks previously declared entity as implementation defined. For + -- an overloaded entity, applies to the most recent homonym. + + -- pragma Implementation_Defined; + + -- The form with no arguments appears anywhere within a scope, most + -- typically a package spec, and indicates that all entities that are + -- defined within the package spec are Implementation_Defined. + + when Pragma_Implementation_Defined => Implementation_Defined : declare + Ent : Entity_Id; + + begin + Check_No_Identifiers; + + -- Form with no arguments + + if Arg_Count = 0 then + Set_Is_Implementation_Defined (Current_Scope); + + -- Form with one argument + + else + Check_Arg_Count (1); + Check_Arg_Is_Local_Name (Arg1); + Ent := Entity (Get_Pragma_Arg (Arg1)); + Set_Is_Implementation_Defined (Ent); + end if; + end Implementation_Defined; + ----------------- -- Implemented -- ----------------- @@ -10092,8 +10130,8 @@ package body Sem_Prag is -- private part of a package spec and apply to a completion. elsif Ekind_In (Typ, E_Private_Type, - E_Record_Type_With_Private, - E_Limited_Private_Type) + E_Record_Type_With_Private, + E_Limited_Private_Type) then null; @@ -12160,12 +12198,21 @@ package body Sem_Prag is declare Argx : constant Node_Id := Get_Pragma_Arg (Arg1); + begin if Chars (Argx) = Name_Ravenscar then Set_Ravenscar_Profile (N); + elsif Chars (Argx) = Name_Restricted then Set_Profile_Restrictions - (Restricted, N, Warn => Treat_Restrictions_As_Warnings); + (Restricted, + N, Warn => Treat_Restrictions_As_Warnings); + + elsif Chars (Argx) = Name_No_Implementation_Extensions then + Set_Profile_Restrictions + (No_Implementation_Extensions, + N, Warn => Treat_Restrictions_As_Warnings); + else Error_Pragma_Arg ("& is not a valid profile", Argx); end if; @@ -12187,11 +12234,18 @@ package body Sem_Prag is declare Argx : constant Node_Id := Get_Pragma_Arg (Arg1); + begin if Chars (Argx) = Name_Ravenscar then Set_Profile_Restrictions (Ravenscar, N, Warn => True); + elsif Chars (Argx) = Name_Restricted then Set_Profile_Restrictions (Restricted, N, Warn => True); + + elsif Chars (Argx) = Name_No_Implementation_Extensions then + Set_Profile_Restrictions + (No_Implementation_Extensions, N, Warn => True); + else Error_Pragma_Arg ("& is not a valid profile", Argx); end if; @@ -14648,6 +14702,7 @@ package body Sem_Prag is Pragma_Finalize_Storage_Only => 0, Pragma_Float_Representation => 0, Pragma_Ident => -1, + Pragma_Implementation_Defined => -1, Pragma_Implemented => -1, Pragma_Implicit_Packing => 0, Pragma_Import => +2, diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index f92eb064996..8bbffd93997 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -12139,8 +12139,31 @@ package body Sem_Util is Nod : Node_Id; begin + -- Unconditionally set the entity + Set_Entity (N, Val); + -- Check for No_Implementation_Identifiers + + if Restriction_Check_Required (No_Implementation_Identifiers) then + + -- We have an implementation defined entity if it is marked as + -- implementation defined, or is defined in a package marked as + -- implementation defined. However, library packages themselves + -- are excluded (we don't want to flag Interfaces itself, just + -- the entities within it). + + if (Is_Implementation_Defined (Val) + and then not (Ekind_In (Val, E_Package, E_Generic_Package) + and then Is_Library_Level_Entity (Val))) + or else Is_Implementation_Defined (Scope (Val)) + then + Check_Restriction (No_Implementation_Identifiers, N); + end if; + end if; + + -- Do the style check + if Style_Check and then not Suppress_Style_Checks (Val) and then not In_Instance diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 3fa0166b66d..fea05ef415b 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -459,6 +459,7 @@ package Snames is Name_External : constant Name_Id := N + $; -- GNAT Name_Finalize_Storage_Only : constant Name_Id := N + $; -- GNAT Name_Ident : constant Name_Id := N + $; -- VMS + Name_Implementation_Defined : constant Name_Id := N + $; -- GNAT Name_Implemented : constant Name_Id := N + $; -- Ada 12 Name_Import : constant Name_Id := N + $; Name_Import_Exception : constant Name_Id := N + $; -- VMS @@ -659,6 +660,7 @@ package Snames is Name_No_Dependence : constant Name_Id := N + $; Name_No_Dynamic_Attachment : constant Name_Id := N + $; Name_No_Dynamic_Interrupts : constant Name_Id := N + $; + Name_No_Implementation_Extensions : constant Name_Id := N + $; Name_No_Requeue : constant Name_Id := N + $; Name_No_Requeue_Statements : constant Name_Id := N + $; Name_No_Task_Attributes : constant Name_Id := N + $; @@ -1612,6 +1614,7 @@ package Snames is Pragma_External, Pragma_Finalize_Storage_Only, Pragma_Ident, + Pragma_Implementation_Defined, Pragma_Implemented, Pragma_Import, Pragma_Import_Exception, |
