Skip to content

R
riscv-gcc-1
Commit df177175 by Robert Dewar Committed by Arnaud Charlet
Options

a-cbprqu.ads, [...]: Mark all entities as Implementation_Defined 

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.

From-SVN: r178579
parent b991dd43
Showing with 290 additions and 53 deletions
gcc/ada/ChangeLog
2011-09-06 Robert Dewar <dewar@adacore.com> 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. * ali.adb, sem_ch13.adb, lib-xref.adb: Minor reformatting.
2011-09-06 Pascal Obry <obry@adacore.com> 2011-09-06 Pascal Obry <obry@adacore.com>
......
gcc/ada/a-cbprqu.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -54,6 +54,10 @@ generic ...@@ -54,6 +54,10 @@ generic
package Ada.Containers.Bounded_Priority_Queues is package Ada.Containers.Bounded_Priority_Queues is
pragma Preelaborate; pragma Preelaborate;
-- All identifiers in this unit are implementation defined
pragma Implementation_Defined;
package Implementation is package Implementation is
type List_Type (Capacity : Count_Type) is tagged limited private; type List_Type (Capacity : Count_Type) is tagged limited private;
...@@ -111,7 +115,6 @@ package Ada.Containers.Bounded_Priority_Queues is ...@@ -111,7 +115,6 @@ package Ada.Containers.Bounded_Priority_Queues is
function Peak_Use return Count_Type; function Peak_Use return Count_Type;
private private
List : Implementation.List_Type (Capacity); List : Implementation.List_Type (Capacity);
end Queue; end Queue;
......
gcc/ada/a-cbsyqu.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -44,6 +44,10 @@ generic ...@@ -44,6 +44,10 @@ generic
package Ada.Containers.Bounded_Synchronized_Queues is package Ada.Containers.Bounded_Synchronized_Queues is
pragma Preelaborate; pragma Preelaborate;
-- All identifiers in this unit are implementation defined
pragma Implementation_Defined;
package Implementation is package Implementation is
type List_Type (Capacity : Count_Type) is tagged limited private; type List_Type (Capacity : Count_Type) is tagged limited private;
......
gcc/ada/a-cuprqu.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -52,6 +52,10 @@ generic ...@@ -52,6 +52,10 @@ generic
package Ada.Containers.Unbounded_Priority_Queues is package Ada.Containers.Unbounded_Priority_Queues is
pragma Preelaborate; pragma Preelaborate;
-- All identifiers in this unit are implementation defined
pragma Implementation_Defined;
package Implementation is package Implementation is
type List_Type is tagged limited private; type List_Type is tagged limited private;
......
gcc/ada/a-cusyqu.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -44,6 +44,10 @@ generic ...@@ -44,6 +44,10 @@ generic
package Ada.Containers.Unbounded_Synchronized_Queues is package Ada.Containers.Unbounded_Synchronized_Queues is
pragma Preelaborate; pragma Preelaborate;
-- All identifiers in this unit are implementation defined
pragma Implementation_Defined;
package Implementation is package Implementation is
type List_Type is tagged limited private; type List_Type is tagged limited private;
......
gcc/ada/a-intnam-aix.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -52,6 +52,10 @@ with System.OS_Interface; ...@@ -52,6 +52,10 @@ with System.OS_Interface;
package Ada.Interrupts.Names is 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 -- 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 -- 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. -- the current system the value of the corresponding constant will be zero.
......
gcc/ada/a-intnam-darwin.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -46,6 +46,10 @@ with System.OS_Interface; ...@@ -46,6 +46,10 @@ with System.OS_Interface;
package Ada.Interrupts.Names is 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 -- 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 -- 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. -- current system the value of the corresponding constant will be zero.
......
gcc/ada/a-intnam-dummy.ads
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- S p e c -- -- S p e c --
-- (No Tasking Version) -- -- (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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -40,6 +40,10 @@ ...@@ -40,6 +40,10 @@
package Ada.Interrupts.Names is 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_1 : constant Interrupt_ID := 1;
DUMMY_INTERRUPT_2 : constant Interrupt_ID := 2; DUMMY_INTERRUPT_2 : constant Interrupt_ID := 2;
......
gcc/ada/a-intnam-freebsd.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -35,6 +35,10 @@ with System.OS_Interface; ...@@ -35,6 +35,10 @@ with System.OS_Interface;
package Ada.Interrupts.Names is 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 -- 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 -- 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. -- the current system the value of the corresponding constant will be zero.
......
gcc/ada/a-intnam-hpux.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -47,6 +47,10 @@ with System.OS_Interface; ...@@ -47,6 +47,10 @@ with System.OS_Interface;
package Ada.Interrupts.Names is 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 -- 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 -- 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. -- the current system the value of the corresponding constant will be zero.
......
gcc/ada/a-intnam-irix.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -53,6 +53,10 @@ with System.OS_Interface; ...@@ -53,6 +53,10 @@ with System.OS_Interface;
package Ada.Interrupts.Names is 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 -- 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 -- 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. -- the current system the value of the corresponding constant will be zero.
......
gcc/ada/a-intnam-linux.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -52,6 +52,10 @@ with System.OS_Interface; ...@@ -52,6 +52,10 @@ with System.OS_Interface;
package Ada.Interrupts.Names is 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 -- 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 -- 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. -- current system the value of the corresponding constant will be zero.
......
gcc/ada/a-intnam-lynxos.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -44,6 +44,10 @@ with System.OS_Interface; ...@@ -44,6 +44,10 @@ with System.OS_Interface;
package Ada.Interrupts.Names is 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 -- Beware that the mapping of names to signals may be many-to-one. There
-- may be aliases. -- may be aliases.
......
gcc/ada/a-intnam-mingw.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -38,6 +38,10 @@ with System.OS_Interface; ...@@ -38,6 +38,10 @@ with System.OS_Interface;
package Ada.Interrupts.Names is 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 -- 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 -- 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. -- current system the value of the corresponding constant will be zero.
......
gcc/ada/a-intnam-solaris.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -49,6 +49,10 @@ with System.OS_Interface; ...@@ -49,6 +49,10 @@ with System.OS_Interface;
package Ada.Interrupts.Names is 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 -- 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 -- 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. -- current system the value of the corresponding constant will be zero.
......
gcc/ada/a-intnam-tru64.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -44,6 +44,10 @@ with System.OS_Interface; ...@@ -44,6 +44,10 @@ with System.OS_Interface;
package Ada.Interrupts.Names is 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 -- 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 -- 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. -- current system the value of the corresponding constant will be zero.
......
gcc/ada/a-intnam-vms.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -38,6 +38,10 @@ with System.OS_Interface; ...@@ -38,6 +38,10 @@ with System.OS_Interface;
package Ada.Interrupts.Names is package Ada.Interrupts.Names is
-- All identifiers in this unit are implementation defined
pragma Implementation_Defined;
package OS renames System.OS_Interface; package OS renames System.OS_Interface;
Interrupt_ID_0 : constant Interrupt_ID := OS.Interrupt_ID_0; Interrupt_ID_0 : constant Interrupt_ID := OS.Interrupt_ID_0;
......
gcc/ada/a-intnam-vxworks.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -35,6 +35,10 @@ with System.OS_Interface; ...@@ -35,6 +35,10 @@ with System.OS_Interface;
package Ada.Interrupts.Names is package Ada.Interrupts.Names is
-- All identifiers in this unit are implementation defined
pragma Implementation_Defined;
subtype Hardware_Interrupts is Interrupt_ID subtype Hardware_Interrupts is Interrupt_ID
range Interrupt_ID'First .. System.OS_Interface.Max_HW_Interrupt; range Interrupt_ID'First .. System.OS_Interface.Max_HW_Interrupt;
-- Range of values that can be used for hardware interrupts -- Range of values that can be used for hardware interrupts
......
gcc/ada/a-intnam.ads
...@@ -23,6 +23,10 @@ ...@@ -23,6 +23,10 @@
package Ada.Interrupts.Names is 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_1 : constant Interrupt_ID := 1;
DUMMY_INTERRUPT_2 : constant Interrupt_ID := 2; DUMMY_INTERRUPT_2 : constant Interrupt_ID := 2;
......
gcc/ada/cstand.adb
...@@ -442,8 +442,10 @@ package body CStand is ...@@ -442,8 +442,10 @@ package body CStand is
begin begin
-- Create type definition nodes for predefined float types -- Create type definition nodes for predefined float types
Copy_Float_Type (Standard_Short_Float, Copy_Float_Type
Find_Back_End_Float_Type ("float")); (Standard_Short_Float,
Find_Back_End_Float_Type ("float"));
Set_Is_Implementation_Defined (Standard_Short_Float);
Copy_Float_Type (Standard_Float, Standard_Short_Float); Copy_Float_Type (Standard_Float, Standard_Short_Float);
...@@ -476,6 +478,7 @@ package body CStand is ...@@ -476,6 +478,7 @@ package body CStand is
LLF := Standard_Long_Float; LLF := Standard_Long_Float;
end if; end if;
Set_Is_Implementation_Defined (Standard_Long_Long_Float);
Copy_Float_Type (Standard_Long_Long_Float, LLF); Copy_Float_Type (Standard_Long_Long_Float, LLF);
Append_Elmt (Standard_Long_Long_Float, Predefined_Float_Types); Append_Elmt (Standard_Long_Long_Float, Predefined_Float_Types);
...@@ -670,9 +673,11 @@ package body CStand is ...@@ -670,9 +673,11 @@ package body CStand is
Build_Signed_Integer_Type Build_Signed_Integer_Type
(Standard_Long_Long_Integer, Standard_Long_Long_Integer_Size); (Standard_Long_Long_Integer, Standard_Long_Long_Integer_Size);
Set_Is_Implementation_Defined (Standard_Long_Long_Integer);
Create_Unconstrained_Base_Type Create_Unconstrained_Base_Type
(Standard_Short_Short_Integer, E_Signed_Integer_Subtype); (Standard_Short_Short_Integer, E_Signed_Integer_Subtype);
Set_Is_Implementation_Defined (Standard_Short_Short_Integer);
Create_Unconstrained_Base_Type Create_Unconstrained_Base_Type
(Standard_Short_Integer, E_Signed_Integer_Subtype); (Standard_Short_Integer, E_Signed_Integer_Subtype);
...@@ -685,6 +690,7 @@ package body CStand is ...@@ -685,6 +690,7 @@ package body CStand is
Create_Unconstrained_Base_Type Create_Unconstrained_Base_Type
(Standard_Long_Long_Integer, E_Signed_Integer_Subtype); (Standard_Long_Long_Integer, E_Signed_Integer_Subtype);
Set_Is_Implementation_Defined (Standard_Short_Short_Integer);
Create_Float_Types; Create_Float_Types;
......
gcc/ada/einfo.adb
...@@ -523,8 +523,7 @@ package body Einfo is ...@@ -523,8 +523,7 @@ package body Einfo is
-- Has_Implicit_Dereference Flag251 -- Has_Implicit_Dereference Flag251
-- Is_Processed_Transient Flag252 -- Is_Processed_Transient Flag252
-- Has_Anonymous_Master Flag253 -- Has_Anonymous_Master Flag253
-- Is_Implementation_Defined Flag254
-- (unused) Flag254
----------------------- -----------------------
-- Local subprograms -- -- Local subprograms --
...@@ -1880,6 +1879,11 @@ package body Einfo is ...@@ -1880,6 +1879,11 @@ package body Einfo is
return Flag7 (Id); return Flag7 (Id);
end Is_Immediately_Visible; 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 function Is_Imported (Id : E) return B is
begin begin
return Flag24 (Id); return Flag24 (Id);
...@@ -4408,6 +4412,11 @@ package body Einfo is ...@@ -4408,6 +4412,11 @@ package body Einfo is
Set_Flag7 (Id, V); Set_Flag7 (Id, V);
end Set_Is_Immediately_Visible; 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 procedure Set_Is_Imported (Id : E; V : B := True) is
begin begin
Set_Flag24 (Id, V); Set_Flag24 (Id, V);
...@@ -7564,6 +7573,7 @@ package body Einfo is ...@@ -7564,6 +7573,7 @@ package body Einfo is
W ("Is_Hidden", Flag57 (Id)); W ("Is_Hidden", Flag57 (Id));
W ("Is_Hidden_Open_Scope", Flag171 (Id)); W ("Is_Hidden_Open_Scope", Flag171 (Id));
W ("Is_Immediately_Visible", Flag7 (Id)); W ("Is_Immediately_Visible", Flag7 (Id));
W ("Is_Implementation_Defined", Flag254 (Id));
W ("Is_Imported", Flag24 (Id)); W ("Is_Imported", Flag24 (Id));
W ("Is_Inlined", Flag11 (Id)); W ("Is_Inlined", Flag11 (Id));
W ("Is_Instantiated", Flag126 (Id)); W ("Is_Instantiated", Flag126 (Id));
......
gcc/ada/einfo.ads
...@@ -2292,6 +2292,12 @@ package Einfo is ...@@ -2292,6 +2292,12 @@ package Einfo is
-- Present in all entities. Set if entity is immediately visible, i.e. -- Present in all entities. Set if entity is immediately visible, i.e.
-- is defined in some currently open scope (RM 8.3(4)). -- 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) -- Is_Imported (Flag24)
-- Present in all entities. Set if the entity is imported. For now we -- Present in all entities. Set if the entity is imported. For now we
-- only allow the import of exceptions, functions, procedures, packages. -- only allow the import of exceptions, functions, procedures, packages.
...@@ -4804,6 +4810,7 @@ package Einfo is ...@@ -4804,6 +4810,7 @@ package Einfo is
-- Is_Hidden (Flag57) -- Is_Hidden (Flag57)
-- Is_Hidden_Open_Scope (Flag171) -- Is_Hidden_Open_Scope (Flag171)
-- Is_Immediately_Visible (Flag7) -- Is_Immediately_Visible (Flag7)
-- Is_Implementation_Defined (Flag254)
-- Is_Imported (Flag24) -- Is_Imported (Flag24)
-- Is_Inlined (Flag11) -- Is_Inlined (Flag11)
-- Is_Internal (Flag17) -- Is_Internal (Flag17)
...@@ -6226,6 +6233,7 @@ package Einfo is ...@@ -6226,6 +6233,7 @@ package Einfo is
function Is_Hidden (Id : E) return B; function Is_Hidden (Id : E) return B;
function Is_Hidden_Open_Scope (Id : E) return B; function Is_Hidden_Open_Scope (Id : E) return B;
function Is_Immediately_Visible (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_Imported (Id : E) return B;
function Is_Inlined (Id : E) return B; function Is_Inlined (Id : E) return B;
function Is_Interface (Id : E) return B; function Is_Interface (Id : E) return B;
...@@ -6820,6 +6828,7 @@ package Einfo is ...@@ -6820,6 +6828,7 @@ package Einfo is
procedure Set_Is_Hidden (Id : E; V : B := True); procedure Set_Is_Hidden (Id : E; V : B := True);
procedure Set_Is_Hidden_Open_Scope (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_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_Imported (Id : E; V : B := True);
procedure Set_Is_Inlined (Id : E; V : B := True); procedure Set_Is_Inlined (Id : E; V : B := True);
procedure Set_Is_Interface (Id : E; V : B := True); procedure Set_Is_Interface (Id : E; V : B := True);
...@@ -7545,6 +7554,7 @@ package Einfo is ...@@ -7545,6 +7554,7 @@ package Einfo is
pragma Inline (Is_Hidden); pragma Inline (Is_Hidden);
pragma Inline (Is_Hidden_Open_Scope); pragma Inline (Is_Hidden_Open_Scope);
pragma Inline (Is_Immediately_Visible); pragma Inline (Is_Immediately_Visible);
pragma Inline (Is_Implementation_Defined);
pragma Inline (Is_Imported); pragma Inline (Is_Imported);
pragma Inline (Is_Incomplete_Or_Private_Type); pragma Inline (Is_Incomplete_Or_Private_Type);
pragma Inline (Is_Incomplete_Type); pragma Inline (Is_Incomplete_Type);
...@@ -7967,6 +7977,7 @@ package Einfo is ...@@ -7967,6 +7977,7 @@ package Einfo is
pragma Inline (Set_Is_Hidden); pragma Inline (Set_Is_Hidden);
pragma Inline (Set_Is_Hidden_Open_Scope); pragma Inline (Set_Is_Hidden_Open_Scope);
pragma Inline (Set_Is_Immediately_Visible); pragma Inline (Set_Is_Immediately_Visible);
pragma Inline (Set_Is_Implementation_Defined);
pragma Inline (Set_Is_Imported); pragma Inline (Set_Is_Imported);
pragma Inline (Set_Is_Inlined); pragma Inline (Set_Is_Inlined);
pragma Inline (Set_Is_Interface); pragma Inline (Set_Is_Interface);
......
gcc/ada/impunit.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -23,10 +23,10 @@ ...@@ -23,10 +23,10 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- This package contains data and functions used to determine if a given -- This package contains data and functions used to determine if a given unit
-- unit is an internal unit intended only for use by the implementation -- is an internal unit intended only for use by the implementation and which
-- and which should not be directly WITH'ed by user code. It also checks -- should not be directly WITH'ed by user code. It also checks for Ada 05
-- for Ada 05 units that should only be WITH'ed in Ada 05 mode. -- units that should only be WITH'ed in Ada 05 mode.
with Types; use Types; with Types; use Types;
...@@ -34,42 +34,42 @@ package Impunit is ...@@ -34,42 +34,42 @@ package Impunit is
type Kind_Of_Unit is type Kind_Of_Unit is
(Implementation_Unit, (Implementation_Unit,
-- Unit from predefined library intended to be used only by the -- Unit from predefined library intended to be used only by the compiler
-- compiler generated code, or from the implementation of the run time. -- generated code, or from the implementation of the run time. Use of
-- Use of such a unit generates a warning unless the client is compiled -- such a unit generates a warning unless the client is compiled with
-- with the -gnatg switch. If we are being super strict, this should be -- the -gnatg switch. If we are being super strict, this should be an
-- an error for the case of Ada units, but that seems over strenuous. -- error for the case of Ada units, but that seems over strenuous.
Not_Predefined_Unit, Not_Predefined_Unit,
-- This is not a predefined unit, so no checks are needed -- This is not a predefined unit, so no checks are needed
Ada_95_Unit, Ada_95_Unit,
-- This unit is defined in the Ada 95 RM, and can be freely with'ed -- This unit is defined in the Ada 95 RM, and can be freely with'ed in
-- in both Ada 95 mode and Ada 05 mode. Note that in Ada 83 mode, no -- both Ada 95 mode and Ada 05 mode. Note that in Ada 83 mode, no child
-- child units are allowed, so you can't even name such a unit. -- units are allowed, so you can't even name such a unit.
Ada_2005_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 -- Ada 95 mode program will generate a warning (again, strictly speaking
-- this should be an error, but that seems over-strenuous). -- this should be an error, but that seems over-strenuous).
Ada_2012_Unit); Ada_2012_Unit);
-- This unit is defined in the Ada 2012 RM. Withing this unit from a Ada -- This unit is defined in the Ada 2012 RM. Withing this unit from an
-- 95 mode or Ada 2005 program will generate a warning (again, strictly -- Ada 95 or 2005 mode program will generate a warning (again, strictly
-- speaking this should be an error, but that seems over-strenuous). -- speaking this should be an error, but that seems over-strenuous).
function Get_Kind_Of_Unit (U : Unit_Number_Type) return Kind_Of_Unit; 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 -- Given the unit number of a unit, this function determines the type
-- of the unit, as defined above. If the result is Implementation_Unit, -- of the unit, as defined above. If the result is Implementation_Unit,
-- then the name of a possible atlernative equivalent unit is placed in -- 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 -- Error_Msg_String/Slen on return. If there is no alternative name, or if
-- if the result is not Implementation_Unit, then Error_Msg_Slen is zero -- the result is not Implementation_Unit, then Error_Msg_Slen is zero on
-- on return, indicating that no alternative name was found. -- return, indicating that no alternative name was found.
function Is_Known_Unit (Nam : Node_Id) return Boolean; function Is_Known_Unit (Nam : Node_Id) return Boolean;
-- Nam is the possible name of a child unit, represented as a selected -- Nam is the possible name of a child unit, represented as a selected
-- component node. This function determines whether the name matches -- component node. This function determines whether the name matches one of
-- one of the known library units, and if so, returns True. If the name -- the known library units, and if so, returns True. If the name does not
-- does not match any known library unit, False is returned. -- match any known library unit, False is returned.
end Impunit; end Impunit;
gcc/ada/interfac.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -36,6 +36,10 @@ ...@@ -36,6 +36,10 @@
package Interfaces is package Interfaces is
pragma Pure; pragma Pure;
-- All identifiers in this unit are implementation defined
pragma Implementation_Defined;
type Integer_8 is range -2 ** 7 .. 2 ** 7 - 1; type Integer_8 is range -2 ** 7 .. 2 ** 7 - 1;
for Integer_8'Size use 8; for Integer_8'Size use 8;
......
gcc/ada/par-prag.adb
...@@ -1149,6 +1149,7 @@ begin ...@@ -1149,6 +1149,7 @@ begin
Pragma_Finalize_Storage_Only | Pragma_Finalize_Storage_Only |
Pragma_Float_Representation | Pragma_Float_Representation |
Pragma_Ident | Pragma_Ident |
Pragma_Implementation_Defined |
Pragma_Implemented | Pragma_Implemented |
Pragma_Implicit_Packing | Pragma_Implicit_Packing |
Pragma_Import | Pragma_Import |
......
gcc/ada/s-maccod.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -36,6 +36,10 @@ ...@@ -36,6 +36,10 @@
package System.Machine_Code is package System.Machine_Code is
pragma Pure; pragma Pure;
-- All identifiers in this unit are implementation defined
pragma Implementation_Defined;
type Asm_Input_Operand is private; type Asm_Input_Operand is private;
type Asm_Output_Operand is private; type Asm_Output_Operand is private;
-- These types are never used directly, they are declared only so that -- These types are never used directly, they are declared only so that
......
gcc/ada/s-rident.ads
...@@ -126,6 +126,7 @@ package System.Rident is ...@@ -126,6 +126,7 @@ package System.Rident is
Immediate_Reclamation, -- (RM H.4(10)) Immediate_Reclamation, -- (RM H.4(10))
No_Implementation_Attributes, -- Ada 2005 AI-257 No_Implementation_Attributes, -- Ada 2005 AI-257
No_Implementation_Identifiers, -- Ada 2012 AI-246
No_Implementation_Pragmas, -- Ada 2005 AI-257 No_Implementation_Pragmas, -- Ada 2005 AI-257
No_Implementation_Restrictions, -- GNAT No_Implementation_Restrictions, -- GNAT
No_Implicit_Aliasing, -- GNAT No_Implicit_Aliasing, -- GNAT
...@@ -310,12 +311,21 @@ package System.Rident is ...@@ -310,12 +311,21 @@ package System.Rident is
-- Profile Definitions and Data -- -- 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 -- Names of recognized profiles. No_Profile is used to indicate that a
-- restriction came from pragma Restrictions[_Warning], as opposed to -- restriction came from pragma Restrictions[_Warning], as opposed to
-- pragma Profile[_Warning]. -- 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 -- Actual used profile names
type Profile_Data is record type Profile_Data is record
...@@ -334,9 +344,24 @@ package System.Rident is ...@@ -334,9 +344,24 @@ package System.Rident is
Profile_Info : constant array (Profile_Name_Actual) of Profile_Data := 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 Profile
(Restricted => Restricted =>
-- Restrictions for Restricted profile -- Restrictions for Restricted profile
......
gcc/ada/sem_prag.adb
...@@ -1052,6 +1052,7 @@ package body Sem_Prag is ...@@ -1052,6 +1052,7 @@ package body Sem_Prag is
if Is_Compilation_Unit (Ent) then if Is_Compilation_Unit (Ent) then
declare declare
Decl : constant Node_Id := Unit_Declaration_Node (Ent); Decl : constant Node_Id := Unit_Declaration_Node (Ent);
begin begin
-- Case of pragma placed immediately after spec -- Case of pragma placed immediately after spec
...@@ -4885,7 +4886,8 @@ package body Sem_Prag is ...@@ -4885,7 +4886,8 @@ package body Sem_Prag is
-- For the pragma case, climb homonym chain. This is -- For the pragma case, climb homonym chain. This is
-- what implements allowing the pragma in the renaming -- 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 if not From_Aspect_Specification (N) then
while Present (Homonym (Subp)) while Present (Homonym (Subp))
...@@ -9120,6 +9122,42 @@ package body Sem_Prag is ...@@ -9120,6 +9122,42 @@ package body Sem_Prag is
end; end;
end Ident; 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 -- -- Implemented --
----------------- -----------------
...@@ -10092,8 +10130,8 @@ package body Sem_Prag is ...@@ -10092,8 +10130,8 @@ package body Sem_Prag is
-- private part of a package spec and apply to a completion. -- private part of a package spec and apply to a completion.
elsif Ekind_In (Typ, E_Private_Type, elsif Ekind_In (Typ, E_Private_Type,
E_Record_Type_With_Private, E_Record_Type_With_Private,
E_Limited_Private_Type) E_Limited_Private_Type)
then then
null; null;
...@@ -12160,12 +12198,21 @@ package body Sem_Prag is ...@@ -12160,12 +12198,21 @@ package body Sem_Prag is
declare declare
Argx : constant Node_Id := Get_Pragma_Arg (Arg1); Argx : constant Node_Id := Get_Pragma_Arg (Arg1);
begin begin
if Chars (Argx) = Name_Ravenscar then if Chars (Argx) = Name_Ravenscar then
Set_Ravenscar_Profile (N); Set_Ravenscar_Profile (N);
elsif Chars (Argx) = Name_Restricted then elsif Chars (Argx) = Name_Restricted then
Set_Profile_Restrictions 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 else
Error_Pragma_Arg ("& is not a valid profile", Argx); Error_Pragma_Arg ("& is not a valid profile", Argx);
end if; end if;
...@@ -12187,11 +12234,18 @@ package body Sem_Prag is ...@@ -12187,11 +12234,18 @@ package body Sem_Prag is
declare declare
Argx : constant Node_Id := Get_Pragma_Arg (Arg1); Argx : constant Node_Id := Get_Pragma_Arg (Arg1);
begin begin
if Chars (Argx) = Name_Ravenscar then if Chars (Argx) = Name_Ravenscar then
Set_Profile_Restrictions (Ravenscar, N, Warn => True); Set_Profile_Restrictions (Ravenscar, N, Warn => True);
elsif Chars (Argx) = Name_Restricted then elsif Chars (Argx) = Name_Restricted then
Set_Profile_Restrictions (Restricted, N, Warn => True); 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 else
Error_Pragma_Arg ("& is not a valid profile", Argx); Error_Pragma_Arg ("& is not a valid profile", Argx);
end if; end if;
...@@ -14648,6 +14702,7 @@ package body Sem_Prag is ...@@ -14648,6 +14702,7 @@ package body Sem_Prag is
Pragma_Finalize_Storage_Only => 0, Pragma_Finalize_Storage_Only => 0,
Pragma_Float_Representation => 0, Pragma_Float_Representation => 0,
Pragma_Ident => -1, Pragma_Ident => -1,
Pragma_Implementation_Defined => -1,
Pragma_Implemented => -1, Pragma_Implemented => -1,
Pragma_Implicit_Packing => 0, Pragma_Implicit_Packing => 0,
Pragma_Import => +2, Pragma_Import => +2,
......
gcc/ada/sem_util.adb
...@@ -12139,8 +12139,31 @@ package body Sem_Util is ...@@ -12139,8 +12139,31 @@ package body Sem_Util is
Nod : Node_Id; Nod : Node_Id;
begin begin
-- Unconditionally set the entity
Set_Entity (N, Val); 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 if Style_Check
and then not Suppress_Style_Checks (Val) and then not Suppress_Style_Checks (Val)
and then not In_Instance and then not In_Instance
......
gcc/ada/snames.ads-tmpl
...@@ -459,6 +459,7 @@ package Snames is ...@@ -459,6 +459,7 @@ package Snames is
Name_External : constant Name_Id := N + $; -- GNAT Name_External : constant Name_Id := N + $; -- GNAT
Name_Finalize_Storage_Only : constant Name_Id := N + $; -- GNAT Name_Finalize_Storage_Only : constant Name_Id := N + $; -- GNAT
Name_Ident : constant Name_Id := N + $; -- VMS Name_Ident : constant Name_Id := N + $; -- VMS
Name_Implementation_Defined : constant Name_Id := N + $; -- GNAT
Name_Implemented : constant Name_Id := N + $; -- Ada 12 Name_Implemented : constant Name_Id := N + $; -- Ada 12
Name_Import : constant Name_Id := N + $; Name_Import : constant Name_Id := N + $;
Name_Import_Exception : constant Name_Id := N + $; -- VMS Name_Import_Exception : constant Name_Id := N + $; -- VMS
...@@ -659,6 +660,7 @@ package Snames is ...@@ -659,6 +660,7 @@ package Snames is
Name_No_Dependence : constant Name_Id := N + $; Name_No_Dependence : constant Name_Id := N + $;
Name_No_Dynamic_Attachment : constant Name_Id := N + $; Name_No_Dynamic_Attachment : constant Name_Id := N + $;
Name_No_Dynamic_Interrupts : 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 : constant Name_Id := N + $;
Name_No_Requeue_Statements : constant Name_Id := N + $; Name_No_Requeue_Statements : constant Name_Id := N + $;
Name_No_Task_Attributes : constant Name_Id := N + $; Name_No_Task_Attributes : constant Name_Id := N + $;
...@@ -1612,6 +1614,7 @@ package Snames is ...@@ -1612,6 +1614,7 @@ package Snames is
Pragma_External, Pragma_External,
Pragma_Finalize_Storage_Only, Pragma_Finalize_Storage_Only,
Pragma_Ident, Pragma_Ident,
Pragma_Implementation_Defined,
Pragma_Implemented, Pragma_Implemented,
Pragma_Import, Pragma_Import,
Pragma_Import_Exception, Pragma_Import_Exception,
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment