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>
-- --
-- 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 --
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;
function Peak_Use return Count_Type;
private
-
List : Implementation.List_Type (Capacity);
end Queue;
-- --
-- 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 --
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;
-- --
-- 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 --
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;
-- --
-- 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 --
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;
-- --
-- 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- --
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.
-- --
-- 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- --
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.
-- 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- --
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;
-- --
-- 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- --
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.
-- --
-- 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- --
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.
-- --
-- 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- --
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.
-- --
-- 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- --
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.
-- --
-- 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- --
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.
-- --
-- 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- --
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.
-- --
-- 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- --
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.
-- --
-- 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- --
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.
-- --
-- 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- --
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;
-- --
-- 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- --
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
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;
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);
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);
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);
Create_Unconstrained_Base_Type
(Standard_Long_Long_Integer, E_Signed_Integer_Subtype);
+ Set_Is_Implementation_Defined (Standard_Short_Short_Integer);
Create_Float_Types;
-- Has_Implicit_Dereference Flag251
-- Is_Processed_Transient Flag252
-- Has_Anonymous_Master Flag253
-
- -- (unused) Flag254
+ -- Is_Implementation_Defined Flag254
-----------------------
-- Local subprograms --
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);
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);
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));
-- 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.
-- 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)
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;
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);
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);
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);
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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;
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;
-- --
-- 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 --
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;
Pragma_Finalize_Storage_Only |
Pragma_Float_Representation |
Pragma_Ident |
+ Pragma_Implementation_Defined |
Pragma_Implemented |
Pragma_Implicit_Packing |
Pragma_Import |
-- --
-- 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- --
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
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
-- 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
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
if Is_Compilation_Unit (Ent) then
declare
Decl : constant Node_Id := Unit_Declaration_Node (Ent);
+
begin
-- Case of pragma placed immediately after spec
-- 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))
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 --
-----------------
-- 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;
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;
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;
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,
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
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
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 + $;
Pragma_External,
Pragma_Finalize_Storage_Only,
Pragma_Ident,
+ Pragma_Implementation_Defined,
Pragma_Implemented,
Pragma_Import,
Pragma_Import_Exception,
OSDN Git Service
