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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

From-SVN: r92829

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;
 

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;

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 --
    ---------------

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

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;

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 --
    ---------------------------------------------------

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 --
       -----------

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 --
    ---------------

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;

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 --
    --  ------------------------

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

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;

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                   |

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 --
    ---------------

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;

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 --
    ----------------------------------

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

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;
 

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;

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

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 --
    ------------------------------

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

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;

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

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);

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;
 
    -------------------

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;
 

gcc/ada/sem_ch13.adb

 ------------------------------------------------------------------------------
---                                                                          --
+--                   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);

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 " &

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;
 

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#" &

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 */