diff options
33 files changed, 1225 insertions, 508 deletions
diff --git a/gcc/ada/a-direio.adb b/gcc/ada/a-direio.adb index 3c5743bc439..0c01d1a6d4b 100644 --- a/gcc/ada/a-direio.adb +++ b/gcc/ada/a-direio.adb @@ -6,7 +6,7 @@ -- -- -- 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 -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -183,9 +183,15 @@ package body Ada.Direct_IO is -- For a non-constrained variant record type, we read into an -- intermediate buffer, since we may have the case of discriminated -- 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 + pragma Warnings (On); + declare Buf : Element_Type; @@ -205,7 +211,13 @@ package body Ada.Direct_IO is begin -- 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 + pragma Warnings (On); + declare Buf : Element_Type; diff --git a/gcc/ada/a-numeri.ads b/gcc/ada/a-numeri.ads index 35efcc2b6af..e0dfef2b2f2 100644 --- a/gcc/ada/a-numeri.ads +++ b/gcc/ada/a-numeri.ads @@ -22,7 +22,12 @@ pragma Pure (Numerics); Pi : constant := 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 := - 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; diff --git a/gcc/ada/ali-util.adb b/gcc/ada/ali-util.adb index 1358ed07c11..1bf114a59e6 100644 --- a/gcc/ada/ali-util.adb +++ b/gcc/ada/ali-util.adb @@ -53,7 +53,9 @@ package body ALI.Util is 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 (Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP); @@ -62,7 +64,8 @@ package body ALI.Util is -- Get_File_Checksum). 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; @@ -200,6 +203,16 @@ package body ALI.Util is Interfaces.Reset; end Initialize_ALI_Source; + ----------------------- + -- Obsolescent_Check -- + ----------------------- + + procedure Obsolescent_Check (S : Source_Ptr) is + pragma Warnings (Off, S); + begin + null; + end Obsolescent_Check; + --------------- -- Post_Scan -- --------------- diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index c1e51b4d472..0f182055571 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -84,6 +84,7 @@ package body ALI is -- Initialize all tables ALIs.Init; + No_Deps.Init; Units.Init; Withs.Init; Sdep.Init; @@ -199,7 +200,7 @@ package body ALI is -- quote. 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; -- Skip blanks, then scan out a time stamp @@ -212,7 +213,7 @@ package body ALI is -- at end of line). Also skips past any following blank lines. 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; -- Skip past white space (blanks or horizontal tab) @@ -948,7 +949,7 @@ package body ALI is C := Getc; Check_Unknown_Line; - -- Acquire restrictions line + -- Acquire first restrictions line while C /= 'R' loop if Ignore_Errors then @@ -974,7 +975,7 @@ package body ALI is -- Save cumulative restrictions in case we have a fatal error Bad_R_Line : exception; - -- Signal bad restrictions line + -- Signal bad restrictions line (raised on unexpected character) begin Checkc (' '); @@ -998,7 +999,7 @@ package body ALI is null; when others => - Fatal_Error; + raise Bad_R_Line; end case; end loop; @@ -1031,7 +1032,7 @@ package body ALI is end; when others => - Fatal_Error; + raise Bad_R_Line; end case; -- Acquire restrictions violations information @@ -1078,7 +1079,7 @@ package body ALI is end if; when others => - Fatal_Error; + raise Bad_R_Line; end case; end loop; @@ -1095,6 +1096,7 @@ package body ALI is if Ignore_Errors then Cumulative_Restrictions := Save_R; ALIs.Table (Id).Restrictions := Restrictions_Initial; + Skip_Eol; -- In normal mode, this is a fatal error @@ -1105,9 +1107,23 @@ package body ALI is end Scan_Restrictions; end if; - -- Acquire 'I' lines if present + -- Acquire additional restrictions (No_Dependence) lines if present 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; while C = 'I' loop diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index 44f5ffa45b8..48b1732f315 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -581,6 +581,29 @@ package ALI is Hash => SHash, 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 -- ------------------------------------ @@ -807,7 +830,7 @@ package ALI is -------------------------------------- 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 (F : File_Name_Type; diff --git a/gcc/ada/bcheck.adb b/gcc/ada/bcheck.adb index 16aeb8589ea..2ada0cf1353 100644 --- a/gcc/ada/bcheck.adb +++ b/gcc/ada/bcheck.adb @@ -56,8 +56,12 @@ package body Bcheck is procedure Check_Consistent_Zero_Cost_Exception_Handling; procedure Consistency_Error_Msg (Msg : String); - -- Produce an error or a warning message, depending on whether - -- an inconsistent configuration is permitted or not. + -- Produce an error or a warning message, depending on whether an + -- 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 -- @@ -539,8 +543,65 @@ package body Bcheck is end loop; end if; 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; + --------------- + -- 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 -- --------------------------------------------------- diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index ae9a5cb0984..fa99d8bd1ad 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -2324,6 +2324,87 @@ package body Exp_Attr is Analyze_And_Resolve (N, Typ); 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 -- ----------- diff --git a/gcc/ada/gprep.adb b/gcc/ada/gprep.adb index 53b2bd6f46f..02e07526778 100644 --- a/gcc/ada/gprep.adb +++ b/gcc/ada/gprep.adb @@ -82,6 +82,9 @@ package body GPrep is procedure Display_Copyright; -- Display the copyright notice + procedure Obsolescent_Check (S : Source_Ptr); + -- Null procedure, needed by instantiation of Scng below + procedure Post_Scan; -- Null procedure, needed by instantiation of Scng below @@ -91,6 +94,7 @@ package body GPrep is Errutil.Error_Msg_S, Errutil.Error_Msg_SC, Errutil.Error_Msg_SP, + Obsolescent_Check, Errutil.Style); -- The scanner for the preprocessor @@ -298,6 +302,17 @@ package body GPrep is New_Line (Outfile.all); 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 -- --------------- diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index 36240549d04..2de8789514b 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -53,6 +53,14 @@ with System.WCh_Con; use System.WCh_Con; 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 -- ---------------------------------- @@ -940,7 +948,7 @@ package body Lib.Writ is end if; end loop; - -- Output restrictions line + -- Output first restrictions line Write_Info_Initiate ('R'); Write_Info_Char (' '); @@ -987,6 +995,19 @@ package body Lib.Writ is 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 for J in Interrupt_States.First .. Interrupt_States.Last loop @@ -1099,7 +1120,23 @@ package body Lib.Writ is Output_References; Write_Info_Terminate; Close_Output_Library_Info; - 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; diff --git a/gcc/ada/lib-writ.ads b/gcc/ada/lib-writ.ads index 2cc6b568cb0..6741c9d4f98 100644 --- a/gcc/ada/lib-writ.ads +++ b/gcc/ada/lib-writ.ads @@ -254,7 +254,7 @@ package Lib.Writ is -- -- 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 -- has been able to determine with respect to restrictions violations. -- The format is: @@ -343,6 +343,16 @@ package Lib.Writ is -- signal a fatal error if it is missing. This means that future -- 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 -- -- ------------------------ diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index b446b99f333..eae80ff022c 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -32,6 +32,8 @@ with Lib.Util; use Lib.Util; with Namet; use Namet; with Nlists; use Nlists; with Opt; use Opt; +with Restrict; use Restrict; +with Rident; use Rident; with Sem_Prag; use Sem_Prag; with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; @@ -259,6 +261,10 @@ package body Lib.Xref is begin 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, -- 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 diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index c35cac7c0ed..5826606352e 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -425,6 +425,9 @@ package body Ch4 is elsif Token = Tok_Access then 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 Expr_Form := EF_Name; return Name_Node; diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index c07c39b7882..d22c5243cee 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -32,6 +32,8 @@ with Fname.UF; use Fname.UF; with Osint; use Osint; +with Rident; use Rident; +with Restrict; use Restrict; with Stringt; use Stringt; with Stylesw; use Stylesw; with Uintp; use Uintp; @@ -41,6 +43,7 @@ separate (Par) function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is 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); Arg_Count : Nat; Arg_Node : Node_Id; @@ -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 -- 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 -- ---------- @@ -196,9 +207,40 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is end if; 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 Error_Msg_Name_1 := Pragma_Name; @@ -207,7 +249,7 @@ begin -- 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)). - if not Is_Pragma_Name (Chars (Pragma_Node)) then + if Prag_Id = Unknown_Pragma then return Pragma_Node; end if; @@ -234,7 +276,7 @@ begin -- Remaining processing is pragma dependent - case Get_Pragma_Id (Pragma_Name) is + case Prag_Id is ------------ -- Ada_83 -- @@ -369,6 +411,38 @@ begin List_Pragmas.Increment_Last; 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) -- ---------------------------------------------------------- @@ -1003,8 +1077,6 @@ begin Pragma_Queuing_Policy | Pragma_Remote_Call_Interface | Pragma_Remote_Types | - Pragma_Restrictions | - Pragma_Restriction_Warnings | Pragma_Restricted_Run_Time | Pragma_Ravenscar | Pragma_Reviewable | diff --git a/gcc/ada/prj-err.adb b/gcc/ada/prj-err.adb index b3d4b5641aa..5db2dd67e52 100644 --- a/gcc/ada/prj-err.adb +++ b/gcc/ada/prj-err.adb @@ -6,7 +6,7 @@ -- -- -- 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 -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -31,6 +31,16 @@ with Stringt; use Stringt; 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 -- --------------- diff --git a/gcc/ada/prj-err.ads b/gcc/ada/prj-err.ads index bfbdd28bfea..8a299744200 100644 --- a/gcc/ada/prj-err.ads +++ b/gcc/ada/prj-err.ads @@ -6,7 +6,7 @@ -- -- -- 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 -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -58,12 +58,12 @@ package Prj.Err is -- file before using any of the other routines in the package. procedure Finalize (Source_Type : String := "project") - renames Errutil.Finalize; + renames Errutil.Finalize; -- Finalize processing of error messages for one file and output message -- indicating the number of detected errors. procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) - renames Errutil.Error_Msg; + renames Errutil.Error_Msg; -- Output a message at specified location. procedure Error_Msg_S (Msg : String) renames Errutil.Error_Msg_S; @@ -85,16 +85,20 @@ package Prj.Err is -- Instantiation of the generic style package, needed for the instantiation -- of the generic scanner below. + procedure Obsolescent_Check (S : Source_Ptr); + -- Dummy null procedure for Scng instantiation + procedure Post_Scan; -- Convert an Ada operator symbol into a standard string package Scanner is new Scng - (Post_Scan => Post_Scan, - Error_Msg => Error_Msg, - Error_Msg_S => Error_Msg_S, - Error_Msg_SC => Error_Msg_SC, - Error_Msg_SP => Error_Msg_SP, - Style => Style); + (Post_Scan => Post_Scan, + Error_Msg => Error_Msg, + Error_Msg_S => Error_Msg_S, + Error_Msg_SC => Error_Msg_SC, + Error_Msg_SP => Error_Msg_SP, + Obsolescent_Check => Obsolescent_Check, + Style => Style); -- Instantiation of the generic scanner end Prj.Err; diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index d35a9ecd8cb..805a9930527 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.adb @@ -61,6 +61,10 @@ package body Restrict is -- in the Names table, and this table will be locked if we are -- 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; -- N is the node for a possible restriction violation message, but -- the message is to be suppressed if this is an internal file and @@ -302,6 +306,36 @@ package body Restrict is end if; 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 -- ---------------------------------------- @@ -496,6 +530,31 @@ package body Restrict is Error_Msg_N (B (1 .. P), N); 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 -- ------------------------------ @@ -612,6 +671,38 @@ package body Restrict is end if; 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 -- ---------------------------------- diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads index 364b6507ad3..b14f4a9468a 100644 --- a/gcc/ada/restrict.ads +++ b/gcc/ada/restrict.ads @@ -27,6 +27,7 @@ -- This package deals with the implementation of the Restrictions pragma with Rident; use Rident; +with Table; with Types; use Types; with Uintp; use Uintp; @@ -132,6 +133,33 @@ package Restrict is No_Elaboration_Code => True, 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 -- ----------------- @@ -162,6 +190,11 @@ package Restrict is -- violation. If the exact count is not known, V is left at its -- 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); -- Tests to see if elaboration code is allowed by the current restrictions -- settings. This function is called by Gigi when it needs to define @@ -241,6 +274,12 @@ package Restrict is -- Similar to the above, except that this is used for the case of a -- 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; pragma Inline (Tasking_Allowed); -- Tests to see if tasking operations are allowed by the current diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index e4d1d035949..edf3a38155a 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -40,6 +40,7 @@ with Nlists; use Nlists; with Nmake; use Nmake; with Output; use Output; with Opt; use Opt; +with Restrict; use Restrict; with Sem; use Sem; with Sem_Ch7; use Sem_Ch7; with Sem_Util; use Sem_Util; @@ -1007,6 +1008,7 @@ package body Rtsfind is Mark_Rewrite_Insertion (Withn); Append (Withn, Context_Items (Cunit (Current_Sem_Unit))); + Check_Restriction_No_Dependence (Name (Withn), Current_Error_Node); end; end if; diff --git a/gcc/ada/s-atacco.ads b/gcc/ada/s-atacco.ads index 51139f567e6..baf37b776a2 100644 --- a/gcc/ada/s-atacco.ads +++ b/gcc/ada/s-atacco.ads @@ -6,7 +6,7 @@ -- -- -- 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 -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -46,7 +46,12 @@ pragma Preelaborate (Address_To_Access_Conversions); "Object is unconstrained array type" & ASCII.LF & "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; for Object_Pointer'Size use Standard'Address_Size; diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads index 409adc66c0f..f64ab2772d5 100644 --- a/gcc/ada/s-rident.ads +++ b/gcc/ada/s-rident.ads @@ -116,6 +116,7 @@ package System.Rident is No_Implementation_Pragmas, -- GNAT No_Implementation_Restrictions, -- GNAT No_Elaboration_Code, -- GNAT + No_Obsolescent_Features, -- Ada 2005 AI-368 -- The following cases require a parameter value @@ -166,7 +167,7 @@ package System.Rident is -- All restrictions (excluding only Not_A_Restriction_Id) 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 subtype Partition_Boolean_Restrictions is All_Boolean_Restrictions range @@ -177,7 +178,7 @@ package System.Rident is -- case of Boolean restrictions. 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 -- and that thus apply only to the current unit. Note that for these -- restrictions, the compiler does not apply restrictions found in diff --git a/gcc/ada/scn.adb b/gcc/ada/scn.adb index 5e8fbbf2298..a60d28e1fe8 100644 --- a/gcc/ada/scn.adb +++ b/gcc/ada/scn.adb @@ -28,6 +28,8 @@ with Atree; use Atree; with Csets; use Csets; with Namet; use Namet; with Opt; use Opt; +with Restrict; use Restrict; +with Rident; use Rident; with Scans; use Scans; with Sinfo; use Sinfo; with Sinput; use Sinput; @@ -321,6 +323,20 @@ package body Scn is end loop; 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 -- ------------------------------ diff --git a/gcc/ada/scn.ads b/gcc/ada/scn.ads index 23741e85441..d2a80f1bfa0 100644 --- a/gcc/ada/scn.ads +++ b/gcc/ada/scn.ads @@ -6,7 +6,7 @@ -- -- -- 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 -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -48,6 +48,10 @@ package Scn is -- Determines the casing style of the current token, which is -- 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; pragma Inline (Post_Scan); -- Create nodes for tokens: Char_Literal, Identifier, Real_Literal, @@ -69,12 +73,13 @@ package Scn is -- generic package Scng with routines appropriate to the compiler package Scanner is new Scng - (Post_Scan => Post_Scan, - Error_Msg => Error_Msg, - Error_Msg_S => Error_Msg_S, - Error_Msg_SC => Error_Msg_SC, - Error_Msg_SP => Error_Msg_SP, - Style => Style.Style_Inst); + (Post_Scan => Post_Scan, + Error_Msg => Error_Msg, + Error_Msg_S => Error_Msg_S, + Error_Msg_SC => Error_Msg_SC, + Error_Msg_SP => Error_Msg_SP, + Obsolescent_Check => Obsolescent_Check, + Style => Style.Style_Inst); procedure Scan renames Scanner.Scan; -- Scan scans out the next token, and advances the scan state accordingly diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb index 9f363593eea..486fbffe45d 100644 --- a/gcc/ada/scng.adb +++ b/gcc/ada/scng.adb @@ -226,7 +226,7 @@ package body Scng is 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; @@ -550,13 +550,18 @@ package body Scng is or else Source (Scan_Ptr + 1) in 'a' .. 'z')) then - if C = ':' and then Warn_On_Obsolescent_Feature then - Error_Msg_S - ("use of "":"" is an obsolescent feature ('R'M 'J.2(3))?"); - Error_Msg_S - ("\use ""'#"" instead?"); + if C = ':' then + Obsolescent_Check (Scan_Ptr); + + if Warn_On_Obsolescent_Feature then + Error_Msg_S + ("use of "":"" is an obsolescent feature ('R'M 'J.2(3))?"); + Error_Msg_S + ("\use ""'#"" instead?"); + end if; end if; + Accumulate_Checksum (C); Base_Char := C; UI_Base := UI_Int_Value; @@ -1498,6 +1503,8 @@ package body Scng is -- Percent starting a string literal when '%' => + Obsolescent_Check (Token_Ptr); + if Warn_On_Obsolescent_Feature then Error_Msg_S ("use of ""'%"" is an obsolescent feature ('R'M 'J.2(4))?"); @@ -1695,6 +1702,7 @@ package body Scng is when '!' => Exclamation_Case : begin Accumulate_Checksum ('!'); + Obsolescent_Check (Token_Ptr); if Warn_On_Obsolescent_Feature then Error_Msg_S @@ -2043,7 +2051,11 @@ package body Scng is -- in particular allows bracket or other notation -- 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 ("wide character not allowed in identifier", Sptr); end if; diff --git a/gcc/ada/scng.ads b/gcc/ada/scng.ads index 31e81a7cd7f..dbe3261848c 100644 --- a/gcc/ada/scng.ads +++ b/gcc/ada/scng.ads @@ -6,7 +6,7 @@ -- -- -- 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 -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -50,6 +50,10 @@ generic with procedure Error_Msg_SP (Msg : String); -- 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 (Error_Msg, Error_Msg_S, Error_Msg_SC, Error_Msg_SP); -- Instantiation of Styleg with the same error reporting routines diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 57c06a599a1..553fb7138a1 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -259,6 +259,9 @@ package body Sem_Attr is procedure Check_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; -- 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. @@ -1074,6 +1077,20 @@ package body Sem_Attr is end if; 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 -- ------------------------------- @@ -2197,6 +2214,13 @@ package body Sem_Attr is -- Case from RM J.4(2) of constrained applied to private type 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 -- because it was valid in the generic unit. Ditto if this is @@ -2897,6 +2921,21 @@ package body Sem_Attr is Resolve (E2, 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 -- ----------- @@ -2944,12 +2983,7 @@ package body Sem_Attr is when Attribute_Modulus => Check_E0; - Check_Type; - - if not Is_Modular_Integer_Type (P_Type) then - Error_Attr ("prefix of % attribute must be modular type", P); - end if; - + Check_Modular_Integer_Type; Set_Etype (N, Universal_Integer); -------------------- @@ -5412,10 +5446,19 @@ package body Sem_Attr is Fold_Ureal (N, UR_Min (Expr_Value_R (E1), Expr_Value_R (E2)), Static); 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 Min; + --------- + -- Mod -- + --------- + + when Attribute_Mod => + Fold_Uint + (N, UI_Mod (Expr_Value (E1), Modulus (P_Base_Type)), Static); + ----------- -- Model -- ----------- @@ -6678,14 +6721,18 @@ package body Sem_Attr is 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 Index : Interp_Index; It : Interp; + begin Get_First_Interp (P, Index, It); - while Present (It.Typ) loop if Covers (Designated_Type (Typ), It.Typ) then Resolve (P, It.Typ); diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 346cbf3eeee..5d9e5caa34d 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -1668,6 +1668,7 @@ package body Sem_Ch10 is end if; U := Unit (Library_Unit (N)); + Check_Restriction_No_Dependence (Name (N), N); Intunit := Is_Internal_File_Name (Unit_File_Name (Current_Sem_Unit)); -- Following checks are skipped for dummy packages (those supplied @@ -3628,6 +3629,77 @@ package body Sem_Ch10 is if Ekind (Uname) = E_Package then Set_From_With_Type (Uname, False); 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; ------------------- diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb index 616b2282308..bd3faa4c8c2 100644 --- a/gcc/ada/sem_ch11.adb +++ b/gcc/ada/sem_ch11.adb @@ -240,14 +240,16 @@ package body Sem_Ch11 is else if Present (Renamed_Entity (Entity (Id))) then - if Entity (Id) = Standard_Numeric_Error - and then Warn_On_Obsolescent_Feature - then - Error_Msg_N - ("Numeric_Error is an " & - "obsolescent feature ('R'M 'J.6(1))?", Id); - Error_Msg_N - ("\use Constraint_Error instead?", Id); + if Entity (Id) = Standard_Numeric_Error then + Check_Restriction (No_Obsolescent_Features, Id); + + if Warn_On_Obsolescent_Feature then + Error_Msg_N + ("Numeric_Error is an " & + "obsolescent feature ('R'M 'J.6(1))?", Id); + Error_Msg_N + ("\use Constraint_Error instead?", Id); + end if; end if; end if; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 117dde22131..e620044b762 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1,5 +1,5 @@ ------------------------------------------------------------------------------ --- -- +-- c -- -- GNAT COMPILER COMPONENTS -- -- -- -- S E M _ C H 1 3 -- @@ -34,6 +34,8 @@ with Lib; use Lib; with Nlists; use Nlists; with Nmake; use Nmake; with Opt; use Opt; +with Restrict; use Restrict; +with Rident; use Rident; with Rtsfind; use Rtsfind; with Sem; use Sem; with Sem_Ch8; use Sem_Ch8; @@ -203,6 +205,8 @@ package body Sem_Ch13 is procedure Analyze_At_Clause (N : Node_Id) is begin + Check_Restriction (No_Obsolescent_Features, N); + if Warn_On_Obsolescent_Feature then Error_Msg_N ("at clause is an obsolescent feature ('R'M 'J.7(2))?", N); @@ -355,6 +359,8 @@ package body Sem_Ch13 is ("\?only one task can be declared of this type", N); end if; + Check_Restriction (No_Obsolescent_Features, N); + if Warn_On_Obsolescent_Feature then Error_Msg_N ("attaching interrupt to task entry is an " & @@ -1187,6 +1193,8 @@ package body Sem_Ch13 is begin if Is_Task_Type (U_Ent) then + Check_Restriction (No_Obsolescent_Features, N); + if Warn_On_Obsolescent_Feature then Error_Msg_N ("storage size clause for task is an " & @@ -1955,6 +1963,8 @@ package body Sem_Ch13 is pragma Warnings (Off, Mod_Val); begin + Check_Restriction (No_Obsolescent_Features, Mod_Clause (N)); + if Warn_On_Obsolescent_Feature then Error_Msg_N ("mod clause is an obsolescent feature ('R'M 'J.8)?", N); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index a80ec969c4f..65a0ae94591 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -8188,6 +8188,8 @@ package body Sem_Ch3 is -- Digits constraint present if Nkind (C) = N_Digits_Constraint then + Check_Restriction (No_Obsolescent_Features, C); + if Warn_On_Obsolescent_Feature then Error_Msg_N ("subtype digits constraint is an " & @@ -8389,6 +8391,8 @@ package body Sem_Ch3 is -- Delta constraint present if Nkind (C) = N_Delta_Constraint then + Check_Restriction (No_Obsolescent_Features, C); + if Warn_On_Obsolescent_Feature then Error_Msg_S ("subtype delta constraint is an " & diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 9691ebbc1db..6ece74120d0 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -3506,6 +3506,10 @@ package body Sem_Prag is -- 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 Arg : Node_Id; R_Id : Restriction_Id; @@ -3513,10 +3517,33 @@ package body Sem_Prag is Expr : Node_Id; 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); -- If this is a Restriction_Warnings pragma, set warning 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 -- ----------------- @@ -3577,7 +3604,13 @@ package body Sem_Prag is Scope_Suppress := (others => True); 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 R_Id := Get_Restriction_Id (Process_Restriction_Synonyms (Arg)); @@ -8543,6 +8576,7 @@ package body Sem_Prag is end if; if Present (External) then + Check_Arg_Is_External_Name (External); Check_Too_Long (External); end if; diff --git a/gcc/ada/snames.adb b/gcc/ada/snames.adb index 125455ca6bf..bdb73ce1595 100644 --- a/gcc/ada/snames.adb +++ b/gcc/ada/snames.adb @@ -356,15 +356,16 @@ package body Snames is "name#" & "nca#" & "no#" & - "on#" & - "parameter_types#" & - "reference#" & + "no_dependence#" & "no_dynamic_attachment#" & "no_dynamic_interrupts#" & "no_requeue#" & "no_requeue_statements#" & "no_task_attributes#" & "no_task_attributes_package#" & + "on#" & + "parameter_types#" & + "reference#" & "restricted#" & "result_mechanism#" & "result_type#" & @@ -449,6 +450,7 @@ package body Snames is "max_size_in_storage_elements#" & "maximum_alignment#" & "mechanism_code#" & + "mod#" & "model_emin#" & "model_epsilon#" & "model_mantissa#" & @@ -569,7 +571,6 @@ package body Snames is "is#" & "limited#" & "loop#" & - "mod#" & "new#" & "not#" & "null#" & diff --git a/gcc/ada/snames.ads b/gcc/ada/snames.ads index 4fb6c255ba8..5d4800752d3 100644 --- a/gcc/ada/snames.ads +++ b/gcc/ada/snames.ads @@ -559,43 +559,44 @@ package Snames is Name_Name : constant Name_Id := N + 296; Name_NCA : constant Name_Id := N + 297; Name_No : constant Name_Id := N + 298; - Name_On : constant Name_Id := N + 299; - Name_Parameter_Types : constant Name_Id := N + 300; - Name_Reference : constant Name_Id := N + 301; - Name_No_Dynamic_Attachment : constant Name_Id := N + 302; - Name_No_Dynamic_Interrupts : constant Name_Id := N + 303; - Name_No_Requeue : constant Name_Id := N + 304; - Name_No_Requeue_Statements : constant Name_Id := N + 305; - Name_No_Task_Attributes : constant Name_Id := N + 306; - Name_No_Task_Attributes_Package : constant Name_Id := N + 307; - Name_Restricted : constant Name_Id := N + 308; - Name_Result_Mechanism : constant Name_Id := N + 309; - Name_Result_Type : constant Name_Id := N + 310; - Name_Runtime : constant Name_Id := N + 311; - Name_SB : constant Name_Id := N + 312; - Name_Secondary_Stack_Size : constant Name_Id := N + 313; - Name_Section : constant Name_Id := N + 314; - Name_Semaphore : constant Name_Id := N + 315; - Name_Simple_Barriers : constant Name_Id := N + 316; - Name_Spec_File_Name : constant Name_Id := N + 317; - Name_Static : constant Name_Id := N + 318; - Name_Stack_Size : constant Name_Id := N + 319; - Name_Subunit_File_Name : constant Name_Id := N + 320; - Name_Task_Stack_Size_Default : constant Name_Id := N + 321; - Name_Task_Type : constant Name_Id := N + 322; - Name_Time_Slicing_Enabled : constant Name_Id := N + 323; - Name_Top_Guard : constant Name_Id := N + 324; - Name_UBA : constant Name_Id := N + 325; - Name_UBS : constant Name_Id := N + 326; - Name_UBSB : constant Name_Id := N + 327; - Name_Unit_Name : constant Name_Id := N + 328; - Name_Unknown : constant Name_Id := N + 329; - Name_Unrestricted : constant Name_Id := N + 330; - Name_Uppercase : constant Name_Id := N + 331; - Name_User : constant Name_Id := N + 332; - Name_VAX_Float : constant Name_Id := N + 333; - Name_VMS : constant Name_Id := N + 334; - Name_Working_Storage : constant Name_Id := N + 335; + Name_No_Dependence : constant Name_Id := N + 299; + Name_No_Dynamic_Attachment : constant Name_Id := N + 300; + Name_No_Dynamic_Interrupts : constant Name_Id := N + 301; + Name_No_Requeue : constant Name_Id := N + 302; + Name_No_Requeue_Statements : constant Name_Id := N + 303; + Name_No_Task_Attributes : constant Name_Id := N + 304; + Name_No_Task_Attributes_Package : constant Name_Id := N + 305; + Name_On : constant Name_Id := N + 306; + Name_Parameter_Types : constant Name_Id := N + 307; + Name_Reference : constant Name_Id := N + 308; + Name_Restricted : constant Name_Id := N + 309; + Name_Result_Mechanism : constant Name_Id := N + 310; + Name_Result_Type : constant Name_Id := N + 311; + Name_Runtime : constant Name_Id := N + 312; + Name_SB : constant Name_Id := N + 313; + Name_Secondary_Stack_Size : constant Name_Id := N + 314; + Name_Section : constant Name_Id := N + 315; + Name_Semaphore : constant Name_Id := N + 316; + Name_Simple_Barriers : constant Name_Id := N + 317; + Name_Spec_File_Name : constant Name_Id := N + 318; + Name_Static : constant Name_Id := N + 319; + Name_Stack_Size : constant Name_Id := N + 320; + Name_Subunit_File_Name : constant Name_Id := N + 321; + Name_Task_Stack_Size_Default : constant Name_Id := N + 322; + Name_Task_Type : constant Name_Id := N + 323; + Name_Time_Slicing_Enabled : constant Name_Id := N + 324; + Name_Top_Guard : constant Name_Id := N + 325; + Name_UBA : constant Name_Id := N + 326; + Name_UBS : constant Name_Id := N + 327; + Name_UBSB : constant Name_Id := N + 328; + Name_Unit_Name : constant Name_Id := N + 329; + Name_Unknown : constant Name_Id := N + 330; + Name_Unrestricted : constant Name_Id := N + 331; + Name_Uppercase : constant Name_Id := N + 332; + Name_User : constant Name_Id := N + 333; + Name_VAX_Float : constant Name_Id := N + 334; + Name_VMS : constant Name_Id := N + 335; + Name_Working_Storage : constant Name_Id := N + 336; -- Names of recognized attributes. The entries with the comment "Ada 83" -- are attributes that are defined in Ada 83, but not in Ada 95. These @@ -609,159 +610,161 @@ package Snames is -- The entries marked VMS are recognized only in OpenVMS implementations -- of GNAT, and are treated as illegal in all other contexts. - First_Attribute_Name : constant Name_Id := N + 336; - Name_Abort_Signal : constant Name_Id := N + 336; -- GNAT - Name_Access : constant Name_Id := N + 337; - Name_Address : constant Name_Id := N + 338; - Name_Address_Size : constant Name_Id := N + 339; -- GNAT - Name_Aft : constant Name_Id := N + 340; - Name_Alignment : constant Name_Id := N + 341; - Name_Asm_Input : constant Name_Id := N + 342; -- GNAT - Name_Asm_Output : constant Name_Id := N + 343; -- GNAT - Name_AST_Entry : constant Name_Id := N + 344; -- VMS - Name_Bit : constant Name_Id := N + 345; -- GNAT - Name_Bit_Order : constant Name_Id := N + 346; - Name_Bit_Position : constant Name_Id := N + 347; -- GNAT - Name_Body_Version : constant Name_Id := N + 348; - Name_Callable : constant Name_Id := N + 349; - Name_Caller : constant Name_Id := N + 350; - Name_Code_Address : constant Name_Id := N + 351; -- GNAT - Name_Component_Size : constant Name_Id := N + 352; - Name_Compose : constant Name_Id := N + 353; - Name_Constrained : constant Name_Id := N + 354; - Name_Count : constant Name_Id := N + 355; - Name_Default_Bit_Order : constant Name_Id := N + 356; -- GNAT - Name_Definite : constant Name_Id := N + 357; - Name_Delta : constant Name_Id := N + 358; - Name_Denorm : constant Name_Id := N + 359; - Name_Digits : constant Name_Id := N + 360; - Name_Elaborated : constant Name_Id := N + 361; -- GNAT - Name_Emax : constant Name_Id := N + 362; -- Ada 83 - Name_Enum_Rep : constant Name_Id := N + 363; -- GNAT - Name_Epsilon : constant Name_Id := N + 364; -- Ada 83 - Name_Exponent : constant Name_Id := N + 365; - Name_External_Tag : constant Name_Id := N + 366; - Name_First : constant Name_Id := N + 367; - Name_First_Bit : constant Name_Id := N + 368; - Name_Fixed_Value : constant Name_Id := N + 369; -- GNAT - Name_Fore : constant Name_Id := N + 370; - Name_Has_Access_Values : constant Name_Id := N + 371; -- GNAT - Name_Has_Discriminants : constant Name_Id := N + 372; -- GNAT - Name_Identity : constant Name_Id := N + 373; - Name_Img : constant Name_Id := N + 374; -- GNAT - Name_Integer_Value : constant Name_Id := N + 375; -- GNAT - Name_Large : constant Name_Id := N + 376; -- Ada 83 - Name_Last : constant Name_Id := N + 377; - Name_Last_Bit : constant Name_Id := N + 378; - Name_Leading_Part : constant Name_Id := N + 379; - Name_Length : constant Name_Id := N + 380; - Name_Machine_Emax : constant Name_Id := N + 381; - Name_Machine_Emin : constant Name_Id := N + 382; - Name_Machine_Mantissa : constant Name_Id := N + 383; - Name_Machine_Overflows : constant Name_Id := N + 384; - Name_Machine_Radix : constant Name_Id := N + 385; - Name_Machine_Rounds : constant Name_Id := N + 386; - Name_Machine_Size : constant Name_Id := N + 387; -- GNAT - Name_Mantissa : constant Name_Id := N + 388; -- Ada 83 - Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 389; - Name_Maximum_Alignment : constant Name_Id := N + 390; -- GNAT - Name_Mechanism_Code : constant Name_Id := N + 391; -- GNAT - Name_Model_Emin : constant Name_Id := N + 392; - Name_Model_Epsilon : constant Name_Id := N + 393; - Name_Model_Mantissa : constant Name_Id := N + 394; - Name_Model_Small : constant Name_Id := N + 395; - Name_Modulus : constant Name_Id := N + 396; - Name_Null_Parameter : constant Name_Id := N + 397; -- GNAT - Name_Object_Size : constant Name_Id := N + 398; -- GNAT - Name_Partition_ID : constant Name_Id := N + 399; - Name_Passed_By_Reference : constant Name_Id := N + 400; -- GNAT - Name_Pool_Address : constant Name_Id := N + 401; - Name_Pos : constant Name_Id := N + 402; - Name_Position : constant Name_Id := N + 403; - Name_Range : constant Name_Id := N + 404; - Name_Range_Length : constant Name_Id := N + 405; -- GNAT - Name_Round : constant Name_Id := N + 406; - Name_Safe_Emax : constant Name_Id := N + 407; -- Ada 83 - Name_Safe_First : constant Name_Id := N + 408; - Name_Safe_Large : constant Name_Id := N + 409; -- Ada 83 - Name_Safe_Last : constant Name_Id := N + 410; - Name_Safe_Small : constant Name_Id := N + 411; -- Ada 83 - Name_Scale : constant Name_Id := N + 412; - Name_Scaling : constant Name_Id := N + 413; - Name_Signed_Zeros : constant Name_Id := N + 414; - Name_Size : constant Name_Id := N + 415; - Name_Small : constant Name_Id := N + 416; - Name_Storage_Size : constant Name_Id := N + 417; - Name_Storage_Unit : constant Name_Id := N + 418; -- GNAT - Name_Tag : constant Name_Id := N + 419; - Name_Target_Name : constant Name_Id := N + 420; -- GNAT - Name_Terminated : constant Name_Id := N + 421; - Name_To_Address : constant Name_Id := N + 422; -- GNAT - Name_Type_Class : constant Name_Id := N + 423; -- GNAT - Name_UET_Address : constant Name_Id := N + 424; -- GNAT - Name_Unbiased_Rounding : constant Name_Id := N + 425; - Name_Unchecked_Access : constant Name_Id := N + 426; - Name_Unconstrained_Array : constant Name_Id := N + 427; - Name_Universal_Literal_String : constant Name_Id := N + 428; -- GNAT - Name_Unrestricted_Access : constant Name_Id := N + 429; -- GNAT - Name_VADS_Size : constant Name_Id := N + 430; -- GNAT - Name_Val : constant Name_Id := N + 431; - Name_Valid : constant Name_Id := N + 432; - Name_Value_Size : constant Name_Id := N + 433; -- GNAT - Name_Version : constant Name_Id := N + 434; - Name_Wchar_T_Size : constant Name_Id := N + 435; -- GNAT - Name_Wide_Width : constant Name_Id := N + 436; - Name_Width : constant Name_Id := N + 437; - Name_Word_Size : constant Name_Id := N + 438; -- GNAT + First_Attribute_Name : constant Name_Id := N + 337; + Name_Abort_Signal : constant Name_Id := N + 337; -- GNAT + Name_Access : constant Name_Id := N + 338; + Name_Address : constant Name_Id := N + 339; + Name_Address_Size : constant Name_Id := N + 340; -- GNAT + Name_Aft : constant Name_Id := N + 341; + Name_Alignment : constant Name_Id := N + 342; + Name_Asm_Input : constant Name_Id := N + 343; -- GNAT + Name_Asm_Output : constant Name_Id := N + 344; -- GNAT + Name_AST_Entry : constant Name_Id := N + 345; -- VMS + Name_Bit : constant Name_Id := N + 346; -- GNAT + Name_Bit_Order : constant Name_Id := N + 347; + Name_Bit_Position : constant Name_Id := N + 348; -- GNAT + Name_Body_Version : constant Name_Id := N + 349; + Name_Callable : constant Name_Id := N + 350; + Name_Caller : constant Name_Id := N + 351; + Name_Code_Address : constant Name_Id := N + 352; -- GNAT + Name_Component_Size : constant Name_Id := N + 353; + Name_Compose : constant Name_Id := N + 354; + Name_Constrained : constant Name_Id := N + 355; + Name_Count : constant Name_Id := N + 356; + Name_Default_Bit_Order : constant Name_Id := N + 357; -- GNAT + Name_Definite : constant Name_Id := N + 358; + Name_Delta : constant Name_Id := N + 359; + Name_Denorm : constant Name_Id := N + 360; + Name_Digits : constant Name_Id := N + 361; + Name_Elaborated : constant Name_Id := N + 362; -- GNAT + Name_Emax : constant Name_Id := N + 363; -- Ada 83 + Name_Enum_Rep : constant Name_Id := N + 364; -- GNAT + Name_Epsilon : constant Name_Id := N + 365; -- Ada 83 + Name_Exponent : constant Name_Id := N + 366; + Name_External_Tag : constant Name_Id := N + 367; + Name_First : constant Name_Id := N + 368; + Name_First_Bit : constant Name_Id := N + 369; + Name_Fixed_Value : constant Name_Id := N + 370; -- GNAT + Name_Fore : constant Name_Id := N + 371; + Name_Has_Access_Values : constant Name_Id := N + 372; -- GNAT + Name_Has_Discriminants : constant Name_Id := N + 373; -- GNAT + Name_Identity : constant Name_Id := N + 374; + Name_Img : constant Name_Id := N + 375; -- GNAT + Name_Integer_Value : constant Name_Id := N + 376; -- GNAT + Name_Large : constant Name_Id := N + 377; -- Ada 83 + Name_Last : constant Name_Id := N + 378; + Name_Last_Bit : constant Name_Id := N + 379; + Name_Leading_Part : constant Name_Id := N + 380; + Name_Length : constant Name_Id := N + 381; + Name_Machine_Emax : constant Name_Id := N + 382; + Name_Machine_Emin : constant Name_Id := N + 383; + Name_Machine_Mantissa : constant Name_Id := N + 384; + Name_Machine_Overflows : constant Name_Id := N + 385; + Name_Machine_Radix : constant Name_Id := N + 386; + Name_Machine_Rounds : constant Name_Id := N + 387; + Name_Machine_Size : constant Name_Id := N + 388; -- GNAT + Name_Mantissa : constant Name_Id := N + 389; -- Ada 83 + Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 390; + Name_Maximum_Alignment : constant Name_Id := N + 391; -- GNAT + Name_Mechanism_Code : constant Name_Id := N + 392; -- GNAT + Name_Mod : constant Name_Id := N + 393; + Name_Model_Emin : constant Name_Id := N + 394; + Name_Model_Epsilon : constant Name_Id := N + 395; + Name_Model_Mantissa : constant Name_Id := N + 396; + Name_Model_Small : constant Name_Id := N + 397; + Name_Modulus : constant Name_Id := N + 398; + Name_Null_Parameter : constant Name_Id := N + 399; -- GNAT + Name_Object_Size : constant Name_Id := N + 400; -- GNAT + Name_Partition_ID : constant Name_Id := N + 401; + Name_Passed_By_Reference : constant Name_Id := N + 402; -- GNAT + Name_Pool_Address : constant Name_Id := N + 403; + Name_Pos : constant Name_Id := N + 404; + Name_Position : constant Name_Id := N + 405; + Name_Range : constant Name_Id := N + 406; + Name_Range_Length : constant Name_Id := N + 407; -- GNAT + Name_Round : constant Name_Id := N + 408; + Name_Safe_Emax : constant Name_Id := N + 409; -- Ada 83 + Name_Safe_First : constant Name_Id := N + 410; + Name_Safe_Large : constant Name_Id := N + 411; -- Ada 83 + Name_Safe_Last : constant Name_Id := N + 412; + Name_Safe_Small : constant Name_Id := N + 413; -- Ada 83 + Name_Scale : constant Name_Id := N + 414; + Name_Scaling : constant Name_Id := N + 415; + Name_Signed_Zeros : constant Name_Id := N + 416; + Name_Size : constant Name_Id := N + 417; + Name_Small : constant Name_Id := N + 418; + Name_Storage_Size : constant Name_Id := N + 419; + Name_Storage_Unit : constant Name_Id := N + 420; -- GNAT + Name_Tag : constant Name_Id := N + 421; + Name_Target_Name : constant Name_Id := N + 422; -- GNAT + Name_Terminated : constant Name_Id := N + 423; + Name_To_Address : constant Name_Id := N + 424; -- GNAT + Name_Type_Class : constant Name_Id := N + 425; -- GNAT + Name_UET_Address : constant Name_Id := N + 426; -- GNAT + Name_Unbiased_Rounding : constant Name_Id := N + 427; + Name_Unchecked_Access : constant Name_Id := N + 428; + Name_Unconstrained_Array : constant Name_Id := N + 429; + Name_Universal_Literal_String : constant Name_Id := N + 430; -- GNAT + Name_Unrestricted_Access : constant Name_Id := N + 431; -- GNAT + Name_VADS_Size : constant Name_Id := N + 432; -- GNAT + Name_Val : constant Name_Id := N + 433; + Name_Valid : constant Name_Id := N + 434; + Name_Value_Size : constant Name_Id := N + 435; -- GNAT + Name_Version : constant Name_Id := N + 436; + Name_Wchar_T_Size : constant Name_Id := N + 437; -- GNAT + Name_Wide_Width : constant Name_Id := N + 438; + Name_Width : constant Name_Id := N + 439; + Name_Word_Size : constant Name_Id := N + 440; -- GNAT -- Attributes that designate attributes returning renamable functions, - -- i.e. functions that return other than a universal value. - - First_Renamable_Function_Attribute : constant Name_Id := N + 439; - Name_Adjacent : constant Name_Id := N + 439; - Name_Ceiling : constant Name_Id := N + 440; - Name_Copy_Sign : constant Name_Id := N + 441; - Name_Floor : constant Name_Id := N + 442; - Name_Fraction : constant Name_Id := N + 443; - Name_Image : constant Name_Id := N + 444; - Name_Input : constant Name_Id := N + 445; - Name_Machine : constant Name_Id := N + 446; - Name_Max : constant Name_Id := N + 447; - Name_Min : constant Name_Id := N + 448; - Name_Model : constant Name_Id := N + 449; - Name_Pred : constant Name_Id := N + 450; - Name_Remainder : constant Name_Id := N + 451; - Name_Rounding : constant Name_Id := N + 452; - Name_Succ : constant Name_Id := N + 453; - Name_Truncation : constant Name_Id := N + 454; - Name_Value : constant Name_Id := N + 455; - Name_Wide_Image : constant Name_Id := N + 456; - Name_Wide_Value : constant Name_Id := N + 457; - Last_Renamable_Function_Attribute : constant Name_Id := N + 457; + -- i.e. functions that return other than a universal value and that + -- have non-universal arguments. + + First_Renamable_Function_Attribute : constant Name_Id := N + 441; + Name_Adjacent : constant Name_Id := N + 441; + Name_Ceiling : constant Name_Id := N + 442; + Name_Copy_Sign : constant Name_Id := N + 443; + Name_Floor : constant Name_Id := N + 444; + Name_Fraction : constant Name_Id := N + 445; + Name_Image : constant Name_Id := N + 446; + Name_Input : constant Name_Id := N + 447; + Name_Machine : constant Name_Id := N + 448; + Name_Max : constant Name_Id := N + 449; + Name_Min : constant Name_Id := N + 450; + Name_Model : constant Name_Id := N + 451; + Name_Pred : constant Name_Id := N + 452; + Name_Remainder : constant Name_Id := N + 453; + Name_Rounding : constant Name_Id := N + 454; + Name_Succ : constant Name_Id := N + 455; + Name_Truncation : constant Name_Id := N + 456; + Name_Value : constant Name_Id := N + 457; + Name_Wide_Image : constant Name_Id := N + 458; + Name_Wide_Value : constant Name_Id := N + 459; + Last_Renamable_Function_Attribute : constant Name_Id := N + 459; -- Attributes that designate procedures - First_Procedure_Attribute : constant Name_Id := N + 458; - Name_Output : constant Name_Id := N + 458; - Name_Read : constant Name_Id := N + 459; - Name_Write : constant Name_Id := N + 460; - Last_Procedure_Attribute : constant Name_Id := N + 460; + First_Procedure_Attribute : constant Name_Id := N + 460; + Name_Output : constant Name_Id := N + 460; + Name_Read : constant Name_Id := N + 461; + Name_Write : constant Name_Id := N + 462; + Last_Procedure_Attribute : constant Name_Id := N + 462; -- Remaining attributes are ones that return entities - First_Entity_Attribute_Name : constant Name_Id := N + 461; - Name_Elab_Body : constant Name_Id := N + 461; -- GNAT - Name_Elab_Spec : constant Name_Id := N + 462; -- GNAT - Name_Storage_Pool : constant Name_Id := N + 463; + First_Entity_Attribute_Name : constant Name_Id := N + 463; + Name_Elab_Body : constant Name_Id := N + 463; -- GNAT + Name_Elab_Spec : constant Name_Id := N + 464; -- GNAT + Name_Storage_Pool : constant Name_Id := N + 465; -- These attributes are the ones that return types - First_Type_Attribute_Name : constant Name_Id := N + 464; - Name_Base : constant Name_Id := N + 464; - Name_Class : constant Name_Id := N + 465; - Last_Type_Attribute_Name : constant Name_Id := N + 465; - Last_Entity_Attribute_Name : constant Name_Id := N + 465; - Last_Attribute_Name : constant Name_Id := N + 465; + First_Type_Attribute_Name : constant Name_Id := N + 466; + Name_Base : constant Name_Id := N + 466; + Name_Class : constant Name_Id := N + 467; + Last_Type_Attribute_Name : constant Name_Id := N + 467; + Last_Entity_Attribute_Name : constant Name_Id := N + 467; + Last_Attribute_Name : constant Name_Id := N + 467; -- Names of recognized locking policy identifiers @@ -769,10 +772,10 @@ package Snames is -- name (e.g. C for Ceiling_Locking). If new policy names are added, -- the first character must be distinct. - First_Locking_Policy_Name : constant Name_Id := N + 466; - Name_Ceiling_Locking : constant Name_Id := N + 466; - Name_Inheritance_Locking : constant Name_Id := N + 467; - Last_Locking_Policy_Name : constant Name_Id := N + 467; + First_Locking_Policy_Name : constant Name_Id := N + 468; + Name_Ceiling_Locking : constant Name_Id := N + 468; + Name_Inheritance_Locking : constant Name_Id := N + 469; + Last_Locking_Policy_Name : constant Name_Id := N + 469; -- Names of recognized queuing policy identifiers. @@ -780,10 +783,10 @@ package Snames is -- name (e.g. F for FIFO_Queuing). If new policy names are added, -- the first character must be distinct. - First_Queuing_Policy_Name : constant Name_Id := N + 468; - Name_FIFO_Queuing : constant Name_Id := N + 468; - Name_Priority_Queuing : constant Name_Id := N + 469; - Last_Queuing_Policy_Name : constant Name_Id := N + 469; + First_Queuing_Policy_Name : constant Name_Id := N + 470; + Name_FIFO_Queuing : constant Name_Id := N + 470; + Name_Priority_Queuing : constant Name_Id := N + 471; + Last_Queuing_Policy_Name : constant Name_Id := N + 471; -- Names of recognized task dispatching policy identifiers @@ -791,205 +794,204 @@ package Snames is -- name (e.g. F for FIFO_WIthinn_Priorities). If new policy names -- are added, the first character must be distinct. - First_Task_Dispatching_Policy_Name : constant Name_Id := N + 470; - Name_FIFO_Within_Priorities : constant Name_Id := N + 470; - Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 470; + First_Task_Dispatching_Policy_Name : constant Name_Id := N + 472; + Name_FIFO_Within_Priorities : constant Name_Id := N + 472; + Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 472; -- Names of recognized checks for pragma Suppress - First_Check_Name : constant Name_Id := N + 471; - Name_Access_Check : constant Name_Id := N + 471; - Name_Accessibility_Check : constant Name_Id := N + 472; - Name_Discriminant_Check : constant Name_Id := N + 473; - Name_Division_Check : constant Name_Id := N + 474; - Name_Elaboration_Check : constant Name_Id := N + 475; - Name_Index_Check : constant Name_Id := N + 476; - Name_Length_Check : constant Name_Id := N + 477; - Name_Overflow_Check : constant Name_Id := N + 478; - Name_Range_Check : constant Name_Id := N + 479; - Name_Storage_Check : constant Name_Id := N + 480; - Name_Tag_Check : constant Name_Id := N + 481; - Name_All_Checks : constant Name_Id := N + 482; - Last_Check_Name : constant Name_Id := N + 482; + First_Check_Name : constant Name_Id := N + 473; + Name_Access_Check : constant Name_Id := N + 473; + Name_Accessibility_Check : constant Name_Id := N + 474; + Name_Discriminant_Check : constant Name_Id := N + 475; + Name_Division_Check : constant Name_Id := N + 476; + Name_Elaboration_Check : constant Name_Id := N + 477; + Name_Index_Check : constant Name_Id := N + 478; + Name_Length_Check : constant Name_Id := N + 479; + Name_Overflow_Check : constant Name_Id := N + 480; + Name_Range_Check : constant Name_Id := N + 481; + Name_Storage_Check : constant Name_Id := N + 482; + Name_Tag_Check : constant Name_Id := N + 483; + Name_All_Checks : constant Name_Id := N + 484; + Last_Check_Name : constant Name_Id := N + 484; -- Names corresponding to reserved keywords, excluding those already - -- declared in the attribute list (Access, Delta, Digits, Range). - - Name_Abort : constant Name_Id := N + 483; - Name_Abs : constant Name_Id := N + 484; - Name_Accept : constant Name_Id := N + 485; - Name_And : constant Name_Id := N + 486; - Name_All : constant Name_Id := N + 487; - Name_Array : constant Name_Id := N + 488; - Name_At : constant Name_Id := N + 489; - Name_Begin : constant Name_Id := N + 490; - Name_Body : constant Name_Id := N + 491; - Name_Case : constant Name_Id := N + 492; - Name_Constant : constant Name_Id := N + 493; - Name_Declare : constant Name_Id := N + 494; - Name_Delay : constant Name_Id := N + 495; - Name_Do : constant Name_Id := N + 496; - Name_Else : constant Name_Id := N + 497; - Name_Elsif : constant Name_Id := N + 498; - Name_End : constant Name_Id := N + 499; - Name_Entry : constant Name_Id := N + 500; - Name_Exception : constant Name_Id := N + 501; - Name_Exit : constant Name_Id := N + 502; - Name_For : constant Name_Id := N + 503; - Name_Function : constant Name_Id := N + 504; - Name_Generic : constant Name_Id := N + 505; - Name_Goto : constant Name_Id := N + 506; - Name_If : constant Name_Id := N + 507; - Name_In : constant Name_Id := N + 508; - Name_Is : constant Name_Id := N + 509; - Name_Limited : constant Name_Id := N + 510; - Name_Loop : constant Name_Id := N + 511; - Name_Mod : constant Name_Id := N + 512; - Name_New : constant Name_Id := N + 513; - Name_Not : constant Name_Id := N + 514; - Name_Null : constant Name_Id := N + 515; - Name_Of : constant Name_Id := N + 516; - Name_Or : constant Name_Id := N + 517; - Name_Others : constant Name_Id := N + 518; - Name_Out : constant Name_Id := N + 519; - Name_Package : constant Name_Id := N + 520; - Name_Pragma : constant Name_Id := N + 521; - Name_Private : constant Name_Id := N + 522; - Name_Procedure : constant Name_Id := N + 523; - Name_Raise : constant Name_Id := N + 524; - Name_Record : constant Name_Id := N + 525; - Name_Rem : constant Name_Id := N + 526; - Name_Renames : constant Name_Id := N + 527; - Name_Return : constant Name_Id := N + 528; - Name_Reverse : constant Name_Id := N + 529; - Name_Select : constant Name_Id := N + 530; - Name_Separate : constant Name_Id := N + 531; - Name_Subtype : constant Name_Id := N + 532; - Name_Task : constant Name_Id := N + 533; - Name_Terminate : constant Name_Id := N + 534; - Name_Then : constant Name_Id := N + 535; - Name_Type : constant Name_Id := N + 536; - Name_Use : constant Name_Id := N + 537; - Name_When : constant Name_Id := N + 538; - Name_While : constant Name_Id := N + 539; - Name_With : constant Name_Id := N + 540; - Name_Xor : constant Name_Id := N + 541; + -- declared in the attribute list (Access, Delta, Digits, Mod, Range). + + Name_Abort : constant Name_Id := N + 485; + Name_Abs : constant Name_Id := N + 486; + Name_Accept : constant Name_Id := N + 487; + Name_And : constant Name_Id := N + 488; + Name_All : constant Name_Id := N + 489; + Name_Array : constant Name_Id := N + 490; + Name_At : constant Name_Id := N + 491; + Name_Begin : constant Name_Id := N + 492; + Name_Body : constant Name_Id := N + 493; + Name_Case : constant Name_Id := N + 494; + Name_Constant : constant Name_Id := N + 495; + Name_Declare : constant Name_Id := N + 496; + Name_Delay : constant Name_Id := N + 497; + Name_Do : constant Name_Id := N + 498; + Name_Else : constant Name_Id := N + 499; + Name_Elsif : constant Name_Id := N + 500; + Name_End : constant Name_Id := N + 501; + Name_Entry : constant Name_Id := N + 502; + Name_Exception : constant Name_Id := N + 503; + Name_Exit : constant Name_Id := N + 504; + Name_For : constant Name_Id := N + 505; + Name_Function : constant Name_Id := N + 506; + Name_Generic : constant Name_Id := N + 507; + Name_Goto : constant Name_Id := N + 508; + Name_If : constant Name_Id := N + 509; + Name_In : constant Name_Id := N + 510; + Name_Is : constant Name_Id := N + 511; + Name_Limited : constant Name_Id := N + 512; + Name_Loop : constant Name_Id := N + 513; + Name_New : constant Name_Id := N + 514; + Name_Not : constant Name_Id := N + 515; + Name_Null : constant Name_Id := N + 516; + Name_Of : constant Name_Id := N + 517; + Name_Or : constant Name_Id := N + 518; + Name_Others : constant Name_Id := N + 519; + Name_Out : constant Name_Id := N + 520; + Name_Package : constant Name_Id := N + 521; + Name_Pragma : constant Name_Id := N + 522; + Name_Private : constant Name_Id := N + 523; + Name_Procedure : constant Name_Id := N + 524; + Name_Raise : constant Name_Id := N + 525; + Name_Record : constant Name_Id := N + 526; + Name_Rem : constant Name_Id := N + 527; + Name_Renames : constant Name_Id := N + 528; + Name_Return : constant Name_Id := N + 529; + Name_Reverse : constant Name_Id := N + 530; + Name_Select : constant Name_Id := N + 531; + Name_Separate : constant Name_Id := N + 532; + Name_Subtype : constant Name_Id := N + 533; + Name_Task : constant Name_Id := N + 534; + Name_Terminate : constant Name_Id := N + 535; + Name_Then : constant Name_Id := N + 536; + Name_Type : constant Name_Id := N + 537; + Name_Use : constant Name_Id := N + 538; + Name_When : constant Name_Id := N + 539; + Name_While : constant Name_Id := N + 540; + Name_With : constant Name_Id := N + 541; + Name_Xor : constant Name_Id := N + 542; -- Names of intrinsic subprograms -- Note: Asm is missing from this list, since Asm is a legitimate -- convention name. So is To_Adress, which is a GNAT attribute. - First_Intrinsic_Name : constant Name_Id := N + 542; - Name_Divide : constant Name_Id := N + 542; - Name_Enclosing_Entity : constant Name_Id := N + 543; - Name_Exception_Information : constant Name_Id := N + 544; - Name_Exception_Message : constant Name_Id := N + 545; - Name_Exception_Name : constant Name_Id := N + 546; - Name_File : constant Name_Id := N + 547; - Name_Import_Address : constant Name_Id := N + 548; - Name_Import_Largest_Value : constant Name_Id := N + 549; - Name_Import_Value : constant Name_Id := N + 550; - Name_Is_Negative : constant Name_Id := N + 551; - Name_Line : constant Name_Id := N + 552; - Name_Rotate_Left : constant Name_Id := N + 553; - Name_Rotate_Right : constant Name_Id := N + 554; - Name_Shift_Left : constant Name_Id := N + 555; - Name_Shift_Right : constant Name_Id := N + 556; - Name_Shift_Right_Arithmetic : constant Name_Id := N + 557; - Name_Source_Location : constant Name_Id := N + 558; - Name_Unchecked_Conversion : constant Name_Id := N + 559; - Name_Unchecked_Deallocation : constant Name_Id := N + 560; - Name_To_Pointer : constant Name_Id := N + 561; - Last_Intrinsic_Name : constant Name_Id := N + 561; + First_Intrinsic_Name : constant Name_Id := N + 543; + Name_Divide : constant Name_Id := N + 543; + Name_Enclosing_Entity : constant Name_Id := N + 544; + Name_Exception_Information : constant Name_Id := N + 545; + Name_Exception_Message : constant Name_Id := N + 546; + Name_Exception_Name : constant Name_Id := N + 547; + Name_File : constant Name_Id := N + 548; + Name_Import_Address : constant Name_Id := N + 549; + Name_Import_Largest_Value : constant Name_Id := N + 550; + Name_Import_Value : constant Name_Id := N + 551; + Name_Is_Negative : constant Name_Id := N + 552; + Name_Line : constant Name_Id := N + 553; + Name_Rotate_Left : constant Name_Id := N + 554; + Name_Rotate_Right : constant Name_Id := N + 555; + Name_Shift_Left : constant Name_Id := N + 556; + Name_Shift_Right : constant Name_Id := N + 557; + Name_Shift_Right_Arithmetic : constant Name_Id := N + 558; + Name_Source_Location : constant Name_Id := N + 559; + Name_Unchecked_Conversion : constant Name_Id := N + 560; + Name_Unchecked_Deallocation : constant Name_Id := N + 561; + Name_To_Pointer : constant Name_Id := N + 562; + Last_Intrinsic_Name : constant Name_Id := N + 562; -- Reserved words used only in Ada 95 - First_95_Reserved_Word : constant Name_Id := N + 562; - Name_Abstract : constant Name_Id := N + 562; - Name_Aliased : constant Name_Id := N + 563; - Name_Protected : constant Name_Id := N + 564; - Name_Until : constant Name_Id := N + 565; - Name_Requeue : constant Name_Id := N + 566; - Name_Tagged : constant Name_Id := N + 567; - Last_95_Reserved_Word : constant Name_Id := N + 567; + First_95_Reserved_Word : constant Name_Id := N + 563; + Name_Abstract : constant Name_Id := N + 563; + Name_Aliased : constant Name_Id := N + 564; + Name_Protected : constant Name_Id := N + 565; + Name_Until : constant Name_Id := N + 566; + Name_Requeue : constant Name_Id := N + 567; + Name_Tagged : constant Name_Id := N + 568; + Last_95_Reserved_Word : constant Name_Id := N + 568; subtype Ada_95_Reserved_Words is Name_Id range First_95_Reserved_Word .. Last_95_Reserved_Word; -- Miscellaneous names used in semantic checking - Name_Raise_Exception : constant Name_Id := N + 568; + Name_Raise_Exception : constant Name_Id := N + 569; -- Additional reserved words and identifiers used in GNAT Project Files -- Note that Name_External is already previously declared - Name_Ada_Roots : constant Name_Id := N + 569; - Name_Binder : constant Name_Id := N + 570; - Name_Binder_Driver : constant Name_Id := N + 571; - Name_Body_Suffix : constant Name_Id := N + 572; - Name_Builder : constant Name_Id := N + 573; - Name_Compiler : constant Name_Id := N + 574; - Name_Compiler_Driver : constant Name_Id := N + 575; - Name_Compiler_Kind : constant Name_Id := N + 576; - Name_Compute_Dependency : constant Name_Id := N + 577; - Name_Cross_Reference : constant Name_Id := N + 578; - Name_Default_Linker : constant Name_Id := N + 579; - Name_Default_Switches : constant Name_Id := N + 580; - Name_Dependency_Option : constant Name_Id := N + 581; - Name_Exec_Dir : constant Name_Id := N + 582; - Name_Executable : constant Name_Id := N + 583; - Name_Executable_Suffix : constant Name_Id := N + 584; - Name_Extends : constant Name_Id := N + 585; - Name_Externally_Built : constant Name_Id := N + 586; - Name_Finder : constant Name_Id := N + 587; - Name_Global_Configuration_Pragmas : constant Name_Id := N + 588; - Name_Gnatls : constant Name_Id := N + 589; - Name_Gnatstub : constant Name_Id := N + 590; - Name_Implementation : constant Name_Id := N + 591; - Name_Implementation_Exceptions : constant Name_Id := N + 592; - Name_Implementation_Suffix : constant Name_Id := N + 593; - Name_Include_Option : constant Name_Id := N + 594; - Name_Language_Processing : constant Name_Id := N + 595; - Name_Languages : constant Name_Id := N + 596; - Name_Library_Dir : constant Name_Id := N + 597; - Name_Library_Auto_Init : constant Name_Id := N + 598; - Name_Library_GCC : constant Name_Id := N + 599; - Name_Library_Interface : constant Name_Id := N + 600; - Name_Library_Kind : constant Name_Id := N + 601; - Name_Library_Name : constant Name_Id := N + 602; - Name_Library_Options : constant Name_Id := N + 603; - Name_Library_Reference_Symbol_File : constant Name_Id := N + 604; - Name_Library_Src_Dir : constant Name_Id := N + 605; - Name_Library_Symbol_File : constant Name_Id := N + 606; - Name_Library_Symbol_Policy : constant Name_Id := N + 607; - Name_Library_Version : constant Name_Id := N + 608; - Name_Linker : constant Name_Id := N + 609; - Name_Local_Configuration_Pragmas : constant Name_Id := N + 610; - Name_Locally_Removed_Files : constant Name_Id := N + 611; - Name_Metrics : constant Name_Id := N + 612; - Name_Naming : constant Name_Id := N + 613; - Name_Object_Dir : constant Name_Id := N + 614; - Name_Pretty_Printer : constant Name_Id := N + 615; - Name_Project : constant Name_Id := N + 616; - Name_Separate_Suffix : constant Name_Id := N + 617; - Name_Source_Dirs : constant Name_Id := N + 618; - Name_Source_Files : constant Name_Id := N + 619; - Name_Source_List_File : constant Name_Id := N + 620; - Name_Spec : constant Name_Id := N + 621; - Name_Spec_Suffix : constant Name_Id := N + 622; - Name_Specification : constant Name_Id := N + 623; - Name_Specification_Exceptions : constant Name_Id := N + 624; - Name_Specification_Suffix : constant Name_Id := N + 625; - Name_Switches : constant Name_Id := N + 626; + Name_Ada_Roots : constant Name_Id := N + 570; + Name_Binder : constant Name_Id := N + 571; + Name_Binder_Driver : constant Name_Id := N + 572; + Name_Body_Suffix : constant Name_Id := N + 573; + Name_Builder : constant Name_Id := N + 574; + Name_Compiler : constant Name_Id := N + 575; + Name_Compiler_Driver : constant Name_Id := N + 576; + Name_Compiler_Kind : constant Name_Id := N + 577; + Name_Compute_Dependency : constant Name_Id := N + 578; + Name_Cross_Reference : constant Name_Id := N + 579; + Name_Default_Linker : constant Name_Id := N + 580; + Name_Default_Switches : constant Name_Id := N + 581; + Name_Dependency_Option : constant Name_Id := N + 582; + Name_Exec_Dir : constant Name_Id := N + 583; + Name_Executable : constant Name_Id := N + 584; + Name_Executable_Suffix : constant Name_Id := N + 585; + Name_Extends : constant Name_Id := N + 586; + Name_Externally_Built : constant Name_Id := N + 587; + Name_Finder : constant Name_Id := N + 588; + Name_Global_Configuration_Pragmas : constant Name_Id := N + 589; + Name_Gnatls : constant Name_Id := N + 590; + Name_Gnatstub : constant Name_Id := N + 591; + Name_Implementation : constant Name_Id := N + 592; + Name_Implementation_Exceptions : constant Name_Id := N + 593; + Name_Implementation_Suffix : constant Name_Id := N + 594; + Name_Include_Option : constant Name_Id := N + 595; + Name_Language_Processing : constant Name_Id := N + 596; + Name_Languages : constant Name_Id := N + 597; + Name_Library_Dir : constant Name_Id := N + 598; + Name_Library_Auto_Init : constant Name_Id := N + 599; + Name_Library_GCC : constant Name_Id := N + 600; + Name_Library_Interface : constant Name_Id := N + 601; + Name_Library_Kind : constant Name_Id := N + 602; + Name_Library_Name : constant Name_Id := N + 603; + Name_Library_Options : constant Name_Id := N + 604; + Name_Library_Reference_Symbol_File : constant Name_Id := N + 605; + Name_Library_Src_Dir : constant Name_Id := N + 606; + Name_Library_Symbol_File : constant Name_Id := N + 607; + Name_Library_Symbol_Policy : constant Name_Id := N + 608; + Name_Library_Version : constant Name_Id := N + 609; + Name_Linker : constant Name_Id := N + 610; + Name_Local_Configuration_Pragmas : constant Name_Id := N + 611; + Name_Locally_Removed_Files : constant Name_Id := N + 612; + Name_Metrics : constant Name_Id := N + 613; + Name_Naming : constant Name_Id := N + 614; + Name_Object_Dir : constant Name_Id := N + 615; + Name_Pretty_Printer : constant Name_Id := N + 616; + Name_Project : constant Name_Id := N + 617; + Name_Separate_Suffix : constant Name_Id := N + 618; + Name_Source_Dirs : constant Name_Id := N + 619; + Name_Source_Files : constant Name_Id := N + 620; + Name_Source_List_File : constant Name_Id := N + 621; + Name_Spec : constant Name_Id := N + 622; + Name_Spec_Suffix : constant Name_Id := N + 623; + Name_Specification : constant Name_Id := N + 624; + Name_Specification_Exceptions : constant Name_Id := N + 625; + Name_Specification_Suffix : constant Name_Id := N + 626; + Name_Switches : constant Name_Id := N + 627; -- Other miscellaneous names used in front end - Name_Unaligned_Valid : constant Name_Id := N + 627; + Name_Unaligned_Valid : constant Name_Id := N + 628; -- Mark last defined name for consistency check in Snames body - Last_Predefined_Name : constant Name_Id := N + 627; + Last_Predefined_Name : constant Name_Id := N + 628; subtype Any_Operator_Name is Name_Id range First_Operator_Name .. Last_Operator_Name; @@ -1055,6 +1057,7 @@ package Snames is Attribute_Max_Size_In_Storage_Elements, Attribute_Maximum_Alignment, Attribute_Mechanism_Code, + Attribute_Mod, Attribute_Model_Emin, Attribute_Model_Epsilon, Attribute_Model_Mantissa, diff --git a/gcc/ada/snames.h b/gcc/ada/snames.h index 08a9b887f17..18cb4edc31a 100644 --- a/gcc/ada/snames.h +++ b/gcc/ada/snames.h @@ -101,84 +101,85 @@ extern unsigned char Get_Attribute_Id (int); #define Attr_Max_Size_In_Storage_Elements 53 #define Attr_Maximum_Alignment 54 #define Attr_Mechanism_Code 55 -#define Attr_Model_Emin 56 -#define Attr_Model_Epsilon 57 -#define Attr_Model_Mantissa 58 -#define Attr_Model_Small 59 -#define Attr_Modulus 60 -#define Attr_Null_Parameter 61 -#define Attr_Object_Size 62 -#define Attr_Partition_ID 63 -#define Attr_Passed_By_Reference 64 -#define Attr_Pool_Address 65 -#define Attr_Pos 66 -#define Attr_Position 67 -#define Attr_Range 68 -#define Attr_Range_Length 69 -#define Attr_Round 70 -#define Attr_Safe_Emax 71 -#define Attr_Safe_First 72 -#define Attr_Safe_Large 73 -#define Attr_Safe_Last 74 -#define Attr_Safe_Small 75 -#define Attr_Scale 76 -#define Attr_Scaling 77 -#define Attr_Signed_Zeros 78 -#define Attr_Size 79 -#define Attr_Small 80 -#define Attr_Storage_Size 81 -#define Attr_Storage_Unit 82 -#define Attr_Tag 83 -#define Attr_Target_Name 84 -#define Attr_Terminated 85 -#define Attr_To_Address 86 -#define Attr_Type_Class 87 -#define Attr_UET_Address 88 -#define Attr_Unbiased_Rounding 89 -#define Attr_Unchecked_Access 90 -#define Attr_Unconstrained_Array 91 -#define Attr_Universal_Literal_String 92 -#define Attr_Unrestricted_Access 93 -#define Attr_VADS_Size 94 -#define Attr_Val 95 -#define Attr_Valid 96 -#define Attr_Value_Size 97 -#define Attr_Version 98 -#define Attr_Wide_Character_Size 99 -#define Attr_Wide_Width 100 -#define Attr_Width 101 -#define Attr_Word_Size 102 +#define Attr_Mod 56 +#define Attr_Model_Emin 57 +#define Attr_Model_Epsilon 58 +#define Attr_Model_Mantissa 59 +#define Attr_Model_Small 60 +#define Attr_Modulus 61 +#define Attr_Null_Parameter 62 +#define Attr_Object_Size 63 +#define Attr_Partition_ID 64 +#define Attr_Passed_By_Reference 65 +#define Attr_Pool_Address 66 +#define Attr_Pos 67 +#define Attr_Position 68 +#define Attr_Range 69 +#define Attr_Range_Length 70 +#define Attr_Round 71 +#define Attr_Safe_Emax 72 +#define Attr_Safe_First 73 +#define Attr_Safe_Large 74 +#define Attr_Safe_Last 75 +#define Attr_Safe_Small 76 +#define Attr_Scale 77 +#define Attr_Scaling 78 +#define Attr_Signed_Zeros 79 +#define Attr_Size 80 +#define Attr_Small 81 +#define Attr_Storage_Size 82 +#define Attr_Storage_Unit 83 +#define Attr_Tag 84 +#define Attr_Target_Name 85 +#define Attr_Terminated 86 +#define Attr_To_Address 87 +#define Attr_Type_Class 88 +#define Attr_UET_Address 89 +#define Attr_Unbiased_Rounding 90 +#define Attr_Unchecked_Access 91 +#define Attr_Unconstrained_Array 92 +#define Attr_Universal_Literal_String 93 +#define Attr_Unrestricted_Access 94 +#define Attr_VADS_Size 95 +#define Attr_Val 96 +#define Attr_Valid 97 +#define Attr_Value_Size 98 +#define Attr_Version 99 +#define Attr_Wide_Character_Size 100 +#define Attr_Wide_Width 101 +#define Attr_Width 102 +#define Attr_Word_Size 103 -#define Attr_Adjacent 103 -#define Attr_Ceiling 104 -#define Attr_Copy_Sign 105 -#define Attr_Floor 106 -#define Attr_Fraction 107 -#define Attr_Image 108 -#define Attr_Input 109 -#define Attr_Machine 110 -#define Attr_Max 111 -#define Attr_Min 112 -#define Attr_Model 113 -#define Attr_Pred 114 -#define Attr_Remainder 115 -#define Attr_Rounding 116 -#define Attr_Succ 117 -#define Attr_Truncation 118 -#define Attr_Value 119 -#define Attr_Wide_Image 120 -#define Attr_Wide_Value 121 +#define Attr_Adjacent 104 +#define Attr_Ceiling 105 +#define Attr_Copy_Sign 106 +#define Attr_Floor 107 +#define Attr_Fraction 108 +#define Attr_Image 109 +#define Attr_Input 110 +#define Attr_Machine 111 +#define Attr_Max 112 +#define Attr_Min 113 +#define Attr_Model 114 +#define Attr_Pred 115 +#define Attr_Remainder 116 +#define Attr_Rounding 117 +#define Attr_Succ 118 +#define Attr_Truncation 119 +#define Attr_Value 120 +#define Attr_Wide_Image 121 +#define Attr_Wide_Value 122 -#define Attr_Output 122 -#define Attr_Read 123 -#define Attr_Write 124 +#define Attr_Output 123 +#define Attr_Read 124 +#define Attr_Write 125 -#define Attr_Elab_Body 125 -#define Attr_Elab_Spec 126 -#define Attr_Storage_Pool 127 +#define Attr_Elab_Body 126 +#define Attr_Elab_Spec 127 +#define Attr_Storage_Pool 128 -#define Attr_Base 128 -#define Attr_Class 129 +#define Attr_Base 129 +#define Attr_Class 130 /* Define the function to check if a Name_Id value is a valid pragma */ |