prj-attr.adb   [plain text]

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                              P R J . A T T R                             --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                                                                          --
--             Copyright (C) 2001-2002 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- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Handling; use Ada.Characters.Handling;
with Namet;     use Namet;
with Output;    use Output;

package body Prj.Attr is

   --  Names end with '#'

   --  Package names are preceded by 'P'

   --  Attribute names are preceded by two letters

   --  The first letter is one of
   --    'S' for Single
   --    'L' for list

   --  The second letter is one of
   --    'V' for single variable
   --    'A' for associative array
   --    'a' for case insensitive associative array

   --  End is indicated by two consecutive '#'.

   Initialization_Data : constant String :=

   --  project attributes

     "SVobject_dir#" &
     "SVexec_dir#" &
     "LVsource_dirs#" &
     "LVsource_files#" &
     "SVsource_list_file#" &
     "SVlibrary_dir#" &
     "SVlibrary_name#" &
     "SVlibrary_kind#" &
     "SVlibrary_elaboration#" &
     "SVlibrary_version#" &
     "LVmain#" &
     "LVlanguages#" &

   --  package Naming

     "Pnaming#" &
     "Saspecification_suffix#" &
     "Saimplementation_suffix#" &
     "SVseparate_suffix#" &
     "SVcasing#" &
     "SVdot_replacement#" &
     "SAspecification#" &
     "SAimplementation#" &
     "LAspecification_exceptions#" &
     "LAimplementation_exceptions#" &

   --  package Compiler

     "Pcompiler#" &
     "Ladefault_switches#" &
     "LAswitches#" &
     "SVlocal_configuration_pragmas#" &

   --  package Builder

     "Pbuilder#" &
     "Ladefault_switches#" &
     "LAswitches#" &
     "SVglobal_configuration_pragmas#" &

   --  package gnatls

     "Pgnatls#" &
     "LVswitches#" &

   --  package Binder

     "Pbinder#" &
     "Ladefault_switches#" &
     "LAswitches#" &

   --  package Linker

     "Plinker#" &
     "Ladefault_switches#" &
     "LAswitches#" &

   --  package Cross_Reference

     "Pcross_reference#" &
     "Ladefault_switches#" &
     "LAswitches#" &

   --  package Finder

     "Pfinder#" &
     "Ladefault_switches#" &
     "LAswitches#" &

   --  package Gnatstub

     "Pgnatstub#" &
     "LVswitches#" &

   --  package Ide

     "Pide#" &
     "SVremote_host#" &
     "Sacompiler_command#" &
     "SVdebugger_command#" &
     "SVgnatlist#" &
     "SVvcs_kind#" &
     "SVvcs_file_check#" &
     "SVvcs_log_check#" &

     "#";

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize is
      Start             : Positive           := Initialization_Data'First;
      Finish            : Positive           := Start;
      Current_Package   : Package_Node_Id    := Empty_Package;
      Current_Attribute : Attribute_Node_Id  := Empty_Attribute;
      Is_An_Attribute   : Boolean            := False;
      Kind_1            : Variable_Kind      := Undefined;
      Kind_2            : Attribute_Kind     := Single;
      Package_Name      : Name_Id            := No_Name;
      Attribute_Name    : Name_Id            := No_Name;
      First_Attribute   : Attribute_Node_Id  := Attribute_First;

   begin
      --  Make sure the two tables are empty

      Attributes.Set_Last (Attributes.First);
      Package_Attributes.Set_Last (Package_Attributes.First);

      while Initialization_Data (Start) /= '#' loop
         Is_An_Attribute := True;
         case Initialization_Data (Start) is
            when 'P' =>

               --  New allowed package

               Start := Start + 1;

               Finish := Start;
               while Initialization_Data (Finish) /= '#' loop
                  Finish := Finish + 1;
               end loop;

               Name_Len := Finish - Start;
               Name_Buffer (1 .. Name_Len) :=
                 To_Lower (Initialization_Data (Start .. Finish - 1));
               Package_Name := Name_Find;

               for Index in Package_First .. Package_Attributes.Last loop
                  if Package_Name = Package_Attributes.Table (Index).Name then
                     Write_Line ("Duplicate package name """ &
                                 Initialization_Data (Start .. Finish - 1) &
                                 """ in Prj.Attr body.");
                     raise Program_Error;
                  end if;
               end loop;

               Is_An_Attribute := False;
               Current_Attribute := Empty_Attribute;
               Package_Attributes.Increment_Last;
               Current_Package := Package_Attributes.Last;
               Package_Attributes.Table (Current_Package).Name :=
                 Package_Name;
               Start := Finish + 1;

            when 'S' =>
               Kind_1 := Single;

            when 'L' =>
               Kind_1 := List;

            when others =>
               raise Program_Error;
         end case;

         if Is_An_Attribute then

            --  New attribute

            Start := Start + 1;
            case Initialization_Data (Start) is
               when 'V' =>
                  Kind_2 := Single;
               when 'A' =>
                  Kind_2 := Associative_Array;
               when 'a' =>
                  Kind_2 := Case_Insensitive_Associative_Array;
               when others =>
                  raise Program_Error;
            end case;

            Start := Start + 1;
            Finish := Start;

            while Initialization_Data (Finish) /= '#' loop
               Finish := Finish + 1;
            end loop;

            Name_Len := Finish - Start;
            Name_Buffer (1 .. Name_Len) :=
              To_Lower (Initialization_Data (Start .. Finish - 1));
            Attribute_Name := Name_Find;
            Attributes.Increment_Last;
            if Current_Attribute = Empty_Attribute then
               First_Attribute := Attributes.Last;

               if Current_Package /= Empty_Package then
                  Package_Attributes.Table (Current_Package).First_Attribute
                    := Attributes.Last;
               end if;

            else
               --  Check that there are no duplicate attributes

               for Index in First_Attribute .. Attributes.Last - 1 loop
                  if Attribute_Name =
                    Attributes.Table (Index).Name then
                     Write_Line ("Duplicate attribute name """ &
                                 Initialization_Data (Start .. Finish - 1) &
                                 """ in Prj.Attr body.");
                     raise Program_Error;
                  end if;
               end loop;

               Attributes.Table (Current_Attribute).Next :=
                 Attributes.Last;
            end if;

            Current_Attribute := Attributes.Last;
            Attributes.Table (Current_Attribute) :=
              (Name    => Attribute_Name,
               Kind_1  => Kind_1,
               Kind_2  => Kind_2,
               Next    => Empty_Attribute);
            Start := Finish + 1;
         end if;
      end loop;
   end Initialize;

end Prj.Attr;