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>
* 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>
......
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;
......
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;
......
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;
......
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;
......
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.
......
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.
......
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;
......
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.
......
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.
......
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.
......
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.
......
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.
......
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.
......
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.
......
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.
......
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;
......
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
......
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;
......
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;
......
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));
......
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);
......
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;
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;
......
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 |
......
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
......
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
......
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,
......
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
......
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,
......
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