2004-05-10 Doug Rupp <rupp@gnat.com>

[pf3gnuchains/gcc-fork.git] / gcc / ada / prj-dect.adb

diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb
index 9865dff..0db8d91 100644 (file)
--- a/gcc/ada/prj-dect.adb
+++ b/gcc/ada/prj-dect.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---           Copyright (C) 2001-2003 Free Software Foundation, Inc          --
+--           Copyright (C) 2001-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- --
@@ -33,6 +33,7 @@ with Scans;    use Scans;
 with Snames;
 with Types;    use Types;
 with Prj.Attr; use Prj.Attr;
+with Uintp;    use Uintp;
 
 package body Prj.Dect is
 
@@ -121,10 +122,12 @@ package body Prj.Dect is
       Current_Attribute      : Attribute_Node_Id := First_Attribute;
       Full_Associative_Array : Boolean           := False;
       Attribute_Name         : Name_Id           := No_Name;
+      Optional_Index         : Boolean           := False;
 
    begin
       Attribute := Default_Project_Node (Of_Kind => N_Attribute_Declaration);
       Set_Location_Of (Attribute, To => Token_Ptr);
+      Set_Previous_Line_Node (Attribute);
 
       --  Scan past "for"
 
@@ -193,8 +196,9 @@ package body Prj.Dect is
 
          --  Set, if appropriate the index case insensitivity flag
 
-         elsif Attributes.Table (Current_Attribute).Kind_2 =
-           Case_Insensitive_Associative_Array
+         elsif Attributes.Table (Current_Attribute).Kind_2 in
+                 Case_Insensitive_Associative_Array ..
+                 Optional_Index_Case_Insensitive_Associative_Array
          then
             Set_Case_Insensitive (Attribute, To => True);
          end if;
@@ -244,6 +248,41 @@ package body Prj.Dect is
          if Token = Tok_String_Literal then
             Set_Associative_Array_Index_Of (Attribute, Token_Name);
             Scan; --  past the literal string index
+
+            if Token = Tok_At then
+               case Attributes.Table (Current_Attribute).Kind_2 is
+                  when Optional_Index_Associative_Array |
+                       Optional_Index_Case_Insensitive_Associative_Array =>
+                     Scan;
+                     Expect (Tok_Integer_Literal, "integer literal");
+
+                     if Token = Tok_Integer_Literal then
+
+                        --  Set the source index value from given literal
+
+                        declare
+                           Index : constant Int :=
+                                     UI_To_Int (Int_Literal_Value);
+                        begin
+                           if Index = 0 then
+                              Error_Msg ("index cannot be zero", Token_Ptr);
+                           else
+                              Set_Source_Index_Of (Attribute, To => Index);
+                           end if;
+                        end;
+
+                        Scan;
+                     end if;
+
+                  when others =>
+                     Error_Msg ("index not allowed here", Token_Ptr);
+                     Scan;
+
+                     if Token = Tok_Integer_Literal then
+                        Scan;
+                     end if;
+               end case;
+            end if;
          end if;
 
          Expect (Tok_Right_Paren, "`)`");
@@ -270,6 +309,7 @@ package body Prj.Dect is
       if Current_Attribute /= Empty_Attribute then
          Set_Expression_Kind_Of
            (Attribute, To => Attributes.Table (Current_Attribute).Kind_1);
+         Optional_Index := Attributes.Table (Current_Attribute).Optional_Index;
       end if;
 
       Expect (Tok_Use, "USE");
@@ -438,7 +478,8 @@ package body Prj.Dect is
                Parse_Expression
                  (Expression      => Expression,
                   Current_Project => Current_Project,
-                  Current_Package => Current_Package);
+                  Current_Package => Current_Package,
+                  Optional_Index  => Optional_Index);
                Set_Expression_Of (Attribute, To => Expression);
 
                --  If the expression is legal, but not of the right kind
@@ -467,6 +508,9 @@ package body Prj.Dect is
       if Current_Attribute = Empty_Attribute then
          Attribute := Empty_Node;
       end if;
+
+      Set_End_Of_Line (Attribute);
+      Set_Previous_Line_Node (Attribute);
    end Parse_Attribute_Declaration;
 
    -----------------------------
@@ -535,6 +579,9 @@ package body Prj.Dect is
       Expect (Tok_Is, "IS");
 
       if Token = Tok_Is then
+         Set_End_Of_Line (Case_Construction);
+         Set_Previous_Line_Node (Case_Construction);
+         Set_Next_End_Node (Case_Construction);
 
          --  Scan past "is"
 
@@ -571,6 +618,8 @@ package body Prj.Dect is
             Scan;
 
             Expect (Tok_Arrow, "`=>`");
+            Set_End_Of_Line (Current_Item);
+            Set_Previous_Line_Node (Current_Item);
 
             --  Empty_Node in Field1 of a Case_Item indicates
             --  the "when others =>" branch.
@@ -596,6 +645,8 @@ package body Prj.Dect is
             Set_First_Choice_Of (Current_Item, To => First_Choice);
 
             Expect (Tok_Arrow, "`=>`");
+            Set_End_Of_Line (Current_Item);
+            Set_Previous_Line_Node (Current_Item);
 
             Parse_Declarative_Items
               (Declarations    => First_Declarative_Item,
@@ -613,6 +664,7 @@ package body Prj.Dect is
       End_Case_Construction;
 
       Expect (Tok_End, "`END CASE`");
+      Remove_Next_End_Node;
 
       if Token = Tok_End then
 
@@ -629,6 +681,7 @@ package body Prj.Dect is
       Scan;
 
       Expect (Tok_Semicolon, "`;`");
+      Set_Previous_End_Node (Case_Construction);
 
    end Parse_Case_Construction;
 
@@ -673,6 +726,9 @@ package body Prj.Dect is
                   Current_Project => Current_Project,
                   Current_Package => Current_Package);
 
+               Set_End_Of_Line (Current_Declaration);
+               Set_Previous_Line_Node (Current_Declaration);
+
             when Tok_For =>
 
                Parse_Attribute_Declaration
@@ -681,6 +737,9 @@ package body Prj.Dect is
                   Current_Project => Current_Project,
                   Current_Package => Current_Package);
 
+               Set_End_Of_Line (Current_Declaration);
+               Set_Previous_Line_Node (Current_Declaration);
+
             when Tok_Package =>
 
                --  Package declaration
@@ -693,6 +752,8 @@ package body Prj.Dect is
                  (Package_Declaration => Current_Declaration,
                   Current_Project     => Current_Project);
 
+               Set_Previous_End_Node (Current_Declaration);
+
             when Tok_Type =>
 
                --  Type String Declaration
@@ -706,6 +767,9 @@ package body Prj.Dect is
                  (String_Type     => Current_Declaration,
                   Current_Project => Current_Project);
 
+               Set_End_Of_Line (Current_Declaration);
+               Set_Previous_Line_Node (Current_Declaration);
+
             when Tok_Case =>
 
                --  Case construction
@@ -716,6 +780,8 @@ package body Prj.Dect is
                   Current_Project   => Current_Project,
                   Current_Package   => Current_Package);
 
+               Set_Previous_End_Node (Current_Declaration);
+
             when others =>
                exit;
 
@@ -928,8 +994,13 @@ package body Prj.Dect is
          end if;
 
          Expect (Tok_Semicolon, "`;`");
+         Set_End_Of_Line (Package_Declaration);
+         Set_Previous_Line_Node (Package_Declaration);
 
       elsif Token = Tok_Is then
+         Set_End_Of_Line (Package_Declaration);
+         Set_Previous_Line_Node (Package_Declaration);
+         Set_Next_End_Node (Package_Declaration);
 
          Parse_Declarative_Items
            (Declarations    => First_Declarative_Item,
@@ -970,6 +1041,7 @@ package body Prj.Dect is
          end if;
 
          Expect (Tok_Semicolon, "`;`");
+         Remove_Next_End_Node;
 
       else
          Error_Msg ("expected IS or RENAMES", Token_Ptr);
@@ -1193,7 +1265,8 @@ package body Prj.Dect is
       Parse_Expression
         (Expression      => Expression,
          Current_Project => Current_Project,
-         Current_Package => Current_Package);
+         Current_Package => Current_Package,
+         Optional_Index  => False);
       Set_Expression_Of (Variable, To => Expression);
 
       if Expression /= Empty_Node then