-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2007, 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- --
+-- 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 COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- 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. --
-- --
------------------------------------------------------------------------------
-with Namet; use Namet;
with Osint;
with Prj.Com; use Prj.Com;
-with Table;
-
with System.Case_Util; use System.Case_Util;
package body Prj.Attr is
-- Data for predefined attributes and packages
- -- Names end with '#'
+ -- Names are in lower case and end with '#'
-- Package names are preceded by 'P'
- -- Attribute names are preceded by two letters:
+ -- Attribute names are preceded by two or three letters:
-- The first letter is one of
-- 'S' for Single
-- insensitive
-- 'c' same as 'b', with optional index
+ -- The third optional letter is
+ -- 'R' to indicate that the attribute is read-only
+
-- End is indicated by two consecutive '#'
Initialization_Data : constant String :=
- -- project attributes
-
- "SVobject_dir#" &
- "SVexec_dir#" &
- "LVsource_dirs#" &
- "LVsource_files#" &
- "LVlocally_removed_files#" &
- "SVsource_list_file#" &
- "SVlibrary_dir#" &
- "SVlibrary_name#" &
- "SVlibrary_kind#" &
- "SVlibrary_version#" &
- "LVlibrary_interface#" &
- "SVlibrary_auto_init#" &
- "LVlibrary_options#" &
- "SVlibrary_src_dir#" &
- "SVlibrary_ali_dir#" &
- "SVlibrary_gcc#" &
- "SVlibrary_symbol_file#" &
- "SVlibrary_symbol_policy#" &
- "SVlibrary_reference_symbol_file#" &
- "lVmain#" &
- "LVlanguages#" &
- "SVmain_language#" &
- "LVada_roots#" &
- "SVexternally_built#" &
+ -- project level attributes
+
+ -- General
+
+ "SVRname#" &
+ "lVmain#" &
+ "LVlanguages#" &
+ "SVmain_language#" &
+ "Laroots#" &
+ "SVexternally_built#" &
+
+ -- Directories
+
+ "SVobject_dir#" &
+ "SVexec_dir#" &
+ "LVsource_dirs#" &
+ "LVexcluded_source_dirs#" &
+
+ -- Source files
+
+ "LVsource_files#" &
+ "LVlocally_removed_files#" &
+ "LVexcluded_source_files#" &
+ "SVsource_list_file#" &
+
+ -- Libraries
+
+ "SVlibrary_dir#" &
+ "SVlibrary_name#" &
+ "SVlibrary_kind#" &
+ "SVlibrary_version#" &
+ "LVlibrary_interface#" &
+ "SVlibrary_auto_init#" &
+ "LVlibrary_options#" &
+ "SVlibrary_src_dir#" &
+ "SVlibrary_ali_dir#" &
+ "SVlibrary_gcc#" &
+ "SVlibrary_symbol_file#" &
+ "SVlibrary_symbol_policy#" &
+ "SVlibrary_reference_symbol_file#" &
+
+ -- Configuration - General
+
+ "SVdefault_language#" &
+ "LVrun_path_option#" &
+ "Satoolchain_version#" &
+ "Satoolchain_description#" &
+
+ -- Configuration - Libraries
+
+ "SVlibrary_builder#" &
+ "SVlibrary_support#" &
+
+ -- Configuration - Archives
+
+ "LVarchive_builder#" &
+ "LVarchive_indexer#" &
+ "SVarchive_suffix#" &
+ "LVlibrary_partial_linker#" &
+
+ -- Configuration - Shared libraries
+
+ "SVshared_library_prefix#" &
+ "SVshared_library_suffix#" &
+ "SVsymbolic_link_supported#" &
+ "SVlibrary_major_minor_id_supported#" &
+ "SVlibrary_auto_init_supported#" &
+ "LVshared_library_minimum_switches#" &
+ "LVlibrary_version_switches#" &
+ "Saruntime_library_dir#" &
-- package Naming
- "Pnaming#" &
- "Saspecification_suffix#" &
- "Saspec_suffix#" &
- "Saimplementation_suffix#" &
- "Sabody_suffix#" &
- "SVseparate_suffix#" &
- "SVcasing#" &
- "SVdot_replacement#" &
- "sAspecification#" &
- "sAspec#" &
- "sAimplementation#" &
- "sAbody#" &
- "Laspecification_exceptions#" &
- "Laimplementation_exceptions#" &
+ "Pnaming#" &
+ "Saspecification_suffix#" &
+ "Saspec_suffix#" &
+ "Saimplementation_suffix#" &
+ "Sabody_suffix#" &
+ "SVseparate_suffix#" &
+ "SVcasing#" &
+ "SVdot_replacement#" &
+ "sAspecification#" &
+ "sAspec#" &
+ "sAimplementation#" &
+ "sAbody#" &
+ "Laspecification_exceptions#" &
+ "Laimplementation_exceptions#" &
-- package Compiler
- "Pcompiler#" &
- "Ladefault_switches#" &
- "Lcswitches#" &
- "SVlocal_configuration_pragmas#" &
+ "Pcompiler#" &
+ "Ladefault_switches#" &
+ "Lcswitches#" &
+ "SVlocal_configuration_pragmas#" &
+ "Salocal_config_file#" &
+
+ -- Configuration - Compiling
+
+ "Sadriver#" &
+ "Larequired_switches#" &
+ "Lapic_option#" &
+
+ -- Configuration - Mapping files
+
+ "Lamapping_file_switches#" &
+ "Samapping_spec_suffix#" &
+ "Samapping_body_suffix#" &
+
+ -- Configuration - Config files
+
+ "Laconfig_file_switches#" &
+ "Saconfig_body_file_name#" &
+ "Saconfig_spec_file_name#" &
+ "Saconfig_body_file_name_pattern#" &
+ "Saconfig_spec_file_name_pattern#" &
+ "Saconfig_file_unique#" &
+
+ -- Configuration - Dependencies
+
+ "Ladependency_switches#" &
+ "Lacompute_dependency#" &
+
+ -- Configuration - Search paths
+
+ "Lainclude_switches#" &
+ "Sainclude_path#" &
+ "Sainclude_path_file#" &
-- package Builder
- "Pbuilder#" &
- "Ladefault_switches#" &
- "Lcswitches#" &
- "Scexecutable#" &
- "SVexecutable_suffix#" &
- "SVglobal_configuration_pragmas#" &
+ "Pbuilder#" &
+ "Ladefault_switches#" &
+ "Lcswitches#" &
+ "Scexecutable#" &
+ "SVexecutable_suffix#" &
+ "SVglobal_configuration_pragmas#" &
+ "Saglobal_config_file#" &
-- package gnatls
- "Pgnatls#" &
- "LVswitches#" &
+ "Pgnatls#" &
+ "LVswitches#" &
-- package Binder
- "Pbinder#" &
- "Ladefault_switches#" &
- "Lcswitches#" &
+ "Pbinder#" &
+ "Ladefault_switches#" &
+ "Lcswitches#" &
+
+ -- Configuration - Binding
+
+ "Sadriver#" &
+ "Larequired_switches#" &
+ "Saprefix#" &
+ "Saobjects_path#" &
+ "Saobjects_path_file#" &
-- package Linker
- "Plinker#" &
- "Ladefault_switches#" &
- "Lcswitches#" &
- "LVlinker_options#" &
+ "Plinker#" &
+ "LVrequired_switches#" &
+ "Ladefault_switches#" &
+ "Lcswitches#" &
+ "LVlinker_options#" &
+
+ -- Configuration - Linking
+
+ "SVdriver#" &
+ "LVexecutable_switch#" &
+ "SVlib_dir_switch#" &
+ "SVlib_name_switch#" &
-- package Cross_Reference
- "Pcross_reference#" &
- "Ladefault_switches#" &
- "Lbswitches#" &
+ "Pcross_reference#" &
+ "Ladefault_switches#" &
+ "Lbswitches#" &
-- package Finder
- "Pfinder#" &
- "Ladefault_switches#" &
- "Lbswitches#" &
+ "Pfinder#" &
+ "Ladefault_switches#" &
+ "Lbswitches#" &
-- package Pretty_Printer
- "Ppretty_printer#" &
- "Ladefault_switches#" &
- "Lbswitches#" &
+ "Ppretty_printer#" &
+ "Ladefault_switches#" &
+ "Lbswitches#" &
-- package gnatstub
- "Pgnatstub#" &
- "Ladefault_switches#" &
- "Lbswitches#" &
+ "Pgnatstub#" &
+ "Ladefault_switches#" &
+ "Lbswitches#" &
-- package Check
- "Pcheck#" &
- "Ladefault_switches#" &
- "Lbswitches#" &
+ "Pcheck#" &
+ "Ladefault_switches#" &
+ "Lbswitches#" &
-- package Eliminate
- "Peliminate#" &
- "Ladefault_switches#" &
- "Lbswitches#" &
+ "Peliminate#" &
+ "Ladefault_switches#" &
+ "Lbswitches#" &
-- package Metrics
- "Pmetrics#" &
- "Ladefault_switches#" &
- "Lbswitches#" &
+ "Pmetrics#" &
+ "Ladefault_switches#" &
+ "Lbswitches#" &
-- package Ide
- "Pide#" &
- "Ladefault_switches#" &
- "SVremote_host#" &
- "SVprogram_host#" &
- "SVcommunication_protocol#" &
- "Sacompiler_command#" &
- "SVdebugger_command#" &
- "SVgnatlist#" &
- "SVvcs_kind#" &
- "SVvcs_file_check#" &
- "SVvcs_log_check#" &
-
- -- package Language_Processing
-
- "Planguage_processing#" &
- "Lacompiler_driver#" &
- "Sacompiler_kind#" &
- "Ladependency_option#" &
- "Lacompute_dependency#" &
- "Lainclude_option#" &
- "Sabinder_driver#" &
- "SVdefault_linker#" &
-
- "#";
+ "Pide#" &
+ "Ladefault_switches#" &
+ "SVremote_host#" &
+ "SVprogram_host#" &
+ "SVcommunication_protocol#" &
+ "Sacompiler_command#" &
+ "SVdebugger_command#" &
+ "SVgnatlist#" &
+ "SVvcs_kind#" &
+ "SVvcs_file_check#" &
+ "SVvcs_log_check#" &
+
+ -- package Stack
+
+ "Pstack#" &
+ "LVswitches#" &
+
+ "#";
Initialized : Boolean := False;
-- A flag to avoid multiple initialization
Is_An_Attribute : Boolean := False;
Var_Kind : Variable_Kind := Undefined;
Optional_Index : Boolean := False;
- Attr_Kind : Attribute_Kind := Single;
+ Attr_Kind : Attribute_Kind := Single;
Package_Name : Name_Id := No_Name;
Attribute_Name : Name_Id := No_Name;
First_Attribute : Attr_Node_Id := Attr.First_Attribute;
+ Read_Only : Boolean;
function Attribute_Location return String;
-- Returns a string depending if we are in the project level attributes
Package_Attributes.Increment_Last;
Current_Package := Package_Attributes.Last;
Package_Attributes.Table (Current_Package) :=
- (Name => Package_Name,
- Known => True,
- First_Attribute => Empty_Attr);
+ (Name => Package_Name,
+ Known => True,
+ First_Attribute => Empty_Attr);
Start := Finish + 1;
when 'S' =>
end case;
Start := Start + 1;
+
+ if Initialization_Data (Start) = 'R' then
+ Read_Only := True;
+ Start := Start + 1;
+
+ else
+ Read_Only := False;
+ end if;
+
Finish := Start;
while Initialization_Data (Finish) /= '#' loop
Var_Kind => Var_Kind,
Optional_Index => Optional_Index,
Attr_Kind => Attr_Kind,
+ Read_Only => Read_Only,
Next => Empty_Attr);
Start := Finish + 1;
end if;
Initialized := True;
end Initialize;
+ ------------------
+ -- Is_Read_Only --
+ ------------------
+
+ function Is_Read_Only (Attribute : Attribute_Node_Id) return Boolean is
+ begin
+ return Attrs.Table (Attribute.Value).Read_Only;
+ end Is_Read_Only;
+
----------------
-- Name_Id_Of --
----------------
Var_Kind => Var_Kind,
Optional_Index => Opt_Index,
Attr_Kind => Real_Attr_Kind,
+ Read_Only => False,
Next => First_Attr);
Package_Attributes.Table (In_Package.Value).First_Attribute :=
Attrs.Last;
Package_Attributes.Increment_Last;
Id := (Value => Package_Attributes.Last);
Package_Attributes.Table (Package_Attributes.Last) :=
- (Name => Pkg_Name, Known => True, First_Attribute => Empty_Attr);
+ (Name => Pkg_Name,
+ Known => True,
+ First_Attribute => Empty_Attr);
end Register_New_Package;
procedure Register_New_Package
Var_Kind => Attributes (Index).Var_Kind,
Optional_Index => Attributes (Index).Opt_Index,
Attr_Kind => Attr_Kind,
+ Read_Only => False,
Next => First_Attr);
First_Attr := Attrs.Last;
end loop;
Package_Attributes.Increment_Last;
Package_Attributes.Table (Package_Attributes.Last) :=
- (Name => Pkg_Name, Known => True, First_Attribute => First_Attr);
+ (Name => Pkg_Name,
+ Known => True,
+ First_Attribute => First_Attr);
end Register_New_Package;
---------------------------
OSDN Git Service
