gcc/ada/prj-attr.ads

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             P R J . A T T R                              --
   6 --                                                                          --
   7 --                                 S p e c                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2001-2014, 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 3,  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 COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 --  This package defines packages and attributes in GNAT project files.
  27 --  There are predefined packages and attributes.
  28
  29 --  It is also possible to define new packages with their attributes
  30
  31 with Table;
  32
  33 with GNAT.Strings;
  34
  35 package Prj.Attr is
  36
  37    function Package_Name_List return GNAT.Strings.String_List;
  38    --  Returns the list of valid package names, including those added by
  39    --  procedures Register_New_Package below. The String_Access components of
  40    --  the returned String_List should never be freed.
  41
  42    procedure Initialize;
  43    --  Initialize the predefined project level attributes and the predefined
  44    --  packages and their attribute. This procedure should be called by
  45    --  Prj.Initialize.
  46
  47    type Attribute_Kind is (
  48       Unknown,
  49       --  The attribute does not exist
  50
  51       Single,
  52       --  Single variable attribute (not an associative array)
  53
  54       Associative_Array,
  55       --  Associative array attribute with a case sensitive index
  56
  57       Optional_Index_Associative_Array,
  58       --  Associative array attribute with a case sensitive index and an
  59       --  optional source index.
  60
  61       Case_Insensitive_Associative_Array,
  62       --  Associative array attribute with a case insensitive index
  63
  64       Optional_Index_Case_Insensitive_Associative_Array
  65       --  Associative array attribute with a case insensitive index and an
  66       --  optional source index.
  67    );
  68    --  Characteristics of an attribute. Optional_Index indicates that there
  69    --  may be an optional index in the index of the associative array, as in
  70    --     for Switches ("files.ada" at 2) use ...
  71
  72    subtype Defined_Attribute_Kind is Attribute_Kind
  73      range Single .. Optional_Index_Case_Insensitive_Associative_Array;
  74    --  Subset of Attribute_Kinds that may be used for the attributes that is
  75    --  used when defining a new package.
  76
  77    subtype All_Case_Insensitive_Associative_Array is Attribute_Kind range
  78      Case_Insensitive_Associative_Array ..
  79      Optional_Index_Case_Insensitive_Associative_Array;
  80    --  Subtype including both cases of Case_Insensitive_Associative_Array
  81
  82    Max_Attribute_Name_Length : constant := 64;
  83    --  The maximum length of attribute names
  84
  85    subtype Attribute_Name_Length is
  86      Positive range 1 .. Max_Attribute_Name_Length;
  87
  88    type Attribute_Data (Name_Length : Attribute_Name_Length := 1) is record
  89       Name : String (1 .. Name_Length);
  90       --  The name of the attribute
  91
  92       Attr_Kind  : Defined_Attribute_Kind;
  93       --  The type of the attribute
  94
  95       Index_Is_File_Name : Boolean;
  96       --  For associative arrays, indicate if the index is a file name, so
  97       --  that the attribute kind may be modified depending on the case
  98       --  sensitivity of file names. This is only taken into account when
  99       --  Attr_Kind is Associative_Array or Optional_Index_Associative_Array.
 100
 101       Opt_Index : Boolean;
 102       --  True if there may be an optional index in the value of the index,
 103       --  as in:
 104       --    "file.ada" at 2
 105       --    ("main.adb", "file.ada" at 1)
 106
 107       Var_Kind : Defined_Variable_Kind;
 108       --  The attribute value kind: single or list
 109
 110       Default : Attribute_Default_Value := Empty_Value;
 111       --  The value of the attribute when referenced if the attribute has not
 112       --  yet been declared.
 113
 114    end record;
 115    --  Name and characteristics of an attribute in a package registered
 116    --  explicitly with Register_New_Package (see below).
 117
 118    type Attribute_Data_Array is array (Positive range <>) of Attribute_Data;
 119    --  A list of attribute name/characteristics to be used as parameter of
 120    --  procedure Register_New_Package below.
 121
 122    --  In the subprograms below, when it is specified that the subprogram
 123    --  "fails", procedure Prj.Com.Fail is called. Unless it is specified
 124    --  otherwise, if Prj.Com.Fail returns, exception Prj.Prj_Error is raised.
 125
 126    procedure Register_New_Package
 127      (Name       : String;
 128       Attributes : Attribute_Data_Array);
 129    --  Add a new package with its attributes. This procedure can only be
 130    --  called after Initialize, but before any other call to a service of
 131    --  the Project Manager. Fail if the name of the package is empty or not
 132    --  unique, or if the names of the attributes are not different.
 133
 134    ----------------
 135    -- Attributes --
 136    ----------------
 137
 138    type Attribute_Node_Id is private;
 139    --  The type to refers to an attribute, self-initialized
 140
 141    Empty_Attribute : constant Attribute_Node_Id;
 142    --  Indicates no attribute. Default value of Attribute_Node_Id objects
 143
 144    Attribute_First : constant Attribute_Node_Id;
 145    --  First attribute node id of project level attributes
 146
 147    function Attribute_Node_Id_Of
 148      (Name        : Name_Id;
 149       Starting_At : Attribute_Node_Id) return Attribute_Node_Id;
 150    --  Returns the node id of an attribute at the project level or in
 151    --  a package. Starting_At indicates the first known attribute node where
 152    --  to start the search. Returns Empty_Attribute if the attribute cannot
 153    --  be found.
 154
 155    function Attribute_Kind_Of
 156      (Attribute : Attribute_Node_Id) return Attribute_Kind;
 157    --  Returns the attribute kind of a known attribute. Returns Unknown if
 158    --  Attribute is Empty_Attribute.
 159    --
 160    --  To use this function, the following code should be used:
 161    --
 162    --      Pkg : constant Package_Node_Id :=
 163    --              Prj.Attr.Package_Node_Id_Of (Name => <package name>);
 164    --      Att : constant Attribute_Node_Id :=
 165    --              Prj.Attr.Attribute_Node_Id_Of
 166    --                (Name        => <attribute name>,
 167    --                 Starting_At => First_Attribute_Of (Pkg));
 168    --      Kind : constant Attribute_Kind := Attribute_Kind_Of (Att);
 169    --
 170    --  However, do not use this function once you have an already parsed
 171    --  project tree. Instead, given a Project_Node_Id corresponding to the
 172    --  attribute declaration ("for Attr (index) use ..."), use for example:
 173    --
 174    --      if Case_Insensitive (Attr, Tree) then ...
 175
 176    procedure Set_Attribute_Kind_Of
 177      (Attribute : Attribute_Node_Id;
 178       To        : Attribute_Kind);
 179    --  Set the attribute kind of a known attribute. Does nothing if
 180    --  Attribute is Empty_Attribute.
 181
 182    function Attribute_Name_Of (Attribute : Attribute_Node_Id) return Name_Id;
 183    --  Returns the name of a known attribute. Returns No_Name if Attribute is
 184    --  Empty_Attribute.
 185
 186    function Variable_Kind_Of
 187      (Attribute : Attribute_Node_Id) return Variable_Kind;
 188    --  Returns the variable kind of a known attribute. Returns Undefined if
 189    --  Attribute is Empty_Attribute.
 190
 191    procedure Set_Variable_Kind_Of
 192      (Attribute : Attribute_Node_Id;
 193       To        : Variable_Kind);
 194    --  Set the variable kind of a known attribute. Does nothing if Attribute is
 195    --  Empty_Attribute.
 196
 197    function Attribute_Default_Of
 198      (Attribute : Attribute_Node_Id) return Attribute_Default_Value;
 199    --  Returns the default of the attribute, Read_Only_Value for read only
 200    --  attributes, Empty_Value when default not specified, or specified value.
 201
 202    function Optional_Index_Of (Attribute : Attribute_Node_Id) return Boolean;
 203    --  Returns True if Attribute is a known attribute and may have an
 204    --  optional index. Returns False otherwise.
 205
 206    function Is_Read_Only (Attribute : Attribute_Node_Id) return Boolean;
 207
 208    function Next_Attribute
 209      (After : Attribute_Node_Id) return Attribute_Node_Id;
 210    --  Returns the attribute that follow After in the list of project level
 211    --  attributes or the list of attributes in a package.
 212    --  Returns Empty_Attribute if After is either Empty_Attribute or is the
 213    --  last of the list.
 214
 215    function Others_Allowed_For (Attribute : Attribute_Node_Id) return Boolean;
 216    --  True iff the index for an associative array attributes may be others
 217
 218    --------------
 219    -- Packages --
 220    --------------
 221
 222    type Package_Node_Id is private;
 223    --  Type to refer to a package, self initialized
 224
 225    Empty_Package : constant Package_Node_Id;
 226    --  Default value of Package_Node_Id objects
 227
 228    Unknown_Package : constant Package_Node_Id;
 229    --  Value of an unknown package that has been found but is unknown
 230
 231    procedure Register_New_Package (Name : String; Id : out Package_Node_Id);
 232    --  Add a new package. Fails if Name (the package name) is empty or is
 233    --  already the name of a package, and set Id to Empty_Package,
 234    --  if Prj.Com.Fail returns. Initially, the new package has no attributes.
 235    --  Id may be used to add attributes using procedure Register_New_Attribute
 236    --  below.
 237
 238    procedure Register_New_Attribute
 239      (Name               : String;
 240       In_Package         : Package_Node_Id;
 241       Attr_Kind          : Defined_Attribute_Kind;
 242       Var_Kind           : Defined_Variable_Kind;
 243       Index_Is_File_Name : Boolean                 := False;
 244       Opt_Index          : Boolean                 := False;
 245       Default            : Attribute_Default_Value := Empty_Value);
 246    --  Add a new attribute to registered package In_Package. Fails if Name
 247    --  (the attribute name) is empty, if In_Package is Empty_Package or if
 248    --  the attribute name has a duplicate name. See definition of type
 249    --  Attribute_Data above for the meaning of parameters Attr_Kind, Var_Kind,
 250    --  Index_Is_File_Name, Opt_Index, and Default.
 251
 252    function Package_Node_Id_Of (Name : Name_Id) return Package_Node_Id;
 253    --  Returns the package node id of the package with name Name. Returns
 254    --  Empty_Package if there is no package with this name.
 255
 256    function First_Attribute_Of
 257      (Pkg : Package_Node_Id) return Attribute_Node_Id;
 258    --  Returns the first attribute in the list of attributes of package Pkg.
 259    --  Returns Empty_Attribute if Pkg is Empty_Package or Unknown_Package.
 260
 261 private
 262    ----------------
 263    -- Attributes --
 264    ----------------
 265
 266    Attributes_Initial   : constant := 50;
 267    Attributes_Increment : constant := 100;
 268
 269    Attribute_Node_Low_Bound  : constant := 0;
 270    Attribute_Node_High_Bound : constant := 099_999_999;
 271
 272    type Attr_Node_Id is
 273      range Attribute_Node_Low_Bound .. Attribute_Node_High_Bound;
 274    --  Index type for table Attrs in the body
 275
 276    type Attribute_Node_Id is record
 277       Value : Attr_Node_Id := Attribute_Node_Low_Bound;
 278    end record;
 279    --  Full declaration of self-initialized private type
 280
 281    Empty_Attr : constant Attr_Node_Id := Attribute_Node_Low_Bound;
 282
 283    Empty_Attribute : constant Attribute_Node_Id := (Value => Empty_Attr);
 284
 285    First_Attribute : constant Attr_Node_Id := Attribute_Node_Low_Bound + 1;
 286
 287    First_Attribute_Node_Id : constant Attribute_Node_Id :=
 288                                (Value => First_Attribute);
 289
 290    Attribute_First : constant Attribute_Node_Id := First_Attribute_Node_Id;
 291
 292    --------------
 293    -- Packages --
 294    --------------
 295
 296    Packages_Initial   : constant := 10;
 297    Packages_Increment : constant := 100;
 298
 299    Package_Node_Low_Bound  : constant := 0;
 300    Package_Node_High_Bound : constant := 099_999_999;
 301
 302    type Pkg_Node_Id is
 303      range Package_Node_Low_Bound .. Package_Node_High_Bound;
 304    --  Index type for table Package_Attributes in the body
 305
 306    type Package_Node_Id is record
 307       Value : Pkg_Node_Id := Package_Node_Low_Bound;
 308    end record;
 309    --  Full declaration of self-initialized private type
 310
 311    Empty_Pkg       : constant Pkg_Node_Id     := Package_Node_Low_Bound;
 312    Empty_Package   : constant Package_Node_Id := (Value => Empty_Pkg);
 313    Unknown_Pkg     : constant Pkg_Node_Id     := Package_Node_High_Bound;
 314    Unknown_Package : constant Package_Node_Id := (Value => Unknown_Pkg);
 315    First_Package   : constant Pkg_Node_Id     := Package_Node_Low_Bound + 1;
 316
 317    First_Package_Node_Id  : constant Package_Node_Id :=
 318                               (Value => First_Package);
 319
 320    Package_First : constant Package_Node_Id := First_Package_Node_Id;
 321
 322    ----------------
 323    -- Attributes --
 324    ----------------
 325
 326    type Attribute_Record is record
 327       Name           : Name_Id;
 328       Var_Kind       : Variable_Kind;
 329       Optional_Index : Boolean;
 330       Attr_Kind      : Attribute_Kind;
 331       Read_Only      : Boolean;
 332       Others_Allowed : Boolean;
 333       Default        : Attribute_Default_Value;
 334       Next           : Attr_Node_Id;
 335    end record;
 336    --  Data for an attribute
 337
 338    package Attrs is
 339       new Table.Table (Table_Component_Type => Attribute_Record,
 340                        Table_Index_Type     => Attr_Node_Id,
 341                        Table_Low_Bound      => First_Attribute,
 342                        Table_Initial        => Attributes_Initial,
 343                        Table_Increment      => Attributes_Increment,
 344                        Table_Name           => "Prj.Attr.Attrs");
 345    --  The table of the attributes
 346
 347    --------------
 348    -- Packages --
 349    --------------
 350
 351    type Package_Record is record
 352       Name             : Name_Id;
 353       Known            : Boolean := True;
 354       First_Attribute  : Attr_Node_Id;
 355    end record;
 356    --  Data for a package
 357
 358    package Package_Attributes is
 359       new Table.Table (Table_Component_Type => Package_Record,
 360                        Table_Index_Type     => Pkg_Node_Id,
 361                        Table_Low_Bound      => First_Package,
 362                        Table_Initial        => Packages_Initial,
 363                        Table_Increment      => Packages_Increment,
 364                        Table_Name           => "Prj.Attr.Packages");
 365    --  The table of the packages
 366
 367 end Prj.Attr;