gcc/ada/prj-attr.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             P R J . A T T R                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --             Copyright (C) 2001-2003 Free Software Foundation, Inc.       --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Ada.Characters.Handling; use Ada.Characters.Handling;
  28 with Namet;     use Namet;
  29 with Osint;     use Osint;
  30 with Output;    use Output;
  31
  32 package body Prj.Attr is
  33
  34    --  Names end with '#'
  35
  36    --  Package names are preceded by 'P'
  37
  38    --  Attribute names are preceded by two letters
  39
  40    --  The first letter is one of
  41    --    'S' for Single
  42    --    'L' for list
  43
  44    --  The second letter is one of
  45    --    'V' for single variable
  46    --    'A' for associative array
  47    --    'a' for case insensitive associative array
  48    --    'b' for associative array, case insensitive if file names are case
  49    --        insensitive
  50
  51    --  End is indicated by two consecutive '#'.
  52
  53    Initialization_Data : constant String :=
  54
  55    --  project attributes
  56
  57      "SVobject_dir#" &
  58      "SVexec_dir#" &
  59      "LVsource_dirs#" &
  60      "LVsource_files#" &
  61      "LVlocally_removed_files#" &
  62      "SVsource_list_file#" &
  63      "SVlibrary_dir#" &
  64      "SVlibrary_name#" &
  65      "SVlibrary_kind#" &
  66      "SVlibrary_version#" &
  67      "LVlibrary_interface#" &
  68      "SVlibrary_auto_init#" &
  69      "LVlibrary_options#" &
  70      "SVlibrary_src_dir#" &
  71      "SVlibrary_gcc#" &
  72      "SVlibrary_symbol_file#" &
  73      "SVlibrary_symbol_policy#" &
  74      "SVlibrary_reference_symbol_file#" &
  75      "LVmain#" &
  76      "LVlanguages#" &
  77      "SVmain_language#" &
  78
  79    --  package Naming
  80
  81      "Pnaming#" &
  82      "Saspecification_suffix#" &
  83      "Saspec_suffix#" &
  84      "Saimplementation_suffix#" &
  85      "Sabody_suffix#" &
  86      "SVseparate_suffix#" &
  87      "SVcasing#" &
  88      "SVdot_replacement#" &
  89      "SAspecification#" &
  90      "SAspec#" &
  91      "SAimplementation#" &
  92      "SAbody#" &
  93      "Laspecification_exceptions#" &
  94      "Laimplementation_exceptions#" &
  95
  96    --  package Compiler
  97
  98      "Pcompiler#" &
  99      "Ladefault_switches#" &
 100      "Lbswitches#" &
 101      "SVlocal_configuration_pragmas#" &
 102
 103    --  package Builder
 104
 105      "Pbuilder#" &
 106      "Ladefault_switches#" &
 107      "Lbswitches#" &
 108      "SAexecutable#" &
 109      "SVexecutable_suffix#" &
 110      "SVglobal_configuration_pragmas#" &
 111
 112    --  package gnatls
 113
 114      "Pgnatls#" &
 115      "LVswitches#" &
 116
 117    --  package Binder
 118
 119      "Pbinder#" &
 120      "Ladefault_switches#" &
 121      "Lbswitches#" &
 122
 123    --  package Linker
 124
 125      "Plinker#" &
 126      "Ladefault_switches#" &
 127      "Lbswitches#" &
 128      "LVlinker_options#" &
 129
 130    --  package Cross_Reference
 131
 132      "Pcross_reference#" &
 133      "Ladefault_switches#" &
 134      "Lbswitches#" &
 135
 136    --  package Finder
 137
 138      "Pfinder#" &
 139      "Ladefault_switches#" &
 140      "Lbswitches#" &
 141
 142    --  package Pretty_Printer
 143
 144      "Ppretty_printer#" &
 145      "Ladefault_switches#" &
 146      "Lbswitches#" &
 147
 148    --  package gnatstub
 149
 150      "Pgnatstub#" &
 151      "Ladefault_switches#" &
 152      "Lbswitches#" &
 153
 154    --  package Eliminate
 155
 156      "Peliminate#" &
 157      "Ladefault_switches#" &
 158      "Lbswitches#" &
 159
 160    --  package Ide
 161
 162      "Pide#" &
 163      "Ladefault_switches#" &
 164      "SVremote_host#" &
 165      "SVprogram_host#" &
 166      "SVcommunication_protocol#" &
 167      "Sacompiler_command#" &
 168      "SVdebugger_command#" &
 169      "SVgnatlist#" &
 170      "SVvcs_kind#" &
 171      "SVvcs_file_check#" &
 172      "SVvcs_log_check#" &
 173
 174      "#";
 175
 176    ----------------
 177    -- Initialize --
 178    ----------------
 179
 180    procedure Initialize is
 181       Start             : Positive           := Initialization_Data'First;
 182       Finish            : Positive           := Start;
 183       Current_Package   : Package_Node_Id    := Empty_Package;
 184       Current_Attribute : Attribute_Node_Id  := Empty_Attribute;
 185       Is_An_Attribute   : Boolean            := False;
 186       Kind_1            : Variable_Kind      := Undefined;
 187       Kind_2            : Attribute_Kind     := Single;
 188       Package_Name      : Name_Id            := No_Name;
 189       Attribute_Name    : Name_Id            := No_Name;
 190       First_Attribute   : Attribute_Node_Id  := Attribute_First;
 191
 192    begin
 193       --  Make sure the two tables are empty
 194
 195       Attributes.Init;
 196       Package_Attributes.Init;
 197
 198       while Initialization_Data (Start) /= '#' loop
 199          Is_An_Attribute := True;
 200          case Initialization_Data (Start) is
 201             when 'P' =>
 202
 203                --  New allowed package
 204
 205                Start := Start + 1;
 206
 207                Finish := Start;
 208                while Initialization_Data (Finish) /= '#' loop
 209                   Finish := Finish + 1;
 210                end loop;
 211
 212                Name_Len := Finish - Start;
 213                Name_Buffer (1 .. Name_Len) :=
 214                  To_Lower (Initialization_Data (Start .. Finish - 1));
 215                Package_Name := Name_Find;
 216
 217                for Index in Package_First .. Package_Attributes.Last loop
 218                   if Package_Name = Package_Attributes.Table (Index).Name then
 219                      Write_Line ("Duplicate package name """ &
 220                                  Initialization_Data (Start .. Finish - 1) &
 221                                  """ in Prj.Attr body.");
 222                      raise Program_Error;
 223                   end if;
 224                end loop;
 225
 226                Is_An_Attribute := False;
 227                Current_Attribute := Empty_Attribute;
 228                Package_Attributes.Increment_Last;
 229                Current_Package := Package_Attributes.Last;
 230                Package_Attributes.Table (Current_Package).Name :=
 231                  Package_Name;
 232                Start := Finish + 1;
 233
 234             when 'S' =>
 235                Kind_1 := Single;
 236
 237             when 'L' =>
 238                Kind_1 := List;
 239
 240             when others =>
 241                raise Program_Error;
 242          end case;
 243
 244          if Is_An_Attribute then
 245
 246             --  New attribute
 247
 248             Start := Start + 1;
 249             case Initialization_Data (Start) is
 250                when 'V' =>
 251                   Kind_2 := Single;
 252
 253                when 'A' =>
 254                   Kind_2 := Associative_Array;
 255
 256                when 'a' =>
 257                   Kind_2 := Case_Insensitive_Associative_Array;
 258
 259                when 'b' =>
 260                   if File_Names_Case_Sensitive then
 261                      Kind_2 := Case_Insensitive_Associative_Array;
 262                   else
 263                      Kind_2 := Case_Insensitive_Associative_Array;
 264                   end if;
 265
 266                when others =>
 267                   raise Program_Error;
 268             end case;
 269
 270             Start := Start + 1;
 271             Finish := Start;
 272
 273             while Initialization_Data (Finish) /= '#' loop
 274                Finish := Finish + 1;
 275             end loop;
 276
 277             Name_Len := Finish - Start;
 278             Name_Buffer (1 .. Name_Len) :=
 279               To_Lower (Initialization_Data (Start .. Finish - 1));
 280             Attribute_Name := Name_Find;
 281             Attributes.Increment_Last;
 282             if Current_Attribute = Empty_Attribute then
 283                First_Attribute := Attributes.Last;
 284
 285                if Current_Package /= Empty_Package then
 286                   Package_Attributes.Table (Current_Package).First_Attribute
 287                     := Attributes.Last;
 288                end if;
 289
 290             else
 291                --  Check that there are no duplicate attributes
 292
 293                for Index in First_Attribute .. Attributes.Last - 1 loop
 294                   if Attribute_Name =
 295                     Attributes.Table (Index).Name then
 296                      Write_Line ("Duplicate attribute name """ &
 297                                  Initialization_Data (Start .. Finish - 1) &
 298                                  """ in Prj.Attr body.");
 299                      raise Program_Error;
 300                   end if;
 301                end loop;
 302
 303                Attributes.Table (Current_Attribute).Next :=
 304                  Attributes.Last;
 305             end if;
 306
 307             Current_Attribute := Attributes.Last;
 308             Attributes.Table (Current_Attribute) :=
 309               (Name    => Attribute_Name,
 310                Kind_1  => Kind_1,
 311                Kind_2  => Kind_2,
 312                Next    => Empty_Attribute);
 313             Start := Finish + 1;
 314          end if;
 315       end loop;
 316    end Initialize;
 317
 318 end Prj.Attr;