tbuild.ads, [...] (N_Pragma): Chars field removed, use Chars (Pragma_Identifier (..

2008-03-26  Robert Dewar  <dewar@adacore.com>

	* tbuild.ads, tbuild.adb, trans.c, sprint.adb, exp_prag.adb, decl.c,
	par-ch2.adb, sem_elab.adb, sem_util.ads (N_Pragma): Chars field
	removed, use Chars (Pragma_Identifier (..  instead, adjustments
	throughout to accomodate this change.

	* s-pooglo.ads, s-pooloc.ads: Minor comment updates

	* exp_dbug.adb: Use Sem_Util.Set_Debug_Info_Needed (not
	Einfo.Set_Needs_Debug_Info)

From-SVN: r133587

gcc/ada/decl.c

@@ -5035,7 +5035,7 @@ prepend_attributes (Entity_Id gnat_entity, struct attrib ** attr_list)
 						  (First (gnat_assoc)))))));
 	  }
 
-	switch (Get_Pragma_Id (Chars (gnat_temp)))
+	switch (Get_Pragma_Id (Pragma_Identifier (Chars (gnat_temp))))
 	  {
 	  case Pragma_Machine_Attribute:
 	    etype = ATTR_MACHINE_ATTRIBUTE;
@@ -7068,10 +7068,11 @@ check_ok_for_atomic (tree object, Entity_Id gnat_entity, bool comp_p)
        gnat_node = Next_Rep_Item (gnat_node))
     {
       if (!comp_p && Nkind (gnat_node) == N_Pragma
-	  && Get_Pragma_Id (Chars (gnat_node)) == Pragma_Atomic)
+	  && (Get_Pragma_Id (Chars (Pragma_Identifier (gnat_node)))
+              == Pragma_Atomic))
 	gnat_error_point = First (Pragma_Argument_Associations (gnat_node));
       else if (comp_p && Nkind (gnat_node) == N_Pragma
-	       && (Get_Pragma_Id (Chars (gnat_node))
+	       && (Get_Pragma_Id (Chars (Pragma_Identifier (gnat_node)))
 		   == Pragma_Atomic_Components))
 	gnat_error_point = First (Pragma_Argument_Associations (gnat_node));
     }

gcc/ada/exp_dbug.adb

@@ -464,7 +464,7 @@ package body Exp_Dbug is
 
       Set_Debug_Renaming_Link (Obj, Entity (Ren));
 
-      Set_Needs_Debug_Info (Obj);
+      Set_Debug_Info_Needed (Obj);
 
       --  Mark the object as internal so that it won't be initialized when
       --  pragma Initialize_Scalars or Normalize_Scalars is in use.

gcc/ada/exp_prag.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -116,12 +116,14 @@ package body Exp_Prag is
    ---------------------
 
    procedure Expand_N_Pragma (N : Node_Id) is
+      Pname : constant Name_Id := Pragma_Name (N);
+
    begin
-      --  Note: we may have a pragma whose chars field is not a
+      --  Note: we may have a pragma whose Pragma_Identifier field is not a
       --  recognized pragma, and we must ignore it at this stage.
 
-      if Is_Pragma_Name (Chars (N)) then
-         case Get_Pragma_Id (Chars (N)) is
+      if Is_Pragma_Name (Pname) then
+         case Get_Pragma_Id (Pname) is
 
             --  Pragmas requiring special expander action
 
@@ -350,6 +352,8 @@ package body Exp_Prag is
 
    --  For now we do nothing with the size attribute ???
 
+   --  Note: Psect_Object shares this processing
+
    procedure Expand_Pragma_Common_Object (N : Node_Id) is
       Loc : constant Source_Ptr := Sloc (N);
 
@@ -392,7 +396,6 @@ package body Exp_Prag is
       --  Insert the pragma
 
       Insert_After_And_Analyze (N,
-
          Make_Pragma (Loc,
            Chars => Name_Machine_Attribute,
            Pragma_Argument_Associations => New_List (
@@ -731,10 +734,7 @@ package body Exp_Prag is
 
    --  Convert to Common_Object, and expand the resulting pragma
 
-   procedure Expand_Pragma_Psect_Object (N : Node_Id) is
-   begin
-      Set_Chars (N, Name_Common_Object);
-      Expand_Pragma_Common_Object (N);
-   end Expand_Pragma_Psect_Object;
+   procedure Expand_Pragma_Psect_Object (N : Node_Id)
+     renames Expand_Pragma_Common_Object;
 
 end Exp_Prag;

gcc/ada/par-ch2.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -241,8 +241,8 @@ package body Ch2 is
       --  Set True if an identifier is encountered for a pragma argument. Used
       --  to check that there are no more arguments without identifiers.
 
-      Pragma_Node   : Node_Id;
-      Pragma_Name   : Name_Id;
+      Prag_Node     : Node_Id;
+      Prag_Name     : Name_Id;
       Semicolon_Loc : Source_Ptr;
       Ident_Node    : Node_Id;
       Assoc_Node    : Node_Id;
@@ -280,9 +280,9 @@ package body Ch2 is
    --  Start of processing for P_Pragma
 
    begin
-      Pragma_Node := New_Node (N_Pragma, Token_Ptr);
+      Prag_Node := New_Node (N_Pragma, Token_Ptr);
       Scan; -- past PRAGMA
-      Pragma_Name := Token_Name;
+      Prag_Name := Token_Name;
 
       if Style_Check then
          Style.Check_Pragma_Name;
@@ -294,21 +294,20 @@ package body Ch2 is
       if Ada_Version >= Ada_05
         and then Token = Tok_Interface
       then
-         Pragma_Name := Name_Interface;
+         Prag_Name := Name_Interface;
          Ident_Node  := Make_Identifier (Token_Ptr, Name_Interface);
          Scan; -- past INTERFACE
       else
          Ident_Node := P_Identifier;
       end if;
 
-      Set_Chars (Pragma_Node, Pragma_Name);
-      Set_Pragma_Identifier (Pragma_Node, Ident_Node);
+      Set_Pragma_Identifier (Prag_Node, Ident_Node);
 
       --  See if special INTERFACE/IMPORT check is required
 
       if SIS_Entry_Active then
-         Interface_Check_Required := (Pragma_Name = Name_Interface);
-         Import_Check_Required    := (Pragma_Name = Name_Import);
+         Interface_Check_Required := (Prag_Name = Name_Interface);
+         Import_Check_Required    := (Prag_Name = Name_Import);
       else
          Interface_Check_Required := False;
          Import_Check_Required    := False;
@@ -322,7 +321,7 @@ package body Ch2 is
         or else (Token /= Tok_Semicolon
                    and then not Token_Is_At_Start_Of_Line)
       then
-         Set_Pragma_Argument_Associations (Pragma_Node, New_List);
+         Set_Pragma_Argument_Associations (Prag_Node, New_List);
          T_Left_Paren;
 
          loop
@@ -342,7 +341,7 @@ package body Ch2 is
                end if;
             end if;
 
-            Append (Assoc_Node, Pragma_Argument_Associations (Pragma_Node));
+            Append (Assoc_Node, Pragma_Argument_Associations (Prag_Node));
             exit when Token /= Tok_Comma;
             Scan; -- past comma
          end loop;
@@ -352,7 +351,7 @@ package body Ch2 is
          --  statement, and an assignment statement is the most likely
          --  candidate for this error)
 
-         if Token = Tok_Colon_Equal and then Pragma_Name = Name_Debug then
+         if Token = Tok_Colon_Equal and then Prag_Name = Name_Debug then
             Error_Msg_SC ("argument for pragma Debug must be procedure call");
             Resync_To_Semicolon;
 
@@ -378,13 +377,13 @@ package body Ch2 is
       --  case of pragma Source_File_Name, which assume the semicolon
       --  is already scanned out.
 
-      if Chars (Pragma_Node) = Name_Style_Checks then
-         Result := Par.Prag (Pragma_Node, Semicolon_Loc);
+      if Prag_Name = Name_Style_Checks then
+         Result := Par.Prag (Prag_Node, Semicolon_Loc);
          Skip_Pragma_Semicolon;
          return Result;
       else
          Skip_Pragma_Semicolon;
-         return Par.Prag (Pragma_Node, Semicolon_Loc);
+         return Par.Prag (Prag_Node, Semicolon_Loc);
       end if;
 
    exception
@@ -434,14 +433,18 @@ package body Ch2 is
    --  Error recovery: Cannot raise Error_Resync
 
    procedure P_Pragmas_Opt (List : List_Id) is
-      P : Node_Id;
+      P     : Node_Id;
 
    begin
       while Token = Tok_Pragma loop
          P := P_Pragma;
 
-         if Chars (P) = Name_Assert or else Chars (P) = Name_Debug then
-            Error_Msg_Name_1 := Chars (P);
+         if Nkind (P) /= N_Error
+          and then (Pragma_Name (P) = Name_Assert
+                      or else
+                    Pragma_Name (P) = Name_Debug)
+         then
+            Error_Msg_Name_1 := Pragma_Name (P);
             Error_Msg_N
               ("pragma% must be in declaration/statement context", P);
          else

gcc/ada/s-pooglo.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---           Copyright (C) 1992-2005 Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, 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,9 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+--  Storage pool corresponding to default global storage pool used for
+--  types for which no storage pool is specified.
+
 with System;
 with System.Storage_Pools;
 with System.Storage_Elements;

gcc/ada/s-pooloc.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, 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,8 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+--  Storage pool for use with local objects with automatic reclaim
+
 with System.Storage_Elements;
 with System.Pool_Global;
 

gcc/ada/sem_elab.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1997-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1997-2008, 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- --
@@ -1654,12 +1654,6 @@ package body Sem_Elab is
             return;
          end if;
 
-         --  All OK if warnings suppressed on the entity
-
-         if Warnings_Off (Ent) then
-            return;
-         end if;
-
          --  All OK if all warnings suppressed
 
          if Warning_Mode = Suppress then
@@ -1691,16 +1685,20 @@ package body Sem_Elab is
 
          --  Here is where we give the warning
 
-         Error_Msg_Sloc := Sloc (Ent);
+                  --  All OK if warnings suppressed on the entity
 
-         Error_Msg_NE
-           ("?elaboration code may access& before it is initialized",
-            N, Ent);
-         Error_Msg_NE
-           ("\?suggest adding pragma Elaborate_Body to spec of &",
-            N, Scop);
-         Error_Msg_N
-           ("\?or an explicit initialization could be added #", N);
+         if not Has_Warnings_Off (Ent) then
+            Error_Msg_Sloc := Sloc (Ent);
+
+            Error_Msg_NE
+              ("?elaboration code may access& before it is initialized",
+               N, Ent);
+            Error_Msg_NE
+              ("\?suggest adding pragma Elaborate_Body to spec of &",
+               N, Scop);
+            Error_Msg_N
+              ("\?or an explicit initialization could be added #", N);
+         end if;
 
          if not All_Errors_Mode then
             Set_Suppress_Elaboration_Warnings (Ent);
@@ -3109,7 +3107,7 @@ package body Sem_Elab is
       Item := First (Context_Items (Cunit (Current_Sem_Unit)));
       while Present (Item) loop
          if Nkind (Item) = N_Pragma
-           and then Get_Pragma_Id (Chars (Item)) = Pragma_Elaborate_All
+           and then Pragma_Name (Item) = Name_Elaborate_All
          then
             --  Return if some previous error on the pragma itself
 

gcc/ada/sem_util.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -440,6 +440,15 @@ package Sem_Util is
    --  which is the innermost visible entity with the given name. See the
    --  body of Sem_Ch8 for further details on handling of entity visibility.
 
+   function Get_Pragma_Id (N : Node_Id) return Pragma_Id;
+   pragma Inline (Get_Pragma_Id);
+   --  Obtains the Pragma_Id from the Chars field of Pragma_Identifier (N)
+
+   function Get_Referenced_Object (N : Node_Id) return Node_Id;
+   --  Given a node, return the renamed object if the node represents a renamed
+   --  object, otherwise return the node unchanged. The node may represent an
+   --  arbitrary expression.
+
    function Get_Renamed_Entity (E : Entity_Id) return Entity_Id;
    --  Given an entity for an exception, package, subprogram or generic unit,
    --  returns the ultimately renamed entity if this is a renaming. If this is
@@ -452,11 +461,6 @@ package Sem_Util is
    --  related subprogram or entry and returns it, or if no subprogram can
    --  be found, returns Empty.
 
-   function Get_Referenced_Object (N : Node_Id) return Node_Id;
-   --  Given a node, return the renamed object if the node represents
-   --  a renamed object, otherwise return the node unchanged. The node
-   --  may represent an arbitrary expression.
-
    function Get_Subprogram_Body (E : Entity_Id) return Node_Id;
    --  Given the entity for a subprogram (E_Function or E_Procedure),
    --  return the corresponding N_Subprogram_Body node. If the corresponding
@@ -476,17 +480,18 @@ package Sem_Util is
    --  T contains access values (happens for generic formals in some
    --  cases), then False is returned.
 
+   function Has_Abstract_Interfaces
+     (T             : Entity_Id;
+      Use_Full_View : Boolean := True) return Boolean;
+   --  Where T is a concurrent type or a record type, returns true if T covers
+   --  any abstract interface types. In case of private types the argument
+   --  Use_Full_View controls if the check is done using its full view (if
+   --  available).
+
    type Alignment_Result is (Known_Compatible, Unknown, Known_Incompatible);
    --  Result of Has_Compatible_Alignment test, description found below. Note
    --  that the values are arranged in increasing order of problematicness.
 
-   function Has_Abstract_Interfaces
-     (Tagged_Type   : Entity_Id;
-      Use_Full_View : Boolean := True) return Boolean;
-   --  Returns true if Tagged_Type implements some abstract interface. In case
-   --  private types the argument Use_Full_View controls if the check is done
-   --  using its full view (if available).
-
    function Has_Compatible_Alignment
      (Obj  : Entity_Id;
       Expr : Node_Id) return Alignment_Result;
@@ -1028,6 +1033,14 @@ package Sem_Util is
    --  Establish the entity E as the currently visible definition of its
    --  associated name (i.e. the Node_Id associated with its name)
 
+   procedure Set_Debug_Info_Needed (T : Entity_Id);
+   --  Sets the Debug_Info_Needed flag on entity T , and also on any entities
+   --  that are needed by T (for an object, the type of the object is needed,
+   --  and for a type, various subsidiary types are needed -- see body for
+   --  details). Never has any effect on T if the Debug_Info_Off flag is set.
+   --  This routine should always be used instead of Set_Needs_Debug_Info to
+   --  ensure that subsidiary entities are properly handled.
+
    procedure Set_Entity_With_Style_Check (N : Node_Id; Val : Entity_Id);
    --  This procedure has the same calling sequence as Set_Entity, but
    --  if Style_Check is set, then it calls a style checking routine which

gcc/ada/sprint.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -2387,7 +2387,7 @@ package body Sprint is
 
          when N_Pragma =>
             Write_Indent_Str_Sloc ("pragma ");
-            Write_Name_With_Col_Check (Chars (Node));
+            Write_Name_With_Col_Check (Pragma_Name (Node));
 
             if Present (Pragma_Argument_Associations (Node)) then
                Sprint_Opt_Paren_Comma_List

gcc/ada/tbuild.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -360,7 +360,6 @@ package body Tbuild is
    begin
       return
         Make_Pragma (Sloc,
-          Chars                        => Chars,
           Pragma_Argument_Associations => Pragma_Argument_Associations,
           Debug_Statement              => Debug_Statement,
           Pragma_Identifier            => Make_Identifier (Sloc, Chars));

gcc/ada/tbuild.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --

gcc/ada/trans.c

@@ -687,10 +687,11 @@ Pragma_to_gnu (Node_Id gnat_node)
 
   /* Check for (and ignore) unrecognized pragma and do nothing if we are just
      annotating types.  */
-  if (type_annotate_only || !Is_Pragma_Name (Chars (gnat_node)))
+  if (type_annotate_only
+      || !Is_Pragma_Name (Chars (Pragma_Identifier (gnat_node))))
     return gnu_result;
 
-  switch (Get_Pragma_Id (Chars (gnat_node)))
+  switch (Get_Pragma_Id (Pragma_Identifier (Chars (gnat_node))))
     {
     case Pragma_Inspection_Point:
       /* Do nothing at top level: all such variables are already viewable.  */