| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- P R J . A T T R -- |
| -- -- |
| -- S p e c -- |
| -- -- |
| -- Copyright (C) 2001-2014, 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 3, 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 COPYING3. If not, go to -- |
| -- http://www.gnu.org/licenses for a complete copy of the license. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| -- This package defines packages and attributes in GNAT project files. |
| -- There are predefined packages and attributes. |
| |
| -- It is also possible to define new packages with their attributes |
| |
| with Table; |
| |
| with GNAT.Strings; |
| |
| package Prj.Attr is |
| |
| function Package_Name_List return GNAT.Strings.String_List; |
| -- Returns the list of valid package names, including those added by |
| -- procedures Register_New_Package below. The String_Access components of |
| -- the returned String_List should never be freed. |
| |
| procedure Initialize; |
| -- Initialize the predefined project level attributes and the predefined |
| -- packages and their attribute. This procedure should be called by |
| -- Prj.Initialize. |
| |
| type Attribute_Kind is ( |
| Unknown, |
| -- The attribute does not exist |
| |
| Single, |
| -- Single variable attribute (not an associative array) |
| |
| Associative_Array, |
| -- Associative array attribute with a case sensitive index |
| |
| Optional_Index_Associative_Array, |
| -- Associative array attribute with a case sensitive index and an |
| -- optional source index. |
| |
| Case_Insensitive_Associative_Array, |
| -- Associative array attribute with a case insensitive index |
| |
| Optional_Index_Case_Insensitive_Associative_Array |
| -- Associative array attribute with a case insensitive index and an |
| -- optional source index. |
| ); |
| -- Characteristics of an attribute. Optional_Index indicates that there |
| -- may be an optional index in the index of the associative array, as in |
| -- for Switches ("files.ada" at 2) use ... |
| |
| subtype Defined_Attribute_Kind is Attribute_Kind |
| range Single .. Optional_Index_Case_Insensitive_Associative_Array; |
| -- Subset of Attribute_Kinds that may be used for the attributes that is |
| -- used when defining a new package. |
| |
| subtype All_Case_Insensitive_Associative_Array is Attribute_Kind range |
| Case_Insensitive_Associative_Array .. |
| Optional_Index_Case_Insensitive_Associative_Array; |
| -- Subtype including both cases of Case_Insensitive_Associative_Array |
| |
| Max_Attribute_Name_Length : constant := 64; |
| -- The maximum length of attribute names |
| |
| subtype Attribute_Name_Length is |
| Positive range 1 .. Max_Attribute_Name_Length; |
| |
| type Attribute_Data (Name_Length : Attribute_Name_Length := 1) is record |
| Name : String (1 .. Name_Length); |
| -- The name of the attribute |
| |
| Attr_Kind : Defined_Attribute_Kind; |
| -- The type of the attribute |
| |
| Index_Is_File_Name : Boolean; |
| -- For associative arrays, indicate if the index is a file name, so |
| -- that the attribute kind may be modified depending on the case |
| -- sensitivity of file names. This is only taken into account when |
| -- Attr_Kind is Associative_Array or Optional_Index_Associative_Array. |
| |
| Opt_Index : Boolean; |
| -- True if there may be an optional index in the value of the index, |
| -- as in: |
| -- "file.ada" at 2 |
| -- ("main.adb", "file.ada" at 1) |
| |
| Var_Kind : Defined_Variable_Kind; |
| -- The attribute value kind: single or list |
| |
| Default : Attribute_Default_Value := Empty_Value; |
| -- The value of the attribute when referenced if the attribute has not |
| -- yet been declared. |
| |
| end record; |
| -- Name and characteristics of an attribute in a package registered |
| -- explicitly with Register_New_Package (see below). |
| |
| type Attribute_Data_Array is array (Positive range <>) of Attribute_Data; |
| -- A list of attribute name/characteristics to be used as parameter of |
| -- procedure Register_New_Package below. |
| |
| -- In the subprograms below, when it is specified that the subprogram |
| -- "fails", procedure Prj.Com.Fail is called. Unless it is specified |
| -- otherwise, if Prj.Com.Fail returns, exception Prj.Prj_Error is raised. |
| |
| procedure Register_New_Package |
| (Name : String; |
| Attributes : Attribute_Data_Array); |
| -- Add a new package with its attributes. This procedure can only be |
| -- called after Initialize, but before any other call to a service of |
| -- the Project Manager. Fail if the name of the package is empty or not |
| -- unique, or if the names of the attributes are not different. |
| |
| ---------------- |
| -- Attributes -- |
| ---------------- |
| |
| type Attribute_Node_Id is private; |
| -- The type to refers to an attribute, self-initialized |
| |
| Empty_Attribute : constant Attribute_Node_Id; |
| -- Indicates no attribute. Default value of Attribute_Node_Id objects |
| |
| Attribute_First : constant Attribute_Node_Id; |
| -- First attribute node id of project level attributes |
| |
| function Attribute_Node_Id_Of |
| (Name : Name_Id; |
| Starting_At : Attribute_Node_Id) return Attribute_Node_Id; |
| -- Returns the node id of an attribute at the project level or in |
| -- a package. Starting_At indicates the first known attribute node where |
| -- to start the search. Returns Empty_Attribute if the attribute cannot |
| -- be found. |
| |
| function Attribute_Kind_Of |
| (Attribute : Attribute_Node_Id) return Attribute_Kind; |
| -- Returns the attribute kind of a known attribute. Returns Unknown if |
| -- Attribute is Empty_Attribute. |
| -- |
| -- To use this function, the following code should be used: |
| -- |
| -- Pkg : constant Package_Node_Id := |
| -- Prj.Attr.Package_Node_Id_Of (Name => <package name>); |
| -- Att : constant Attribute_Node_Id := |
| -- Prj.Attr.Attribute_Node_Id_Of |
| -- (Name => <attribute name>, |
| -- Starting_At => First_Attribute_Of (Pkg)); |
| -- Kind : constant Attribute_Kind := Attribute_Kind_Of (Att); |
| -- |
| -- However, do not use this function once you have an already parsed |
| -- project tree. Instead, given a Project_Node_Id corresponding to the |
| -- attribute declaration ("for Attr (index) use ..."), use for example: |
| -- |
| -- if Case_Insensitive (Attr, Tree) then ... |
| |
| procedure Set_Attribute_Kind_Of |
| (Attribute : Attribute_Node_Id; |
| To : Attribute_Kind); |
| -- Set the attribute kind of a known attribute. Does nothing if |
| -- Attribute is Empty_Attribute. |
| |
| function Attribute_Name_Of (Attribute : Attribute_Node_Id) return Name_Id; |
| -- Returns the name of a known attribute. Returns No_Name if Attribute is |
| -- Empty_Attribute. |
| |
| function Variable_Kind_Of |
| (Attribute : Attribute_Node_Id) return Variable_Kind; |
| -- Returns the variable kind of a known attribute. Returns Undefined if |
| -- Attribute is Empty_Attribute. |
| |
| procedure Set_Variable_Kind_Of |
| (Attribute : Attribute_Node_Id; |
| To : Variable_Kind); |
| -- Set the variable kind of a known attribute. Does nothing if Attribute is |
| -- Empty_Attribute. |
| |
| function Attribute_Default_Of |
| (Attribute : Attribute_Node_Id) return Attribute_Default_Value; |
| -- Returns the default of the attribute, Read_Only_Value for read only |
| -- attributes, Empty_Value when default not specified, or specified value. |
| |
| function Optional_Index_Of (Attribute : Attribute_Node_Id) return Boolean; |
| -- Returns True if Attribute is a known attribute and may have an |
| -- optional index. Returns False otherwise. |
| |
| function Is_Read_Only (Attribute : Attribute_Node_Id) return Boolean; |
| |
| function Next_Attribute |
| (After : Attribute_Node_Id) return Attribute_Node_Id; |
| -- Returns the attribute that follow After in the list of project level |
| -- attributes or the list of attributes in a package. |
| -- Returns Empty_Attribute if After is either Empty_Attribute or is the |
| -- last of the list. |
| |
| function Others_Allowed_For (Attribute : Attribute_Node_Id) return Boolean; |
| -- True iff the index for an associative array attributes may be others |
| |
| -------------- |
| -- Packages -- |
| -------------- |
| |
| type Package_Node_Id is private; |
| -- Type to refer to a package, self initialized |
| |
| Empty_Package : constant Package_Node_Id; |
| -- Default value of Package_Node_Id objects |
| |
| Unknown_Package : constant Package_Node_Id; |
| -- Value of an unknown package that has been found but is unknown |
| |
| procedure Register_New_Package (Name : String; Id : out Package_Node_Id); |
| -- Add a new package. Fails if Name (the package name) is empty or is |
| -- already the name of a package, and set Id to Empty_Package, |
| -- if Prj.Com.Fail returns. Initially, the new package has no attributes. |
| -- Id may be used to add attributes using procedure Register_New_Attribute |
| -- below. |
| |
| procedure Register_New_Attribute |
| (Name : String; |
| In_Package : Package_Node_Id; |
| Attr_Kind : Defined_Attribute_Kind; |
| Var_Kind : Defined_Variable_Kind; |
| Index_Is_File_Name : Boolean := False; |
| Opt_Index : Boolean := False; |
| Default : Attribute_Default_Value := Empty_Value); |
| -- Add a new attribute to registered package In_Package. Fails if Name |
| -- (the attribute name) is empty, if In_Package is Empty_Package or if |
| -- the attribute name has a duplicate name. See definition of type |
| -- Attribute_Data above for the meaning of parameters Attr_Kind, Var_Kind, |
| -- Index_Is_File_Name, Opt_Index, and Default. |
| |
| function Package_Node_Id_Of (Name : Name_Id) return Package_Node_Id; |
| -- Returns the package node id of the package with name Name. Returns |
| -- Empty_Package if there is no package with this name. |
| |
| function First_Attribute_Of |
| (Pkg : Package_Node_Id) return Attribute_Node_Id; |
| -- Returns the first attribute in the list of attributes of package Pkg. |
| -- Returns Empty_Attribute if Pkg is Empty_Package or Unknown_Package. |
| |
| private |
| ---------------- |
| -- Attributes -- |
| ---------------- |
| |
| Attributes_Initial : constant := 50; |
| Attributes_Increment : constant := 100; |
| |
| Attribute_Node_Low_Bound : constant := 0; |
| Attribute_Node_High_Bound : constant := 099_999_999; |
| |
| type Attr_Node_Id is |
| range Attribute_Node_Low_Bound .. Attribute_Node_High_Bound; |
| -- Index type for table Attrs in the body |
| |
| type Attribute_Node_Id is record |
| Value : Attr_Node_Id := Attribute_Node_Low_Bound; |
| end record; |
| -- Full declaration of self-initialized private type |
| |
| Empty_Attr : constant Attr_Node_Id := Attribute_Node_Low_Bound; |
| |
| Empty_Attribute : constant Attribute_Node_Id := (Value => Empty_Attr); |
| |
| First_Attribute : constant Attr_Node_Id := Attribute_Node_Low_Bound + 1; |
| |
| First_Attribute_Node_Id : constant Attribute_Node_Id := |
| (Value => First_Attribute); |
| |
| Attribute_First : constant Attribute_Node_Id := First_Attribute_Node_Id; |
| |
| -------------- |
| -- Packages -- |
| -------------- |
| |
| Packages_Initial : constant := 10; |
| Packages_Increment : constant := 100; |
| |
| Package_Node_Low_Bound : constant := 0; |
| Package_Node_High_Bound : constant := 099_999_999; |
| |
| type Pkg_Node_Id is |
| range Package_Node_Low_Bound .. Package_Node_High_Bound; |
| -- Index type for table Package_Attributes in the body |
| |
| type Package_Node_Id is record |
| Value : Pkg_Node_Id := Package_Node_Low_Bound; |
| end record; |
| -- Full declaration of self-initialized private type |
| |
| Empty_Pkg : constant Pkg_Node_Id := Package_Node_Low_Bound; |
| Empty_Package : constant Package_Node_Id := (Value => Empty_Pkg); |
| Unknown_Pkg : constant Pkg_Node_Id := Package_Node_High_Bound; |
| Unknown_Package : constant Package_Node_Id := (Value => Unknown_Pkg); |
| First_Package : constant Pkg_Node_Id := Package_Node_Low_Bound + 1; |
| |
| First_Package_Node_Id : constant Package_Node_Id := |
| (Value => First_Package); |
| |
| Package_First : constant Package_Node_Id := First_Package_Node_Id; |
| |
| ---------------- |
| -- Attributes -- |
| ---------------- |
| |
| type Attribute_Record is record |
| Name : Name_Id; |
| Var_Kind : Variable_Kind; |
| Optional_Index : Boolean; |
| Attr_Kind : Attribute_Kind; |
| Read_Only : Boolean; |
| Others_Allowed : Boolean; |
| Default : Attribute_Default_Value; |
| Next : Attr_Node_Id; |
| end record; |
| -- Data for an attribute |
| |
| package Attrs is |
| new Table.Table (Table_Component_Type => Attribute_Record, |
| Table_Index_Type => Attr_Node_Id, |
| Table_Low_Bound => First_Attribute, |
| Table_Initial => Attributes_Initial, |
| Table_Increment => Attributes_Increment, |
| Table_Name => "Prj.Attr.Attrs"); |
| -- The table of the attributes |
| |
| -------------- |
| -- Packages -- |
| -------------- |
| |
| type Package_Record is record |
| Name : Name_Id; |
| Known : Boolean := True; |
| First_Attribute : Attr_Node_Id; |
| end record; |
| -- Data for a package |
| |
| package Package_Attributes is |
| new Table.Table (Table_Component_Type => Package_Record, |
| Table_Index_Type => Pkg_Node_Id, |
| Table_Low_Bound => First_Package, |
| Table_Initial => Packages_Initial, |
| Table_Increment => Packages_Increment, |
| Table_Name => "Prj.Attr.Packages"); |
| -- The table of the packages |
| |
| end Prj.Attr; |
