* c-decl.c (grokfield): Allow typedefs for anonymous structs and

[pf3gnuchains/gcc-fork.git] / gcc / ada / tbuild.adb

diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb
index acbbb7d..3da3c61 100644 (file)
--- a/gcc/ada/tbuild.adb
+++ b/gcc/ada/tbuild.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, 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- --
@@ -32,7 +32,7 @@ with Nmake;    use Nmake;
 with Opt;      use Opt;
 with Restrict; use Restrict;
 with Rident;   use Rident;
-with Sinfo;    use Sinfo;
+with Sem_Aux;  use Sem_Aux;
 with Snames;   use Snames;
 with Stand;    use Stand;
 with Stringt;  use Stringt;
@@ -347,6 +347,24 @@ package body Tbuild is
       return LS;
    end Make_Linker_Section_Pragma;
 
+   -----------------
+   -- Make_Pragma --
+   -----------------
+
+   function Make_Pragma
+     (Sloc                         : Source_Ptr;
+      Chars                        : Name_Id;
+      Pragma_Argument_Associations : List_Id := No_List;
+      Debug_Statement              : Node_Id := Empty) return Node_Id
+   is
+   begin
+      return
+        Make_Pragma (Sloc,
+          Pragma_Argument_Associations => Pragma_Argument_Associations,
+          Debug_Statement              => Debug_Statement,
+          Pragma_Identifier            => Make_Identifier (Sloc, Chars));
+   end Make_Pragma;
+
    ---------------------------------
    -- Make_Raise_Constraint_Error --
    ---------------------------------
@@ -417,6 +435,23 @@ package body Tbuild is
           Strval => End_String);
    end Make_String_Literal;
 
+   --------------------
+   -- Make_Temporary --
+   --------------------
+
+   function Make_Temporary
+     (Loc          : Source_Ptr;
+      Id           : Character;
+      Related_Node : Node_Id := Empty) return Node_Id
+   is
+      Temp : constant Node_Id :=
+               Make_Defining_Identifier (Loc,
+                 Chars => New_Internal_Name (Id));
+   begin
+      Set_Related_Expression (Temp, Related_Node);
+      return Temp;
+   end Make_Temporary;
+
    ---------------------------
    -- Make_Unsuppress_Block --
    ---------------------------
@@ -480,7 +515,7 @@ package body Tbuild is
       Get_Name_String (Related_Id);
 
       if Prefix /= ' ' then
-         pragma Assert (Is_OK_Internal_Letter (Prefix));
+         pragma Assert (Is_OK_Internal_Letter (Prefix) or else Prefix = '_');
 
          for J in reverse 1 .. Name_Len loop
             Name_Buffer (J + 1) := Name_Buffer (J);
@@ -492,8 +527,7 @@ package body Tbuild is
 
       if Suffix /= ' ' then
          pragma Assert (Is_OK_Internal_Letter (Suffix));
-         Name_Len := Name_Len + 1;
-         Name_Buffer (Name_Len) := Suffix;
+         Add_Char_To_Name_Buffer (Suffix);
       end if;
 
       if Suffix_Index /= 0 then
@@ -591,6 +625,58 @@ package body Tbuild is
       return Occurrence;
    end New_Occurrence_Of;
 
+   -----------------
+   -- New_Op_Node --
+   -----------------
+
+   function New_Op_Node
+     (New_Node_Kind : Node_Kind;
+      New_Sloc      : Source_Ptr) return Node_Id
+   is
+      type Name_Of_Type is array (N_Op) of Name_Id;
+      Name_Of : constant Name_Of_Type := Name_Of_Type'(
+         N_Op_And                    => Name_Op_And,
+         N_Op_Or                     => Name_Op_Or,
+         N_Op_Xor                    => Name_Op_Xor,
+         N_Op_Eq                     => Name_Op_Eq,
+         N_Op_Ne                     => Name_Op_Ne,
+         N_Op_Lt                     => Name_Op_Lt,
+         N_Op_Le                     => Name_Op_Le,
+         N_Op_Gt                     => Name_Op_Gt,
+         N_Op_Ge                     => Name_Op_Ge,
+         N_Op_Add                    => Name_Op_Add,
+         N_Op_Subtract               => Name_Op_Subtract,
+         N_Op_Concat                 => Name_Op_Concat,
+         N_Op_Multiply               => Name_Op_Multiply,
+         N_Op_Divide                 => Name_Op_Divide,
+         N_Op_Mod                    => Name_Op_Mod,
+         N_Op_Rem                    => Name_Op_Rem,
+         N_Op_Expon                  => Name_Op_Expon,
+         N_Op_Plus                   => Name_Op_Add,
+         N_Op_Minus                  => Name_Op_Subtract,
+         N_Op_Abs                    => Name_Op_Abs,
+         N_Op_Not                    => Name_Op_Not,
+
+         --  We don't really need these shift operators, since they never
+         --  appear as operators in the source, but the path of least
+         --  resistance is to put them in (the aggregate must be complete)
+
+         N_Op_Rotate_Left            => Name_Rotate_Left,
+         N_Op_Rotate_Right           => Name_Rotate_Right,
+         N_Op_Shift_Left             => Name_Shift_Left,
+         N_Op_Shift_Right            => Name_Shift_Right,
+         N_Op_Shift_Right_Arithmetic => Name_Shift_Right_Arithmetic);
+
+      Nod : constant Node_Id := New_Node (New_Node_Kind, New_Sloc);
+
+   begin
+      if New_Node_Kind in Name_Of'Range then
+         Set_Chars (Nod, Name_Of (New_Node_Kind));
+      end if;
+
+      return Nod;
+   end New_Op_Node;
+
    ----------------------
    -- New_Reference_To --
    ----------------------
@@ -618,10 +704,8 @@ package body Tbuild is
    is
    begin
       Get_Name_String (Related_Id);
-      Name_Len := Name_Len + 1;
-      Name_Buffer (Name_Len) := '_';
-      Name_Buffer (Name_Len + 1 .. Name_Len + Suffix'Length) := Suffix;
-      Name_Len := Name_Len + Suffix'Length;
+      Add_Char_To_Name_Buffer ('_');
+      Add_Str_To_Name_Buffer (Suffix);
       return Name_Find;
    end New_Suffixed_Name;