aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.8.3/gcc/ada/prj-attr.ads
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.8.3/gcc/ada/prj-attr.ads')
-rw-r--r--gcc-4.8.3/gcc/ada/prj-attr.ads356
1 files changed, 356 insertions, 0 deletions
diff --git a/gcc-4.8.3/gcc/ada/prj-attr.ads b/gcc-4.8.3/gcc/ada/prj-attr.ads
new file mode 100644
index 000000000..03e63d140
--- /dev/null
+++ b/gcc-4.8.3/gcc/ada/prj-attr.ads
@@ -0,0 +1,356 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- P R J . A T T R --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2001-2011, 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
+
+ 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 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);
+ -- 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 and Opt_Index.
+
+ 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.
+
+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;
+ 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;