Commit 5f3ab6fb by Arnaud Charlet

s-atacco.ads, [...]: Protect use of 'Constrained by warnings on/off...

	* s-atacco.ads, a-direio.adb: Protect use of 'Constrained by warnings
	on/off, since this is an obsolescent feature, for which we now generate
	a warning.

	* sem_attr.adb (Analyze_Attribute, case Constrained): Issue warning if
	warning mode is set and obsolescent usage of this attribute occurs.
	(Resolve_Access, case 'Access): Note that GNAT uses the context type to
	disambiguate overloaded prefixes, in accordance with AI-235. GNAT code
	predates, and partly motivates, the adoption of the AI.
	Implement new Ada 2005 attribute Mod

	* exp_attr.adb (Expand_N_Attribute_Reference): Implement Ada 2005
	attribute Mod.

	* par-ch4.adb (P_Name): In Ada 2005 mode, recognize new attribute Mod

	* snames.h, snames.ads, snames.adb: Add entry for No_Dependence for
	pragma restrictions.
	New entry for Ada 2005 attribute Mod.

	* par-prag.adb:
	Add recognition of new pragma Restrictions No_Dependence
	Recognize restriction No_Obsolescent_Features at parse time

	* bcheck.adb: Add circuitry for checking for consistency of
	No_Dependence restrictions.

	* lib-writ.ads, lib-writ.adb: Output new R lines for No_Dependence
	restrictions.

	* restrict.ads, restrict.adb: Add subprograms to deal with
	No_Dependence restrictions.

	* rtsfind.adb: Check that implicit with's do not violate No_Dependence
	restrictions.

	* sem_ch3.adb, sem_ch11.adb, sem_ch13.adb, lib-xref.adb,
	sem_attr.adb: Add check for new restriction No_Obsolescent_Features

	* scn.ads, prj-err.ads, prj-err.adb, ali-util.adb, gprep.adb: Add new
	dummy parameter to scng instantiation.
	Needed for new restriction No_Obsolescent_Features

	* scn.adb: (Obsolescent_Check): New procedure
	Needed for new restriction No_Obsolescent_Features

	* scng.ads, scng.adb: Always allow wide characters in Ada 2005 mode, as
	specified by AI-285, needed for implementation of AI-388 (adding greek
	pi to Ada.Numerics).
	Add new generic formal to scng, needed for new restriction
	No_Obsolescent_Features.

	* s-rident.ads: Add new restriction No_Obsolescent_Features.

	* ali.ads, ali.adb: Adjustments for reading new No_Dependence
	restrictions lines.
	(Scan_ALI): When finding an unexpected character on an R line, raise
	exception Bad_R_Line, instead of calling Fatal_Error, so that, when
	Ignore_Errors is True, default restrictions are set and scanning of the
	ALI file continues with the next line. Also, when Bad_R_Line is raised
	and Ignore_Errors is True, skip to the end of le line.

	* sem_ch10.adb: Check that explicit with's do not violate
	No_Dependence restrictions.
	(Install_Withed_Unit): Add code to implement AI-377 and diagnose
	illegal context clauses containing child units of instance.

	* sem_prag.adb: Processing and checking for new No_Dependence
	restrictions.
	(Analyze_Pragma, case Psect_Object): Call Check_Arg_Is_External_Name to
	analyze and check the External argument.

	* a-numeri.ads: Add greek letter pi as alternative spelling of Pi

From-SVN: r92829
parent b1c1e25c
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2004 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- --
...@@ -183,9 +183,15 @@ package body Ada.Direct_IO is ...@@ -183,9 +183,15 @@ package body Ada.Direct_IO is
-- For a non-constrained variant record type, we read into an -- For a non-constrained variant record type, we read into an
-- intermediate buffer, since we may have the case of discriminated -- intermediate buffer, since we may have the case of discriminated
-- records where a discriminant check is required, and we may need -- records where a discriminant check is required, and we may need
-- to assign only part of the record buffer originally written -- to assign only part of the record buffer originally written.
-- Note: we have to turn warnings on/off because this use of
-- the Constrained attribute is an obsolescent feature.
pragma Warnings (Off);
if not Element_Type'Constrained then if not Element_Type'Constrained then
pragma Warnings (On);
declare declare
Buf : Element_Type; Buf : Element_Type;
...@@ -205,7 +211,13 @@ package body Ada.Direct_IO is ...@@ -205,7 +211,13 @@ package body Ada.Direct_IO is
begin begin
-- Same processing for unconstrained case as above -- Same processing for unconstrained case as above
-- Note: we have to turn warnings on/off because this use of
-- the Constrained attribute is an obsolescent feature.
pragma Warnings (Off);
if not Element_Type'Constrained then if not Element_Type'Constrained then
pragma Warnings (On);
declare declare
Buf : Element_Type; Buf : Element_Type;
......
...@@ -22,7 +22,12 @@ pragma Pure (Numerics); ...@@ -22,7 +22,12 @@ pragma Pure (Numerics);
Pi : constant := Pi : constant :=
3.14159_26535_89793_23846_26433_83279_50288_41971_69399_37511; 3.14159_26535_89793_23846_26433_83279_50288_41971_69399_37511;
["03C0"] : constant := Pi;
-- This is the greek letter Pi. Note that it is conforming to have this
-- present even in Ada 95 mode, because there is no way for a normal mode
-- Ada 95 program to reference this identifier in any case.
e : constant := e : constant :=
2.71828_18284_59045_23536_02874_71352_66249_77572_47093_69996; 2.71828_18284_59045_23536_02874_71352_66249_77572_47093_69996;
end Ada.Numerics; end Ada.Numerics;
...@@ -53,7 +53,9 @@ package body ALI.Util is ...@@ -53,7 +53,9 @@ package body ALI.Util is
procedure Error_Msg_SP (Msg : String); procedure Error_Msg_SP (Msg : String);
-- Instantiation of Styleg, needed to instantiate Scng procedure Obsolescent_Check (S : Source_Ptr);
-- Instantiation of Styleg, needed to instantiate Scng
package Style is new Styleg package Style is new Styleg
(Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP); (Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP);
...@@ -62,7 +64,8 @@ package body ALI.Util is ...@@ -62,7 +64,8 @@ package body ALI.Util is
-- Get_File_Checksum). -- Get_File_Checksum).
package Scanner is new Scng package Scanner is new Scng
(Post_Scan, Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP, Style); (Post_Scan, Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP,
Obsolescent_Check, Style);
type Header_Num is range 0 .. 1_000; type Header_Num is range 0 .. 1_000;
...@@ -200,6 +203,16 @@ package body ALI.Util is ...@@ -200,6 +203,16 @@ package body ALI.Util is
Interfaces.Reset; Interfaces.Reset;
end Initialize_ALI_Source; end Initialize_ALI_Source;
-----------------------
-- Obsolescent_Check --
-----------------------
procedure Obsolescent_Check (S : Source_Ptr) is
pragma Warnings (Off, S);
begin
null;
end Obsolescent_Check;
--------------- ---------------
-- Post_Scan -- -- Post_Scan --
--------------- ---------------
......
...@@ -84,6 +84,7 @@ package body ALI is ...@@ -84,6 +84,7 @@ package body ALI is
-- Initialize all tables -- Initialize all tables
ALIs.Init; ALIs.Init;
No_Deps.Init;
Units.Init; Units.Init;
Withs.Init; Withs.Init;
Sdep.Init; Sdep.Init;
...@@ -199,7 +200,7 @@ package body ALI is ...@@ -199,7 +200,7 @@ package body ALI is
-- quote. -- quote.
function Get_Nat return Nat; function Get_Nat return Nat;
-- Skip blanks, then scan out an unsigned integer value in Nat range. -- Skip blanks, then scan out an unsigned integer value in Nat range
function Get_Stamp return Time_Stamp_Type; function Get_Stamp return Time_Stamp_Type;
-- Skip blanks, then scan out a time stamp -- Skip blanks, then scan out a time stamp
...@@ -212,7 +213,7 @@ package body ALI is ...@@ -212,7 +213,7 @@ package body ALI is
-- at end of line). Also skips past any following blank lines. -- at end of line). Also skips past any following blank lines.
procedure Skip_Line; procedure Skip_Line;
-- Skip rest of current line and any following blank lines. -- Skip rest of current line and any following blank lines
procedure Skip_Space; procedure Skip_Space;
-- Skip past white space (blanks or horizontal tab) -- Skip past white space (blanks or horizontal tab)
...@@ -948,7 +949,7 @@ package body ALI is ...@@ -948,7 +949,7 @@ package body ALI is
C := Getc; C := Getc;
Check_Unknown_Line; Check_Unknown_Line;
-- Acquire restrictions line -- Acquire first restrictions line
while C /= 'R' loop while C /= 'R' loop
if Ignore_Errors then if Ignore_Errors then
...@@ -974,7 +975,7 @@ package body ALI is ...@@ -974,7 +975,7 @@ package body ALI is
-- Save cumulative restrictions in case we have a fatal error -- Save cumulative restrictions in case we have a fatal error
Bad_R_Line : exception; Bad_R_Line : exception;
-- Signal bad restrictions line -- Signal bad restrictions line (raised on unexpected character)
begin begin
Checkc (' '); Checkc (' ');
...@@ -998,7 +999,7 @@ package body ALI is ...@@ -998,7 +999,7 @@ package body ALI is
null; null;
when others => when others =>
Fatal_Error; raise Bad_R_Line;
end case; end case;
end loop; end loop;
...@@ -1031,7 +1032,7 @@ package body ALI is ...@@ -1031,7 +1032,7 @@ package body ALI is
end; end;
when others => when others =>
Fatal_Error; raise Bad_R_Line;
end case; end case;
-- Acquire restrictions violations information -- Acquire restrictions violations information
...@@ -1078,7 +1079,7 @@ package body ALI is ...@@ -1078,7 +1079,7 @@ package body ALI is
end if; end if;
when others => when others =>
Fatal_Error; raise Bad_R_Line;
end case; end case;
end loop; end loop;
...@@ -1095,6 +1096,7 @@ package body ALI is ...@@ -1095,6 +1096,7 @@ package body ALI is
if Ignore_Errors then if Ignore_Errors then
Cumulative_Restrictions := Save_R; Cumulative_Restrictions := Save_R;
ALIs.Table (Id).Restrictions := Restrictions_Initial; ALIs.Table (Id).Restrictions := Restrictions_Initial;
Skip_Eol;
-- In normal mode, this is a fatal error -- In normal mode, this is a fatal error
...@@ -1105,9 +1107,23 @@ package body ALI is ...@@ -1105,9 +1107,23 @@ package body ALI is
end Scan_Restrictions; end Scan_Restrictions;
end if; end if;
-- Acquire 'I' lines if present -- Acquire additional restrictions (No_Dependence) lines if present
C := Getc; C := Getc;
while C = 'R' loop
if Ignore ('R') then
Skip_Line;
else
Skip_Space;
No_Deps.Append ((Id, Get_Name));
end if;
Skip_Eol;
C := Getc;
end loop;
-- Acquire 'I' lines if present
Check_Unknown_Line; Check_Unknown_Line;
while C = 'I' loop while C = 'I' loop
......
...@@ -581,6 +581,29 @@ package ALI is ...@@ -581,6 +581,29 @@ package ALI is
Hash => SHash, Hash => SHash,
Equal => SEq); Equal => SEq);
-------------------------
-- No_Dependency Table --
-------------------------
-- Each R line for a No_Dependency Restriction generates an entry in
-- this No_Dependency table.
type No_Dep_Record is record
ALI_File : ALI_Id;
-- ALI File containing tne entry
No_Dep_Unit : Name_Id;
-- Id for names table entry including entire name, including periods.
end record;
package No_Deps is new Table.Table (
Table_Component_Type => No_Dep_Record,
Table_Index_Type => Integer,
Table_Low_Bound => 0,
Table_Initial => 200,
Table_Increment => 400,
Table_Name => "No_Deps");
------------------------------------ ------------------------------------
-- Sdep (Source Dependency) Table -- -- Sdep (Source Dependency) Table --
------------------------------------ ------------------------------------
...@@ -807,7 +830,7 @@ package ALI is ...@@ -807,7 +830,7 @@ package ALI is
-------------------------------------- --------------------------------------
procedure Initialize_ALI; procedure Initialize_ALI;
-- Initialize the ALI tables. Also resets all switch values to defaults. -- Initialize the ALI tables. Also resets all switch values to defaults
function Scan_ALI function Scan_ALI
(F : File_Name_Type; (F : File_Name_Type;
......
...@@ -56,8 +56,12 @@ package body Bcheck is ...@@ -56,8 +56,12 @@ package body Bcheck is
procedure Check_Consistent_Zero_Cost_Exception_Handling; procedure Check_Consistent_Zero_Cost_Exception_Handling;
procedure Consistency_Error_Msg (Msg : String); procedure Consistency_Error_Msg (Msg : String);
-- Produce an error or a warning message, depending on whether -- Produce an error or a warning message, depending on whether an
-- an inconsistent configuration is permitted or not. -- inconsistent configuration is permitted or not.
function Same_Unit (U1 : Name_Id; U2 : Name_Id) return Boolean;
-- Used to compare two unit names for No_Dependence checks. U1 is in
-- standard unit name format, and U2 is in literal form with periods.
------------------------------------ ------------------------------------
-- Check_Consistent_Configuration -- -- Check_Consistent_Configuration --
...@@ -539,8 +543,65 @@ package body Bcheck is ...@@ -539,8 +543,65 @@ package body Bcheck is
end loop; end loop;
end if; end if;
end loop; end loop;
-- Now deal with No_Dependence indications. Note that we put the loop
-- through entries in the no dependency table first, since this loop
-- is most often empty (no such pragma Restrictions in use).
for ND in No_Deps.First .. No_Deps.Last loop
declare
ND_Unit : constant Name_Id := No_Deps.Table (ND).No_Dep_Unit;
begin
for J in ALIs.First .. ALIs.Last loop
declare
A : ALIs_Record renames ALIs.Table (J);
begin
for K in A.First_Unit .. A.Last_Unit loop
declare
U : Unit_Record renames Units.Table (K);
begin
for L in U.First_With .. U.Last_With loop
if Same_Unit (Withs.Table (L).Uname, ND_Unit) then
Error_Msg_Name_1 := U.Uname;
Error_Msg_Name_2 := ND_Unit;
Consistency_Error_Msg
("unit & violates restriction " &
"No_Dependence => %");
end if;
end loop;
end;
end loop;
end;
end loop;
end;
end loop;
end Check_Consistent_Restrictions; end Check_Consistent_Restrictions;
---------------
-- Same_Unit --
---------------
function Same_Unit (U1 : Name_Id; U2 : Name_Id) return Boolean is
begin
-- Note, the string U1 has a terminating %s or %b, U2 does not
if Length_Of_Name (U1) - 2 = Length_Of_Name (U2) then
Get_Name_String (U1);
declare
U1_Str : constant String := Name_Buffer (1 .. Name_Len - 2);
begin
Get_Name_String (U2);
return U1_Str = Name_Buffer (1 .. Name_Len);
end;
else
return False;
end if;
end Same_Unit;
--------------------------------------------------- ---------------------------------------------------
-- Check_Consistent_Zero_Cost_Exception_Handling -- -- Check_Consistent_Zero_Cost_Exception_Handling --
--------------------------------------------------- ---------------------------------------------------
......
...@@ -2324,6 +2324,87 @@ package body Exp_Attr is ...@@ -2324,6 +2324,87 @@ package body Exp_Attr is
Analyze_And_Resolve (N, Typ); Analyze_And_Resolve (N, Typ);
end Mantissa; end Mantissa;
---------
-- Mod --
---------
when Attribute_Mod => Mod_Case : declare
Arg : constant Node_Id := Relocate_Node (First (Exprs));
Hi : constant Node_Id := Type_High_Bound (Etype (Arg));
Modv : constant Uint := Modulus (Btyp);
begin
-- This is not so simple. The issue is what type to use for the
-- computation of the modular value.
-- The easy case is when the modulus value is within the bounds
-- of the signed integer type of the argument. In this case we can
-- just do the computation in that signed integer type, and then
-- do an ordinary conversion to the target type.
if Modv <= Expr_Value (Hi) then
Rewrite (N,
Convert_To (Btyp,
Make_Op_Mod (Loc,
Left_Opnd => Arg,
Right_Opnd => Make_Integer_Literal (Loc, Modv))));
-- Here we know that the modulus is larger than type'Last of the
-- integer type. There are three possible cases to consider:
-- a) The integer value is non-negative. In this case, it is
-- returned as the result (since it is less than the modulus).
-- b) The integer value is negative. In this case, we know that
-- the result is modulus + value, where the value might be as
-- small as -modulus. The trouble is what type do we use to do
-- this subtraction. No type will do, since modulus can be as
-- big as 2**64, and no integer type accomodates this value.
-- Let's do a bit of algebra
-- modulus + value
-- = modulus - (-value)
-- = (modulus - 1) - (-value - 1)
-- Now modulus - 1 is certainly in range of the modular type.
-- -value is in the range 1 .. modulus, so -value -1 is in the
-- range 0 .. modulus-1 which is in range of the modular type.
-- Furthermore, (-value - 1) can be expressed as -(value + 1)
-- which we can compute using the integer base type.
else
Rewrite (N,
Make_Conditional_Expression (Loc,
Expressions => New_List (
Make_Op_Ge (Loc,
Left_Opnd => Duplicate_Subexpr (Arg),
Right_Opnd => Make_Integer_Literal (Loc, 0)),
Convert_To (Btyp,
Duplicate_Subexpr_No_Checks (Arg)),
Make_Op_Subtract (Loc,
Left_Opnd =>
Make_Integer_Literal (Loc,
Intval => Modv - 1),
Right_Opnd =>
Convert_To (Btyp,
Make_Op_Minus (Loc,
Right_Opnd =>
Make_Op_Add (Loc,
Left_Opnd => Duplicate_Subexpr_No_Checks (Arg),
Right_Opnd =>
Make_Integer_Literal (Loc,
Intval => 1))))))));
end if;
Analyze_And_Resolve (N, Btyp);
end Mod_Case;
----------- -----------
-- Model -- -- Model --
----------- -----------
......
...@@ -82,6 +82,9 @@ package body GPrep is ...@@ -82,6 +82,9 @@ package body GPrep is
procedure Display_Copyright; procedure Display_Copyright;
-- Display the copyright notice -- Display the copyright notice
procedure Obsolescent_Check (S : Source_Ptr);
-- Null procedure, needed by instantiation of Scng below
procedure Post_Scan; procedure Post_Scan;
-- Null procedure, needed by instantiation of Scng below -- Null procedure, needed by instantiation of Scng below
...@@ -91,6 +94,7 @@ package body GPrep is ...@@ -91,6 +94,7 @@ package body GPrep is
Errutil.Error_Msg_S, Errutil.Error_Msg_S,
Errutil.Error_Msg_SC, Errutil.Error_Msg_SC,
Errutil.Error_Msg_SP, Errutil.Error_Msg_SP,
Obsolescent_Check,
Errutil.Style); Errutil.Style);
-- The scanner for the preprocessor -- The scanner for the preprocessor
...@@ -298,6 +302,17 @@ package body GPrep is ...@@ -298,6 +302,17 @@ package body GPrep is
New_Line (Outfile.all); New_Line (Outfile.all);
end New_EOL_To_Outfile; end New_EOL_To_Outfile;
-----------------------
-- Obsolescent_Check --
-----------------------
procedure Obsolescent_Check (S : Source_Ptr) is
pragma Warnings (Off, S);
begin
null;
end Obsolescent_Check;
--------------- ---------------
-- Post_Scan -- -- Post_Scan --
--------------- ---------------
......
...@@ -53,6 +53,14 @@ with System.WCh_Con; use System.WCh_Con; ...@@ -53,6 +53,14 @@ with System.WCh_Con; use System.WCh_Con;
package body Lib.Writ is package body Lib.Writ is
-----------------------
-- Local Subprograms --
-----------------------
procedure Write_Unit_Name (N : Node_Id);
-- Used to write out the unit name for R (pragma Restriction) lines
-- for uses of Restriction (No_Dependence => unit-name).
---------------------------------- ----------------------------------
-- Add_Preprocessing_Dependency -- -- Add_Preprocessing_Dependency --
---------------------------------- ----------------------------------
...@@ -940,7 +948,7 @@ package body Lib.Writ is ...@@ -940,7 +948,7 @@ package body Lib.Writ is
end if; end if;
end loop; end loop;
-- Output restrictions line -- Output first restrictions line
Write_Info_Initiate ('R'); Write_Info_Initiate ('R');
Write_Info_Char (' '); Write_Info_Char (' ');
...@@ -987,6 +995,19 @@ package body Lib.Writ is ...@@ -987,6 +995,19 @@ package body Lib.Writ is
Write_Info_EOL; Write_Info_EOL;
-- Output R lines for No_Dependence entries
for J in No_Dependence.First .. No_Dependence.Last loop
if In_Extended_Main_Source_Unit (No_Dependence.Table (J).Unit)
and then not No_Dependence.Table (J).Warn
then
Write_Info_Initiate ('R');
Write_Info_Char (' ');
Write_Unit_Name (No_Dependence.Table (J).Unit);
Write_Info_EOL;
end if;
end loop;
-- Output interrupt state lines -- Output interrupt state lines
for J in Interrupt_States.First .. Interrupt_States.Last loop for J in Interrupt_States.First .. Interrupt_States.Last loop
...@@ -1099,7 +1120,23 @@ package body Lib.Writ is ...@@ -1099,7 +1120,23 @@ package body Lib.Writ is
Output_References; Output_References;
Write_Info_Terminate; Write_Info_Terminate;
Close_Output_Library_Info; Close_Output_Library_Info;
end Write_ALI; end Write_ALI;
---------------------
-- Write_Unit_Name --
---------------------
procedure Write_Unit_Name (N : Node_Id) is
begin
if Nkind (N) = N_Identifier then
Write_Info_Name (Chars (N));
else
pragma Assert (Nkind (N) = N_Selected_Component);
Write_Unit_Name (Prefix (N));
Write_Info_Char ('.');
Write_Unit_Name (Selector_Name (N));
end if;
end Write_Unit_Name;
end Lib.Writ; end Lib.Writ;
...@@ -254,7 +254,7 @@ package Lib.Writ is ...@@ -254,7 +254,7 @@ package Lib.Writ is
-- -- R Restrictions -- -- -- R Restrictions --
-- --------------------- -- ---------------------
-- The R line records the status of restrictions generated by pragma -- The first R line records the status of restrictions generated by pragma
-- Restrictions encountered, as well as information on what the compiler -- Restrictions encountered, as well as information on what the compiler
-- has been able to determine with respect to restrictions violations. -- has been able to determine with respect to restrictions violations.
-- The format is: -- The format is:
...@@ -343,6 +343,16 @@ package Lib.Writ is ...@@ -343,6 +343,16 @@ package Lib.Writ is
-- signal a fatal error if it is missing. This means that future -- signal a fatal error if it is missing. This means that future
-- changes to the ALI file format must retain the R line. -- changes to the ALI file format must retain the R line.
-- Subsequent R lines are present only if pragma Restriction No_Dependence
-- is used. There is one such line for each such pragma appearing in the
-- extended main unit. The format is
-- R unit_name
-- Here the unit name is in all lower case. The components of the unit
-- name are separated by periods. The names themselves are in encoded
-- form, as documented in Namet.
-- ------------------------ -- ------------------------
-- -- I Interrupt States -- -- -- I Interrupt States --
-- ------------------------ -- ------------------------
......
...@@ -32,6 +32,8 @@ with Lib.Util; use Lib.Util; ...@@ -32,6 +32,8 @@ with Lib.Util; use Lib.Util;
with Namet; use Namet; with Namet; use Namet;
with Nlists; use Nlists; with Nlists; use Nlists;
with Opt; use Opt; with Opt; use Opt;
with Restrict; use Restrict;
with Rident; use Rident;
with Sem_Prag; use Sem_Prag; with Sem_Prag; use Sem_Prag;
with Sem_Util; use Sem_Util; with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo; with Sinfo; use Sinfo;
...@@ -259,6 +261,10 @@ package body Lib.Xref is ...@@ -259,6 +261,10 @@ package body Lib.Xref is
begin begin
pragma Assert (Nkind (E) in N_Entity); pragma Assert (Nkind (E) in N_Entity);
if E = Standard_ASCII then
Check_Restriction (No_Obsolescent_Features, N);
end if;
-- Never collect references if not in main source unit. However, -- Never collect references if not in main source unit. However,
-- we omit this test if Typ is 'e' or 'k', since these entries are -- we omit this test if Typ is 'e' or 'k', since these entries are
-- really structural, and it is useful to have them in units -- really structural, and it is useful to have them in units
......
...@@ -425,6 +425,9 @@ package body Ch4 is ...@@ -425,6 +425,9 @@ package body Ch4 is
elsif Token = Tok_Access then elsif Token = Tok_Access then
Attr_Name := Name_Access; Attr_Name := Name_Access;
elsif Token = Tok_Mod and then Ada_Version = Ada_05 then
Attr_Name := Name_Mod;
elsif Apostrophe_Should_Be_Semicolon then elsif Apostrophe_Should_Be_Semicolon then
Expr_Form := EF_Name; Expr_Form := EF_Name;
return Name_Node; return Name_Node;
......
...@@ -32,6 +32,8 @@ ...@@ -32,6 +32,8 @@
with Fname.UF; use Fname.UF; with Fname.UF; use Fname.UF;
with Osint; use Osint; with Osint; use Osint;
with Rident; use Rident;
with Restrict; use Restrict;
with Stringt; use Stringt; with Stringt; use Stringt;
with Stylesw; use Stylesw; with Stylesw; use Stylesw;
with Uintp; use Uintp; with Uintp; use Uintp;
...@@ -41,6 +43,7 @@ separate (Par) ...@@ -41,6 +43,7 @@ separate (Par)
function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
Pragma_Name : constant Name_Id := Chars (Pragma_Node); Pragma_Name : constant Name_Id := Chars (Pragma_Node);
Prag_Id : constant Pragma_Id := Get_Pragma_Id (Pragma_Name);
Pragma_Sloc : constant Source_Ptr := Sloc (Pragma_Node); Pragma_Sloc : constant Source_Ptr := Sloc (Pragma_Node);
Arg_Count : Nat; Arg_Count : Nat;
Arg_Node : Node_Id; Arg_Node : Node_Id;
...@@ -83,6 +86,14 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is ...@@ -83,6 +86,14 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
-- Same as Check_Optional_Identifier, except that the name is required -- Same as Check_Optional_Identifier, except that the name is required
-- to be present and to match the given Id value. -- to be present and to match the given Id value.
procedure Process_Restrictions_Or_Restriction_Warnings;
-- Common processing for Restrictions and Restriction_Warnings pragmas.
-- This routine only processes the case of No_Obsolescent_Features,
-- which is the only restriction that has syntactic effects. No general
-- error checking is done, since this will be done in Sem_Prag. The
-- other case processed is pragma Restrictions No_Dependence, since
-- otherwise this is done too late.
---------- ----------
-- Arg1 -- -- Arg1 --
---------- ----------
...@@ -196,9 +207,40 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is ...@@ -196,9 +207,40 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
end if; end if;
end Check_Required_Identifier; end Check_Required_Identifier;
---------- --------------------------------------------------
-- Prag -- -- Process_Restrictions_Or_Restriction_Warnings --
---------- --------------------------------------------------
procedure Process_Restrictions_Or_Restriction_Warnings is
Arg : Node_Id;
Id : Name_Id;
Expr : Node_Id;
begin
Arg := Arg1;
while Present (Arg) loop
Id := Chars (Arg);
Expr := Expression (Arg);
if Id = No_Name
and then Nkind (Expr) = N_Identifier
and then Get_Restriction_Id (Chars (Expr)) = No_Obsolescent_Features
then
Set_Restriction (No_Obsolescent_Features, Pragma_Node);
Restriction_Warnings (No_Obsolescent_Features) :=
Prag_Id = Pragma_Restriction_Warnings;
elsif Id = Name_No_Dependence then
Set_Restriction_No_Dependence
(Unit => Expr,
Warn => Prag_Id = Pragma_Restriction_Warnings);
end if;
Next (Arg);
end loop;
end Process_Restrictions_Or_Restriction_Warnings;
-- Start if processing for Prag
begin begin
Error_Msg_Name_1 := Pragma_Name; Error_Msg_Name_1 := Pragma_Name;
...@@ -207,7 +249,7 @@ begin ...@@ -207,7 +249,7 @@ begin
-- it is a semantic error, not a syntactic one (we have already checked -- it is a semantic error, not a syntactic one (we have already checked
-- the syntax for the unrecognized pragma as required by (RM 2.8(11)). -- the syntax for the unrecognized pragma as required by (RM 2.8(11)).
if not Is_Pragma_Name (Chars (Pragma_Node)) then if Prag_Id = Unknown_Pragma then
return Pragma_Node; return Pragma_Node;
end if; end if;
...@@ -234,7 +276,7 @@ begin ...@@ -234,7 +276,7 @@ begin
-- Remaining processing is pragma dependent -- Remaining processing is pragma dependent
case Get_Pragma_Id (Pragma_Name) is case Prag_Id is
------------ ------------
-- Ada_83 -- -- Ada_83 --
...@@ -369,6 +411,38 @@ begin ...@@ -369,6 +411,38 @@ begin
List_Pragmas.Increment_Last; List_Pragmas.Increment_Last;
List_Pragmas.Table (List_Pragmas.Last) := (Page, Semi); List_Pragmas.Table (List_Pragmas.Last) := (Page, Semi);
------------------
-- Restrictions --
------------------
-- pragma Restrictions (RESTRICTION {, RESTRICTION});
-- RESTRICTION ::=
-- restriction_IDENTIFIER
-- | restriction_parameter_IDENTIFIER => EXPRESSION
-- We process the case of No_Obsolescent_Features, since this has
-- a syntactic effect that we need to detect at parse time (the use
-- of replacement characters such as colon for pound sign).
when Pragma_Restrictions =>
Process_Restrictions_Or_Restriction_Warnings;
--------------------------
-- Restriction_Warnings --
--------------------------
-- pragma Restriction_Warnings (RESTRICTION {, RESTRICTION});
-- RESTRICTION ::=
-- restriction_IDENTIFIER
-- | restriction_parameter_IDENTIFIER => EXPRESSION
-- See above comment for pragma Restrictions
when Pragma_Restriction_Warnings =>
Process_Restrictions_Or_Restriction_Warnings;
---------------------------------------------------------- ----------------------------------------------------------
-- Source_File_Name and Source_File_Name_Project (GNAT) -- -- Source_File_Name and Source_File_Name_Project (GNAT) --
---------------------------------------------------------- ----------------------------------------------------------
...@@ -1003,8 +1077,6 @@ begin ...@@ -1003,8 +1077,6 @@ begin
Pragma_Queuing_Policy | Pragma_Queuing_Policy |
Pragma_Remote_Call_Interface | Pragma_Remote_Call_Interface |
Pragma_Remote_Types | Pragma_Remote_Types |
Pragma_Restrictions |
Pragma_Restriction_Warnings |
Pragma_Restricted_Run_Time | Pragma_Restricted_Run_Time |
Pragma_Ravenscar | Pragma_Ravenscar |
Pragma_Reviewable | Pragma_Reviewable |
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2002-2003 Free Software Foundation, Inc. -- -- Copyright (C) 2002-2004 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- --
...@@ -31,6 +31,16 @@ with Stringt; use Stringt; ...@@ -31,6 +31,16 @@ with Stringt; use Stringt;
package body Prj.Err is package body Prj.Err is
-----------------------
-- Obsolescent_Check --
-----------------------
procedure Obsolescent_Check (S : Source_Ptr) is
pragma Warnings (Off, S);
begin
null;
end Obsolescent_Check;
--------------- ---------------
-- Post_Scan -- -- Post_Scan --
--------------- ---------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2002-2003 Free Software Foundation, Inc. -- -- Copyright (C) 2002-2004 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- --
...@@ -58,12 +58,12 @@ package Prj.Err is ...@@ -58,12 +58,12 @@ package Prj.Err is
-- file before using any of the other routines in the package. -- file before using any of the other routines in the package.
procedure Finalize (Source_Type : String := "project") procedure Finalize (Source_Type : String := "project")
renames Errutil.Finalize; renames Errutil.Finalize;
-- Finalize processing of error messages for one file and output message -- Finalize processing of error messages for one file and output message
-- indicating the number of detected errors. -- indicating the number of detected errors.
procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr)
renames Errutil.Error_Msg; renames Errutil.Error_Msg;
-- Output a message at specified location. -- Output a message at specified location.
procedure Error_Msg_S (Msg : String) renames Errutil.Error_Msg_S; procedure Error_Msg_S (Msg : String) renames Errutil.Error_Msg_S;
...@@ -85,16 +85,20 @@ package Prj.Err is ...@@ -85,16 +85,20 @@ package Prj.Err is
-- Instantiation of the generic style package, needed for the instantiation -- Instantiation of the generic style package, needed for the instantiation
-- of the generic scanner below. -- of the generic scanner below.
procedure Obsolescent_Check (S : Source_Ptr);
-- Dummy null procedure for Scng instantiation
procedure Post_Scan; procedure Post_Scan;
-- Convert an Ada operator symbol into a standard string -- Convert an Ada operator symbol into a standard string
package Scanner is new Scng package Scanner is new Scng
(Post_Scan => Post_Scan, (Post_Scan => Post_Scan,
Error_Msg => Error_Msg, Error_Msg => Error_Msg,
Error_Msg_S => Error_Msg_S, Error_Msg_S => Error_Msg_S,
Error_Msg_SC => Error_Msg_SC, Error_Msg_SC => Error_Msg_SC,
Error_Msg_SP => Error_Msg_SP, Error_Msg_SP => Error_Msg_SP,
Style => Style); Obsolescent_Check => Obsolescent_Check,
Style => Style);
-- Instantiation of the generic scanner -- Instantiation of the generic scanner
end Prj.Err; end Prj.Err;
...@@ -61,6 +61,10 @@ package body Restrict is ...@@ -61,6 +61,10 @@ package body Restrict is
-- in the Names table, and this table will be locked if we are -- in the Names table, and this table will be locked if we are
-- generating a message from gigi. -- generating a message from gigi.
function Same_Unit (U1, U2 : Node_Id) return Boolean;
-- Returns True iff U1 and U2 represent the same library unit. Used for
-- handling of No_Dependence => Unit restriction case.
function Suppress_Restriction_Message (N : Node_Id) return Boolean; function Suppress_Restriction_Message (N : Node_Id) return Boolean;
-- N is the node for a possible restriction violation message, but -- N is the node for a possible restriction violation message, but
-- the message is to be suppressed if this is an internal file and -- the message is to be suppressed if this is an internal file and
...@@ -302,6 +306,36 @@ package body Restrict is ...@@ -302,6 +306,36 @@ package body Restrict is
end if; end if;
end Check_Restriction; end Check_Restriction;
-------------------------------------
-- Check_Restriction_No_Dependence --
-------------------------------------
procedure Check_Restriction_No_Dependence (U : Node_Id; Err : Node_Id) is
DU : Node_Id;
begin
for J in No_Dependence.First .. No_Dependence.Last loop
DU := No_Dependence.Table (J).Unit;
if Same_Unit (U, DU) then
Error_Msg_Sloc := Sloc (DU);
Error_Msg_Node_1 := DU;
if No_Dependence.Table (J).Warn then
Error_Msg
("?violation of restriction `No_Dependence '='> &`#",
Sloc (Err));
else
Error_Msg
("|violation of restriction `No_Dependence '='> &`#",
Sloc (Err));
end if;
return;
end if;
end loop;
end Check_Restriction_No_Dependence;
---------------------------------------- ----------------------------------------
-- Cunit_Boolean_Restrictions_Restore -- -- Cunit_Boolean_Restrictions_Restore --
---------------------------------------- ----------------------------------------
...@@ -496,6 +530,31 @@ package body Restrict is ...@@ -496,6 +530,31 @@ package body Restrict is
Error_Msg_N (B (1 .. P), N); Error_Msg_N (B (1 .. P), N);
end Restriction_Msg; end Restriction_Msg;
---------------
-- Same_Unit --
---------------
function Same_Unit (U1, U2 : Node_Id) return Boolean is
begin
if Nkind (U1) = N_Identifier then
return Nkind (U2) = N_Identifier and then Chars (U1) = Chars (U2);
elsif Nkind (U2) = N_Identifier then
return False;
elsif (Nkind (U1) = N_Selected_Component
or else Nkind (U1) = N_Expanded_Name)
and then
(Nkind (U2) = N_Selected_Component
or else Nkind (U2) = N_Expanded_Name)
then
return Same_Unit (Prefix (U1), Prefix (U2))
and then Same_Unit (Selector_Name (U1), Selector_Name (U2));
else
return False;
end if;
end Same_Unit;
------------------------------ ------------------------------
-- Set_Profile_Restrictions -- -- Set_Profile_Restrictions --
------------------------------ ------------------------------
...@@ -612,6 +671,38 @@ package body Restrict is ...@@ -612,6 +671,38 @@ package body Restrict is
end if; end if;
end Set_Restriction; end Set_Restriction;
-----------------------------------
-- Set_Restriction_No_Dependence --
-----------------------------------
procedure Set_Restriction_No_Dependence
(Unit : Node_Id;
Warn : Boolean)
is
begin
-- Loop to check for duplicate entry
for J in No_Dependence.First .. No_Dependence.Last loop
-- Case of entry already in table
if Same_Unit (Unit, No_Dependence.Table (J).Unit) then
-- Error has precedence over warning
if not Warn then
No_Dependence.Table (J).Warn := False;
end if;
return;
end if;
end loop;
-- Entry is in table
No_Dependence.Append ((Unit, Warn));
end Set_Restriction_No_Dependence;
---------------------------------- ----------------------------------
-- Suppress_Restriction_Message -- -- Suppress_Restriction_Message --
---------------------------------- ----------------------------------
......
...@@ -27,6 +27,7 @@ ...@@ -27,6 +27,7 @@
-- This package deals with the implementation of the Restrictions pragma -- This package deals with the implementation of the Restrictions pragma
with Rident; use Rident; with Rident; use Rident;
with Table;
with Types; use Types; with Types; use Types;
with Uintp; use Uintp; with Uintp; use Uintp;
...@@ -132,6 +133,33 @@ package Restrict is ...@@ -132,6 +133,33 @@ package Restrict is
No_Elaboration_Code => True, No_Elaboration_Code => True,
others => False); others => False);
-- The following table records entries made by Restrictions pragmas
-- that specify a parameter for No_Dependence. Each such pragma makes
-- an entry in this table.
-- Note: we have chosen to implement this restriction in the "syntactic"
-- form, where we do not check that the named package is a language defined
-- package, but instead we allow arbitrary package names. The discussion of
-- this issue is not complete in the ARG, but the sense seems to be leaning
-- in this direction, which makes more sense to us, since it is much more
-- useful, and much easier to implement.
type ND_Entry is record
Unit : Node_Id;
-- The unit parameter from the No_Dependence pragma
Warn : Boolean;
-- True if from Restriction_Warnings, False if from Restrictions
end record;
package No_Dependence is new Table.Table (
Table_Component_Type => ND_Entry,
Table_Index_Type => Int,
Table_Low_Bound => 0,
Table_Initial => 200,
Table_Increment => 200,
Table_Name => "Name_No_Dependence");
----------------- -----------------
-- Subprograms -- -- Subprograms --
----------------- -----------------
...@@ -162,6 +190,11 @@ package Restrict is ...@@ -162,6 +190,11 @@ package Restrict is
-- violation. If the exact count is not known, V is left at its -- violation. If the exact count is not known, V is left at its
-- default value of -1 which indicates an unknown count. -- default value of -1 which indicates an unknown count.
procedure Check_Restriction_No_Dependence (U : Node_Id; Err : Node_Id);
-- Called when a dependence on a unit is created (either implicitly, or by
-- an explicit WITH clause). U is a node for the unit involved, and Err
-- is the node to which an error will be attached if necessary.
procedure Check_Elaboration_Code_Allowed (N : Node_Id); procedure Check_Elaboration_Code_Allowed (N : Node_Id);
-- Tests to see if elaboration code is allowed by the current restrictions -- Tests to see if elaboration code is allowed by the current restrictions
-- settings. This function is called by Gigi when it needs to define -- settings. This function is called by Gigi when it needs to define
...@@ -241,6 +274,12 @@ package Restrict is ...@@ -241,6 +274,12 @@ package Restrict is
-- Similar to the above, except that this is used for the case of a -- Similar to the above, except that this is used for the case of a
-- parameter restriction, and the corresponding value V is given. -- parameter restriction, and the corresponding value V is given.
procedure Set_Restriction_No_Dependence
(Unit : Node_Id;
Warn : Boolean);
-- Sets given No_Dependence restriction in table if not there already.
-- Warn is True if from Restriction_Warnings, False if from Restrictions.
function Tasking_Allowed return Boolean; function Tasking_Allowed return Boolean;
pragma Inline (Tasking_Allowed); pragma Inline (Tasking_Allowed);
-- Tests to see if tasking operations are allowed by the current -- Tests to see if tasking operations are allowed by the current
......
...@@ -40,6 +40,7 @@ with Nlists; use Nlists; ...@@ -40,6 +40,7 @@ with Nlists; use Nlists;
with Nmake; use Nmake; with Nmake; use Nmake;
with Output; use Output; with Output; use Output;
with Opt; use Opt; with Opt; use Opt;
with Restrict; use Restrict;
with Sem; use Sem; with Sem; use Sem;
with Sem_Ch7; use Sem_Ch7; with Sem_Ch7; use Sem_Ch7;
with Sem_Util; use Sem_Util; with Sem_Util; use Sem_Util;
...@@ -1007,6 +1008,7 @@ package body Rtsfind is ...@@ -1007,6 +1008,7 @@ package body Rtsfind is
Mark_Rewrite_Insertion (Withn); Mark_Rewrite_Insertion (Withn);
Append (Withn, Context_Items (Cunit (Current_Sem_Unit))); Append (Withn, Context_Items (Cunit (Current_Sem_Unit)));
Check_Restriction_No_Dependence (Name (Withn), Current_Error_Node);
end; end;
end if; end if;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2004 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 --
...@@ -46,7 +46,12 @@ pragma Preelaborate (Address_To_Access_Conversions); ...@@ -46,7 +46,12 @@ pragma Preelaborate (Address_To_Access_Conversions);
"Object is unconstrained array type" & ASCII.LF & "Object is unconstrained array type" & ASCII.LF &
"To_Pointer results may not have bounds"); "To_Pointer results may not have bounds");
xyz : Boolean := Object'Constrained; -- Capture constrained status, suppressing warnings, since this is
-- an obsolescent feature to use Constrained in this way (RM J.4).
pragma Warnings (Off);
Xyz : Boolean := Object'Constrained;
pragma Warnings (On);
type Object_Pointer is access all Object; type Object_Pointer is access all Object;
for Object_Pointer'Size use Standard'Address_Size; for Object_Pointer'Size use Standard'Address_Size;
......
...@@ -116,6 +116,7 @@ package System.Rident is ...@@ -116,6 +116,7 @@ package System.Rident is
No_Implementation_Pragmas, -- GNAT No_Implementation_Pragmas, -- GNAT
No_Implementation_Restrictions, -- GNAT No_Implementation_Restrictions, -- GNAT
No_Elaboration_Code, -- GNAT No_Elaboration_Code, -- GNAT
No_Obsolescent_Features, -- Ada 2005 AI-368
-- The following cases require a parameter value -- The following cases require a parameter value
...@@ -166,7 +167,7 @@ package System.Rident is ...@@ -166,7 +167,7 @@ package System.Rident is
-- All restrictions (excluding only Not_A_Restriction_Id) -- All restrictions (excluding only Not_A_Restriction_Id)
subtype All_Boolean_Restrictions is Restriction_Id range subtype All_Boolean_Restrictions is Restriction_Id range
Simple_Barriers .. No_Elaboration_Code; Simple_Barriers .. No_Obsolescent_Features;
-- All restrictions which do not take a parameter -- All restrictions which do not take a parameter
subtype Partition_Boolean_Restrictions is All_Boolean_Restrictions range subtype Partition_Boolean_Restrictions is All_Boolean_Restrictions range
...@@ -177,7 +178,7 @@ package System.Rident is ...@@ -177,7 +178,7 @@ package System.Rident is
-- case of Boolean restrictions. -- case of Boolean restrictions.
subtype Cunit_Boolean_Restrictions is All_Boolean_Restrictions range subtype Cunit_Boolean_Restrictions is All_Boolean_Restrictions range
Immediate_Reclamation .. No_Elaboration_Code; Immediate_Reclamation .. No_Obsolescent_Features;
-- Boolean restrictions that are not checked for partition consistency -- Boolean restrictions that are not checked for partition consistency
-- and that thus apply only to the current unit. Note that for these -- and that thus apply only to the current unit. Note that for these
-- restrictions, the compiler does not apply restrictions found in -- restrictions, the compiler does not apply restrictions found in
......
...@@ -28,6 +28,8 @@ with Atree; use Atree; ...@@ -28,6 +28,8 @@ with Atree; use Atree;
with Csets; use Csets; with Csets; use Csets;
with Namet; use Namet; with Namet; use Namet;
with Opt; use Opt; with Opt; use Opt;
with Restrict; use Restrict;
with Rident; use Rident;
with Scans; use Scans; with Scans; use Scans;
with Sinfo; use Sinfo; with Sinfo; use Sinfo;
with Sinput; use Sinput; with Sinput; use Sinput;
...@@ -321,6 +323,20 @@ package body Scn is ...@@ -321,6 +323,20 @@ package body Scn is
end loop; end loop;
end Initialize_Scanner; end Initialize_Scanner;
-----------------------
-- Obsolescent_Check --
-----------------------
procedure Obsolescent_Check (S : Source_Ptr) is
begin
-- This is a pain in the neck case, since we normally need a node to
-- call Check_Restrictions, and all we have is a source pointer. The
-- easiest thing is to construct a dummy node. A bit kludgy, but this
-- is a marginal case. It's not worth trying to do things more cleanly.
Check_Restriction (No_Obsolescent_Features, New_Node (N_Empty, S));
end Obsolescent_Check;
------------------------------ ------------------------------
-- Scan_Reserved_Identifier -- -- Scan_Reserved_Identifier --
------------------------------ ------------------------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2002 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2004 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- --
...@@ -48,6 +48,10 @@ package Scn is ...@@ -48,6 +48,10 @@ package Scn is
-- Determines the casing style of the current token, which is -- Determines the casing style of the current token, which is
-- either a keyword or an identifier. See also package Casing. -- either a keyword or an identifier. See also package Casing.
procedure Obsolescent_Check (S : Source_Ptr);
-- Called to handle pragma restrictions check for usage of obsolescent
-- character replacements during the scan.
procedure Post_Scan; procedure Post_Scan;
pragma Inline (Post_Scan); pragma Inline (Post_Scan);
-- Create nodes for tokens: Char_Literal, Identifier, Real_Literal, -- Create nodes for tokens: Char_Literal, Identifier, Real_Literal,
...@@ -69,12 +73,13 @@ package Scn is ...@@ -69,12 +73,13 @@ package Scn is
-- generic package Scng with routines appropriate to the compiler -- generic package Scng with routines appropriate to the compiler
package Scanner is new Scng package Scanner is new Scng
(Post_Scan => Post_Scan, (Post_Scan => Post_Scan,
Error_Msg => Error_Msg, Error_Msg => Error_Msg,
Error_Msg_S => Error_Msg_S, Error_Msg_S => Error_Msg_S,
Error_Msg_SC => Error_Msg_SC, Error_Msg_SC => Error_Msg_SC,
Error_Msg_SP => Error_Msg_SP, Error_Msg_SP => Error_Msg_SP,
Style => Style.Style_Inst); Obsolescent_Check => Obsolescent_Check,
Style => Style.Style_Inst);
procedure Scan renames Scanner.Scan; procedure Scan renames Scanner.Scan;
-- Scan scans out the next token, and advances the scan state accordingly -- Scan scans out the next token, and advances the scan state accordingly
......
...@@ -226,7 +226,7 @@ package body Scng is ...@@ -226,7 +226,7 @@ package body Scng is
Initialize_Checksum; Initialize_Checksum;
-- Do not call Scan, otherwise the License stuff does not work in Scn. -- Do not call Scan, otherwise the License stuff does not work in Scn
end Initialize_Scanner; end Initialize_Scanner;
...@@ -550,13 +550,18 @@ package body Scng is ...@@ -550,13 +550,18 @@ package body Scng is
or else or else
Source (Scan_Ptr + 1) in 'a' .. 'z')) Source (Scan_Ptr + 1) in 'a' .. 'z'))
then then
if C = ':' and then Warn_On_Obsolescent_Feature then if C = ':' then
Error_Msg_S Obsolescent_Check (Scan_Ptr);
("use of "":"" is an obsolescent feature ('R'M 'J.2(3))?");
Error_Msg_S if Warn_On_Obsolescent_Feature then
("\use ""'#"" instead?"); Error_Msg_S
("use of "":"" is an obsolescent feature ('R'M 'J.2(3))?");
Error_Msg_S
("\use ""'#"" instead?");
end if;
end if; end if;
Accumulate_Checksum (C); Accumulate_Checksum (C);
Base_Char := C; Base_Char := C;
UI_Base := UI_Int_Value; UI_Base := UI_Int_Value;
...@@ -1498,6 +1503,8 @@ package body Scng is ...@@ -1498,6 +1503,8 @@ package body Scng is
-- Percent starting a string literal -- Percent starting a string literal
when '%' => when '%' =>
Obsolescent_Check (Token_Ptr);
if Warn_On_Obsolescent_Feature then if Warn_On_Obsolescent_Feature then
Error_Msg_S Error_Msg_S
("use of ""'%"" is an obsolescent feature ('R'M 'J.2(4))?"); ("use of ""'%"" is an obsolescent feature ('R'M 'J.2(4))?");
...@@ -1695,6 +1702,7 @@ package body Scng is ...@@ -1695,6 +1702,7 @@ package body Scng is
when '!' => Exclamation_Case : begin when '!' => Exclamation_Case : begin
Accumulate_Checksum ('!'); Accumulate_Checksum ('!');
Obsolescent_Check (Token_Ptr);
if Warn_On_Obsolescent_Feature then if Warn_On_Obsolescent_Feature then
Error_Msg_S Error_Msg_S
...@@ -2043,7 +2051,11 @@ package body Scng is ...@@ -2043,7 +2051,11 @@ package body Scng is
-- in particular allows bracket or other notation -- in particular allows bracket or other notation
-- to be used for upper half letters. -- to be used for upper half letters.
if Identifier_Character_Set /= 'w' then -- Wide characters are always allowed in Ada 2005
if Identifier_Character_Set /= 'w'
and then Ada_Version < Ada_05
then
Error_Msg Error_Msg
("wide character not allowed in identifier", Sptr); ("wide character not allowed in identifier", Sptr);
end if; end if;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2004 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- --
...@@ -50,6 +50,10 @@ generic ...@@ -50,6 +50,10 @@ generic
with procedure Error_Msg_SP (Msg : String); with procedure Error_Msg_SP (Msg : String);
-- Output a message at the start of the previous token -- Output a message at the start of the previous token
with procedure Obsolescent_Check (S : Source_Ptr);
-- Called when one of the obsolescent character replacements is
-- used with S pointing to the character in question.
with package Style is new Styleg with package Style is new Styleg
(Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP); (Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP);
-- Instantiation of Styleg with the same error reporting routines -- Instantiation of Styleg with the same error reporting routines
......
...@@ -259,6 +259,9 @@ package body Sem_Attr is ...@@ -259,6 +259,9 @@ package body Sem_Attr is
procedure Check_Library_Unit; procedure Check_Library_Unit;
-- Verify that prefix of attribute N is a library unit -- Verify that prefix of attribute N is a library unit
procedure Check_Modular_Integer_Type;
-- Verify that prefix of attribute N is a modular integer type
procedure Check_Not_Incomplete_Type; procedure Check_Not_Incomplete_Type;
-- Check that P (the prefix of the attribute) is not an incomplete -- Check that P (the prefix of the attribute) is not an incomplete
-- type or a private type for which no full view has been given. -- type or a private type for which no full view has been given.
...@@ -1074,6 +1077,20 @@ package body Sem_Attr is ...@@ -1074,6 +1077,20 @@ package body Sem_Attr is
end if; end if;
end Check_Library_Unit; end Check_Library_Unit;
--------------------------------
-- Check_Modular_Integer_Type --
--------------------------------
procedure Check_Modular_Integer_Type is
begin
Check_Type;
if not Is_Modular_Integer_Type (P_Type) then
Error_Attr
("prefix of % attribute must be modular integer type", P);
end if;
end Check_Modular_Integer_Type;
------------------------------- -------------------------------
-- Check_Not_Incomplete_Type -- -- Check_Not_Incomplete_Type --
------------------------------- -------------------------------
...@@ -2197,6 +2214,13 @@ package body Sem_Attr is ...@@ -2197,6 +2214,13 @@ package body Sem_Attr is
-- Case from RM J.4(2) of constrained applied to private type -- Case from RM J.4(2) of constrained applied to private type
if Is_Entity_Name (P) and then Is_Type (Entity (P)) then if Is_Entity_Name (P) and then Is_Type (Entity (P)) then
Check_Restriction (No_Obsolescent_Features, N);
if Warn_On_Obsolescent_Feature then
Error_Msg_N
("constrained for private type is an " &
"obsolescent feature ('R'M 'J.4)?", N);
end if;
-- If we are within an instance, the attribute must be legal -- If we are within an instance, the attribute must be legal
-- because it was valid in the generic unit. Ditto if this is -- because it was valid in the generic unit. Ditto if this is
...@@ -2897,6 +2921,21 @@ package body Sem_Attr is ...@@ -2897,6 +2921,21 @@ package body Sem_Attr is
Resolve (E2, P_Base_Type); Resolve (E2, P_Base_Type);
Set_Etype (N, P_Base_Type); Set_Etype (N, P_Base_Type);
---------
-- Mod --
---------
when Attribute_Mod =>
-- Note: this attribute is only allowed in Ada 2005 mode, but
-- we do not need to test that here, since Mod is only recognized
-- as an attribute name in Ada 2005 mode during the parse.
Check_E1;
Check_Modular_Integer_Type;
Resolve (E1, Any_Integer);
Set_Etype (N, P_Base_Type);
----------- -----------
-- Model -- -- Model --
----------- -----------
...@@ -2944,12 +2983,7 @@ package body Sem_Attr is ...@@ -2944,12 +2983,7 @@ package body Sem_Attr is
when Attribute_Modulus => when Attribute_Modulus =>
Check_E0; Check_E0;
Check_Type; Check_Modular_Integer_Type;
if not Is_Modular_Integer_Type (P_Type) then
Error_Attr ("prefix of % attribute must be modular type", P);
end if;
Set_Etype (N, Universal_Integer); Set_Etype (N, Universal_Integer);
-------------------- --------------------
...@@ -5412,10 +5446,19 @@ package body Sem_Attr is ...@@ -5412,10 +5446,19 @@ package body Sem_Attr is
Fold_Ureal Fold_Ureal
(N, UR_Min (Expr_Value_R (E1), Expr_Value_R (E2)), Static); (N, UR_Min (Expr_Value_R (E1), Expr_Value_R (E2)), Static);
else else
Fold_Uint (N, UI_Min (Expr_Value (E1), Expr_Value (E2)), Static); Fold_Uint
(N, UI_Min (Expr_Value (E1), Expr_Value (E2)), Static);
end if; end if;
end Min; end Min;
---------
-- Mod --
---------
when Attribute_Mod =>
Fold_Uint
(N, UI_Mod (Expr_Value (E1), Modulus (P_Base_Type)), Static);
----------- -----------
-- Model -- -- Model --
----------- -----------
...@@ -6678,14 +6721,18 @@ package body Sem_Attr is ...@@ -6678,14 +6721,18 @@ package body Sem_Attr is
elsif Is_Overloaded (P) then elsif Is_Overloaded (P) then
-- Use the designated type of the context to disambiguate -- Use the designated type of the context to disambiguate
-- Note that this was not strictly conformant to Ada 95,
-- but was the implementation adopted by most Ada 95 compilers.
-- The use of the context type to resolve an Access attribute
-- reference is now mandated in AI-235 for Ada 2005.
declare declare
Index : Interp_Index; Index : Interp_Index;
It : Interp; It : Interp;
begin begin
Get_First_Interp (P, Index, It); Get_First_Interp (P, Index, It);
while Present (It.Typ) loop while Present (It.Typ) loop
if Covers (Designated_Type (Typ), It.Typ) then if Covers (Designated_Type (Typ), It.Typ) then
Resolve (P, It.Typ); Resolve (P, It.Typ);
......
...@@ -1668,6 +1668,7 @@ package body Sem_Ch10 is ...@@ -1668,6 +1668,7 @@ package body Sem_Ch10 is
end if; end if;
U := Unit (Library_Unit (N)); U := Unit (Library_Unit (N));
Check_Restriction_No_Dependence (Name (N), N);
Intunit := Is_Internal_File_Name (Unit_File_Name (Current_Sem_Unit)); Intunit := Is_Internal_File_Name (Unit_File_Name (Current_Sem_Unit));
-- Following checks are skipped for dummy packages (those supplied -- Following checks are skipped for dummy packages (those supplied
...@@ -3628,6 +3629,77 @@ package body Sem_Ch10 is ...@@ -3628,6 +3629,77 @@ package body Sem_Ch10 is
if Ekind (Uname) = E_Package then if Ekind (Uname) = E_Package then
Set_From_With_Type (Uname, False); Set_From_With_Type (Uname, False);
end if; end if;
-- Ada 2005 (AI-377): it is illegal for a with_clause to name a child
-- unit if there is a visible homograph for it declared in the same
-- declarative region. This pathological case can only arise when an
-- instance I1 of a generic unit G1 has an explicit child unit I1.G2,
-- G1 has a generic child also named G2, and the context includes with_
-- clauses for both I1.G2 and for G1.G2, making an implicit declaration
-- of I1.G2 visible as well.
if Is_Child_Unit (Uname)
and then Is_Visible_Child_Unit (Uname)
and then Ada_Version >= Ada_05
then
declare
Decl1 : constant Node_Id := Unit_Declaration_Node (P);
Decl2 : Node_Id;
P2 : Entity_Id;
U2 : Entity_Id;
begin
U2 := Homonym (Uname);
while Present (U2) loop
P2 := Scope (U2);
Decl2 := Unit_Declaration_Node (P2);
if Is_Child_Unit (U2)
and then Is_Visible_Child_Unit (U2)
then
if Is_Generic_Instance (P)
and then Nkind (Decl1) = N_Package_Declaration
and then Generic_Parent (Specification (Decl1)) = P2
then
Error_Msg_N ("illegal with_clause", With_Clause);
Error_Msg_N
("\child unit has visible homograph" &
" ('R'M 8.3(26), 10.1.1(19))",
With_Clause);
exit;
elsif Is_Generic_Instance (P2)
and then Nkind (Decl2) = N_Package_Declaration
and then Generic_Parent (Specification (Decl2)) = P
then
-- With_clause for child unit of instance appears before
-- in the context. We want to place the error message on
-- it, not on the generic child unit itself.
declare
Prev_Clause : Node_Id;
begin
Prev_Clause := First (List_Containing (With_Clause));
while Entity (Name (Prev_Clause)) /= U2 loop
Next (Prev_Clause);
end loop;
pragma Assert (Present (Prev_Clause));
Error_Msg_N ("illegal with_clause", Prev_Clause);
Error_Msg_N
("\child unit has visible homograph" &
" ('R'M 8.3(26), 10.1.1(19))",
Prev_Clause);
exit;
end;
end if;
end if;
U2 := Homonym (U2);
end loop;
end;
end if;
end Install_Withed_Unit; end Install_Withed_Unit;
------------------- -------------------
......
...@@ -240,14 +240,16 @@ package body Sem_Ch11 is ...@@ -240,14 +240,16 @@ package body Sem_Ch11 is
else else
if Present (Renamed_Entity (Entity (Id))) then if Present (Renamed_Entity (Entity (Id))) then
if Entity (Id) = Standard_Numeric_Error if Entity (Id) = Standard_Numeric_Error then
and then Warn_On_Obsolescent_Feature Check_Restriction (No_Obsolescent_Features, Id);
then
Error_Msg_N if Warn_On_Obsolescent_Feature then
("Numeric_Error is an " & Error_Msg_N
"obsolescent feature ('R'M 'J.6(1))?", Id); ("Numeric_Error is an " &
Error_Msg_N "obsolescent feature ('R'M 'J.6(1))?", Id);
("\use Constraint_Error instead?", Id); Error_Msg_N
("\use Constraint_Error instead?", Id);
end if;
end if; end if;
end if; end if;
......
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- -- -- c --
-- GNAT COMPILER COMPONENTS -- -- GNAT COMPILER COMPONENTS --
-- -- -- --
-- S E M _ C H 1 3 -- -- S E M _ C H 1 3 --
...@@ -34,6 +34,8 @@ with Lib; use Lib; ...@@ -34,6 +34,8 @@ with Lib; use Lib;
with Nlists; use Nlists; with Nlists; use Nlists;
with Nmake; use Nmake; with Nmake; use Nmake;
with Opt; use Opt; with Opt; use Opt;
with Restrict; use Restrict;
with Rident; use Rident;
with Rtsfind; use Rtsfind; with Rtsfind; use Rtsfind;
with Sem; use Sem; with Sem; use Sem;
with Sem_Ch8; use Sem_Ch8; with Sem_Ch8; use Sem_Ch8;
...@@ -203,6 +205,8 @@ package body Sem_Ch13 is ...@@ -203,6 +205,8 @@ package body Sem_Ch13 is
procedure Analyze_At_Clause (N : Node_Id) is procedure Analyze_At_Clause (N : Node_Id) is
begin begin
Check_Restriction (No_Obsolescent_Features, N);
if Warn_On_Obsolescent_Feature then if Warn_On_Obsolescent_Feature then
Error_Msg_N Error_Msg_N
("at clause is an obsolescent feature ('R'M 'J.7(2))?", N); ("at clause is an obsolescent feature ('R'M 'J.7(2))?", N);
...@@ -355,6 +359,8 @@ package body Sem_Ch13 is ...@@ -355,6 +359,8 @@ package body Sem_Ch13 is
("\?only one task can be declared of this type", N); ("\?only one task can be declared of this type", N);
end if; end if;
Check_Restriction (No_Obsolescent_Features, N);
if Warn_On_Obsolescent_Feature then if Warn_On_Obsolescent_Feature then
Error_Msg_N Error_Msg_N
("attaching interrupt to task entry is an " & ("attaching interrupt to task entry is an " &
...@@ -1187,6 +1193,8 @@ package body Sem_Ch13 is ...@@ -1187,6 +1193,8 @@ package body Sem_Ch13 is
begin begin
if Is_Task_Type (U_Ent) then if Is_Task_Type (U_Ent) then
Check_Restriction (No_Obsolescent_Features, N);
if Warn_On_Obsolescent_Feature then if Warn_On_Obsolescent_Feature then
Error_Msg_N Error_Msg_N
("storage size clause for task is an " & ("storage size clause for task is an " &
...@@ -1955,6 +1963,8 @@ package body Sem_Ch13 is ...@@ -1955,6 +1963,8 @@ package body Sem_Ch13 is
pragma Warnings (Off, Mod_Val); pragma Warnings (Off, Mod_Val);
begin begin
Check_Restriction (No_Obsolescent_Features, Mod_Clause (N));
if Warn_On_Obsolescent_Feature then if Warn_On_Obsolescent_Feature then
Error_Msg_N Error_Msg_N
("mod clause is an obsolescent feature ('R'M 'J.8)?", N); ("mod clause is an obsolescent feature ('R'M 'J.8)?", N);
......
...@@ -8188,6 +8188,8 @@ package body Sem_Ch3 is ...@@ -8188,6 +8188,8 @@ package body Sem_Ch3 is
-- Digits constraint present -- Digits constraint present
if Nkind (C) = N_Digits_Constraint then if Nkind (C) = N_Digits_Constraint then
Check_Restriction (No_Obsolescent_Features, C);
if Warn_On_Obsolescent_Feature then if Warn_On_Obsolescent_Feature then
Error_Msg_N Error_Msg_N
("subtype digits constraint is an " & ("subtype digits constraint is an " &
...@@ -8389,6 +8391,8 @@ package body Sem_Ch3 is ...@@ -8389,6 +8391,8 @@ package body Sem_Ch3 is
-- Delta constraint present -- Delta constraint present
if Nkind (C) = N_Delta_Constraint then if Nkind (C) = N_Delta_Constraint then
Check_Restriction (No_Obsolescent_Features, C);
if Warn_On_Obsolescent_Feature then if Warn_On_Obsolescent_Feature then
Error_Msg_S Error_Msg_S
("subtype delta constraint is an " & ("subtype delta constraint is an " &
......
...@@ -3506,6 +3506,10 @@ package body Sem_Prag is ...@@ -3506,6 +3506,10 @@ package body Sem_Prag is
-- Process_Restrictions_Or_Restriction_Warnings -- -- Process_Restrictions_Or_Restriction_Warnings --
-------------------------------------------------- --------------------------------------------------
-- Note: some of the simple identifier cases were handled in par-prag,
-- but it is harmless (and more straightforward) to simply handle all
-- cases here, even if it means we repeat a bit of work in some cases.
procedure Process_Restrictions_Or_Restriction_Warnings is procedure Process_Restrictions_Or_Restriction_Warnings is
Arg : Node_Id; Arg : Node_Id;
R_Id : Restriction_Id; R_Id : Restriction_Id;
...@@ -3513,10 +3517,33 @@ package body Sem_Prag is ...@@ -3513,10 +3517,33 @@ package body Sem_Prag is
Expr : Node_Id; Expr : Node_Id;
Val : Uint; Val : Uint;
procedure Check_Unit_Name (N : Node_Id);
-- Checks unit name parameter for No_Dependence. Returns if it has
-- an appropriate form, otherwise raises pragma argument error.
procedure Set_Warning (R : All_Restrictions); procedure Set_Warning (R : All_Restrictions);
-- If this is a Restriction_Warnings pragma, set warning flag, -- If this is a Restriction_Warnings pragma, set warning flag,
-- otherwise reset the flag. -- otherwise reset the flag.
---------------------
-- Check_Unit_Name --
---------------------
procedure Check_Unit_Name (N : Node_Id) is
begin
if Nkind (N) = N_Selected_Component then
Check_Unit_Name (Prefix (N));
Check_Unit_Name (Selector_Name (N));
elsif Nkind (N) = N_Identifier then
return;
else
Error_Pragma_Arg
("wrong form for unit name for No_Dependence", N);
end if;
end Check_Unit_Name;
----------------- -----------------
-- Set_Warning -- -- Set_Warning --
----------------- -----------------
...@@ -3577,7 +3604,13 @@ package body Sem_Prag is ...@@ -3577,7 +3604,13 @@ package body Sem_Prag is
Scope_Suppress := (others => True); Scope_Suppress := (others => True);
end if; end if;
-- Case of restriction identifier present -- Case of No_Dependence => unit-name. Note that the parser
-- already made the necessary entry in the No_Dependence table.
elsif Id = Name_No_Dependence then
Check_Unit_Name (Expr);
-- All other cases of restriction identifier present
else else
R_Id := Get_Restriction_Id (Process_Restriction_Synonyms (Arg)); R_Id := Get_Restriction_Id (Process_Restriction_Synonyms (Arg));
...@@ -8543,6 +8576,7 @@ package body Sem_Prag is ...@@ -8543,6 +8576,7 @@ package body Sem_Prag is
end if; end if;
if Present (External) then if Present (External) then
Check_Arg_Is_External_Name (External);
Check_Too_Long (External); Check_Too_Long (External);
end if; end if;
......
...@@ -356,15 +356,16 @@ package body Snames is ...@@ -356,15 +356,16 @@ package body Snames is
"name#" & "name#" &
"nca#" & "nca#" &
"no#" & "no#" &
"on#" & "no_dependence#" &
"parameter_types#" &
"reference#" &
"no_dynamic_attachment#" & "no_dynamic_attachment#" &
"no_dynamic_interrupts#" & "no_dynamic_interrupts#" &
"no_requeue#" & "no_requeue#" &
"no_requeue_statements#" & "no_requeue_statements#" &
"no_task_attributes#" & "no_task_attributes#" &
"no_task_attributes_package#" & "no_task_attributes_package#" &
"on#" &
"parameter_types#" &
"reference#" &
"restricted#" & "restricted#" &
"result_mechanism#" & "result_mechanism#" &
"result_type#" & "result_type#" &
...@@ -449,6 +450,7 @@ package body Snames is ...@@ -449,6 +450,7 @@ package body Snames is
"max_size_in_storage_elements#" & "max_size_in_storage_elements#" &
"maximum_alignment#" & "maximum_alignment#" &
"mechanism_code#" & "mechanism_code#" &
"mod#" &
"model_emin#" & "model_emin#" &
"model_epsilon#" & "model_epsilon#" &
"model_mantissa#" & "model_mantissa#" &
...@@ -569,7 +571,6 @@ package body Snames is ...@@ -569,7 +571,6 @@ package body Snames is
"is#" & "is#" &
"limited#" & "limited#" &
"loop#" & "loop#" &
"mod#" &
"new#" & "new#" &
"not#" & "not#" &
"null#" & "null#" &
......
...@@ -101,84 +101,85 @@ extern unsigned char Get_Attribute_Id (int); ...@@ -101,84 +101,85 @@ extern unsigned char Get_Attribute_Id (int);
#define Attr_Max_Size_In_Storage_Elements 53 #define Attr_Max_Size_In_Storage_Elements 53
#define Attr_Maximum_Alignment 54 #define Attr_Maximum_Alignment 54
#define Attr_Mechanism_Code 55 #define Attr_Mechanism_Code 55
#define Attr_Model_Emin 56 #define Attr_Mod 56
#define Attr_Model_Epsilon 57 #define Attr_Model_Emin 57
#define Attr_Model_Mantissa 58 #define Attr_Model_Epsilon 58
#define Attr_Model_Small 59 #define Attr_Model_Mantissa 59
#define Attr_Modulus 60 #define Attr_Model_Small 60
#define Attr_Null_Parameter 61 #define Attr_Modulus 61
#define Attr_Object_Size 62 #define Attr_Null_Parameter 62
#define Attr_Partition_ID 63 #define Attr_Object_Size 63
#define Attr_Passed_By_Reference 64 #define Attr_Partition_ID 64
#define Attr_Pool_Address 65 #define Attr_Passed_By_Reference 65
#define Attr_Pos 66 #define Attr_Pool_Address 66
#define Attr_Position 67 #define Attr_Pos 67
#define Attr_Range 68 #define Attr_Position 68
#define Attr_Range_Length 69 #define Attr_Range 69
#define Attr_Round 70 #define Attr_Range_Length 70
#define Attr_Safe_Emax 71 #define Attr_Round 71
#define Attr_Safe_First 72 #define Attr_Safe_Emax 72
#define Attr_Safe_Large 73 #define Attr_Safe_First 73
#define Attr_Safe_Last 74 #define Attr_Safe_Large 74
#define Attr_Safe_Small 75 #define Attr_Safe_Last 75
#define Attr_Scale 76 #define Attr_Safe_Small 76
#define Attr_Scaling 77 #define Attr_Scale 77
#define Attr_Signed_Zeros 78 #define Attr_Scaling 78
#define Attr_Size 79 #define Attr_Signed_Zeros 79
#define Attr_Small 80 #define Attr_Size 80
#define Attr_Storage_Size 81 #define Attr_Small 81
#define Attr_Storage_Unit 82 #define Attr_Storage_Size 82
#define Attr_Tag 83 #define Attr_Storage_Unit 83
#define Attr_Target_Name 84 #define Attr_Tag 84
#define Attr_Terminated 85 #define Attr_Target_Name 85
#define Attr_To_Address 86 #define Attr_Terminated 86
#define Attr_Type_Class 87 #define Attr_To_Address 87
#define Attr_UET_Address 88 #define Attr_Type_Class 88
#define Attr_Unbiased_Rounding 89 #define Attr_UET_Address 89
#define Attr_Unchecked_Access 90 #define Attr_Unbiased_Rounding 90
#define Attr_Unconstrained_Array 91 #define Attr_Unchecked_Access 91
#define Attr_Universal_Literal_String 92 #define Attr_Unconstrained_Array 92
#define Attr_Unrestricted_Access 93 #define Attr_Universal_Literal_String 93
#define Attr_VADS_Size 94 #define Attr_Unrestricted_Access 94
#define Attr_Val 95 #define Attr_VADS_Size 95
#define Attr_Valid 96 #define Attr_Val 96
#define Attr_Value_Size 97 #define Attr_Valid 97
#define Attr_Version 98 #define Attr_Value_Size 98
#define Attr_Wide_Character_Size 99 #define Attr_Version 99
#define Attr_Wide_Width 100 #define Attr_Wide_Character_Size 100
#define Attr_Width 101 #define Attr_Wide_Width 101
#define Attr_Word_Size 102 #define Attr_Width 102
#define Attr_Word_Size 103
#define Attr_Adjacent 103 #define Attr_Adjacent 104
#define Attr_Ceiling 104 #define Attr_Ceiling 105
#define Attr_Copy_Sign 105 #define Attr_Copy_Sign 106
#define Attr_Floor 106 #define Attr_Floor 107
#define Attr_Fraction 107 #define Attr_Fraction 108
#define Attr_Image 108 #define Attr_Image 109
#define Attr_Input 109 #define Attr_Input 110
#define Attr_Machine 110 #define Attr_Machine 111
#define Attr_Max 111 #define Attr_Max 112
#define Attr_Min 112 #define Attr_Min 113
#define Attr_Model 113 #define Attr_Model 114
#define Attr_Pred 114 #define Attr_Pred 115
#define Attr_Remainder 115 #define Attr_Remainder 116
#define Attr_Rounding 116 #define Attr_Rounding 117
#define Attr_Succ 117 #define Attr_Succ 118
#define Attr_Truncation 118 #define Attr_Truncation 119
#define Attr_Value 119 #define Attr_Value 120
#define Attr_Wide_Image 120 #define Attr_Wide_Image 121
#define Attr_Wide_Value 121 #define Attr_Wide_Value 122
#define Attr_Output 122 #define Attr_Output 123
#define Attr_Read 123 #define Attr_Read 124
#define Attr_Write 124 #define Attr_Write 125
#define Attr_Elab_Body 125 #define Attr_Elab_Body 126
#define Attr_Elab_Spec 126 #define Attr_Elab_Spec 127
#define Attr_Storage_Pool 127 #define Attr_Storage_Pool 128
#define Attr_Base 128 #define Attr_Base 129
#define Attr_Class 129 #define Attr_Class 130
/* Define the function to check if a Name_Id value is a valid pragma */ /* Define the function to check if a Name_Id value is a valid pragma */
......
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