19f0526a54
2003-11-19 Arnaud Charlet <charlet@act-europe.fr> * gnatmem.adb: Clean up verbose output. * gprcmd.adb: Change copyright to FSF. 2003-11-19 Vincent Celier <celier@gnat.com> * symbols.adb: (Initialize): New parameters Reference, Symbol_Policy and Version (ignored). * symbols.ads: (Policy): New type (Initialize): New parameter Reference, Symbol_Policy and Library_Version. Remove parameter Force. Minor reformatting. * snames.ads, snames.adbadb: New standard names Library_Reference_Symbol_File and Library_Symbol_Policy * mlib-prj.adb: (Build_Library): Call Build_Dinamic_Library with the Symbol_Data of the project. * mlib-tgt.adb: (Build_Dynamic_Library): New parameter Symbol_Data (ignored) * mlib-tgt.ads: (Build_Dynamic_Library): New parameter Symbol_Data * prj.adb: (Project_Empty): New component Symbol_Data * prj.ads: (Policy, Symbol_Record): New types (Project_Data): New component Symbol_Data * prj-attr.adb: New attributes Library_Symbol_File, Library_Symbol_Policy and Library_Reference_Symbol_File. * prj-nmsc.adb: (Ada_Check): When project is a Stand-Alone library project, process attribute Library_Symbol_File, Library_Symbol_Policy and Library_Reference_Symbol_File. * 5aml-tgt.adb, 5bml-tgt.adb, 5gml-tgt.adb, 5hml-tgt.adb, 5wml-tgt.adb, 5zml-tgt.adb, 5lml-tgt.adb, 5sml-tgt.adb (Build_Dynamic_Library): New parameter Symbol_Data (ignored). * 5vml-tgt.adb (VMS_Options): Remove --for-linker=gsmatch=equal,1,0 (Build_Dynamic_Library): New parameter Symbol_Data. New internal functions Option_File_Name and Version_String. Set new options of gnatsym related to symbol file, symbol policy and reference symbol file. * 5vsymbol.adb: Extensive modifications to take into account the reference symbol file, the symbol policy, the library version and to put in the symbol file the minor and major IDs. * bld.adb (Process_Declarative_Items): Put second argument of gprcmd to_absolute between single quotes, to avoid problems with Windows. * bld-io.adb: Update Copyright notice. (Flush): Remove last character of a line, if it is a back slash, to avoid make problems. * gnatsym.adb: Implement new scheme with reference symbol file and symbol policy. * g-os_lib.ads: (Is_Directory): Clarify comment 2003-11-19 Robert Dewar <dewar@gnat.com> * atree.adb: Move New_Copy_Tree global variables to head of package * errout.adb: Minor reformatting 2003-11-19 Javier Miranda <miranda@gnat.com> * sem_ch4.adb: (Diagnose_Call): Improve error message. Add reference to Ada0Y (AI-50217) * sem_ch6.adb, sem_ch8.adb, sem_type.adb, sem_util.adb: Add reference to AI-50217 * sinfo.ads: (N_With_Clause): Document fields referred to AI-50217 * sprint.adb: Add reference to Ada0Y (AI-50217, AI-287) * sem_aggr.adb: Complete documentation of AI-287 changes * par-ch4.adb: Document previous changes. * lib-load.adb, lib-writ.adb, einfo.ads, par-ch10.adb, sem_cat.adb, sem_ch3.adb, sem_ch10.adb, sem_ch12.adb: Add references to Ada0Y (AI-50217) * exp_aggr.adb: Add references to AI-287 in previous changes 2003-11-19 Ed Schonberg <schonberg@gnat.com> * exp_ch6.adb: (Add_Call_By_Copy_Node): Do not original node of rewritten expression in the rewriting is the result of an inlined call. * exp_ch6.adb (Add_Call_By_Copy_Node): If actual for (in-)out parameter is a type conversion, use original node to construct the post-call assignment, because expression may have been rewritten, e.g. if it is a packed array. * sem_attr.adb: (Resolve_Attribute, case 'Constrained): Attribute is legal in an inlined body, just as it is in an instance. Categorization routines * sem_ch12.adb (Analyze_Association, Instantiate_Formal_Subprogram, Instantiate_Object): Set proper sloc reference for message on missing actual. 2003-11-19 Thomas Quinot <quinot@act-europe.fr> * Makefile.in: Add FreeBSD libgnat pairs. * usage.adb: Fix typo in usage message. 2003-11-19 Jerome Guitton <guitton@act-europe.fr> * Makefile.in: On powerpc-wrs-vxworksae: Add s-thread.ad?, s-thrini.ad? and s-tiitho.adb to the full runtime, to support the pragma Thread_Body. Remove i-vthrea.ad? and s-tpae65.ad?, not needed anymore. * s-thread.adb: This file is now a dummy implementation of System.Thread. 2003-11-19 Sergey Rybin <rybin@act-europe.fr> * rtsfind.adb (Initialize): Add initialization for RTE_Is_Available 2003-11-19 Emmanuel Briot <briot@act-europe.fr> * xref_lib.adb (Parse_Identifier_Info): Add handling of generic instanciation references in the parent type description. From-SVN: r73757
319 lines
9.7 KiB
Ada
319 lines
9.7 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- P R J . A T T R --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 2001-2003 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- --
|
|
-- 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, 59 Temple Place - Suite 330, Boston, --
|
|
-- MA 02111-1307, USA. --
|
|
-- --
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
with Ada.Characters.Handling; use Ada.Characters.Handling;
|
|
with Namet; use Namet;
|
|
with Osint; use Osint;
|
|
with Output; use Output;
|
|
|
|
package body Prj.Attr is
|
|
|
|
-- Names end with '#'
|
|
|
|
-- Package names are preceded by 'P'
|
|
|
|
-- Attribute names are preceded by two letters
|
|
|
|
-- The first letter is one of
|
|
-- 'S' for Single
|
|
-- 'L' for list
|
|
|
|
-- The second letter is one of
|
|
-- 'V' for single variable
|
|
-- 'A' for associative array
|
|
-- 'a' for case insensitive associative array
|
|
-- 'b' for associative array, case insensitive if file names are case
|
|
-- insensitive
|
|
|
|
-- 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_gcc#" &
|
|
"SVlibrary_symbol_file#" &
|
|
"SVlibrary_symbol_policy#" &
|
|
"SVlibrary_reference_symbol_file#" &
|
|
"LVmain#" &
|
|
"LVlanguages#" &
|
|
"SVmain_language#" &
|
|
|
|
-- package Naming
|
|
|
|
"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#" &
|
|
"Lbswitches#" &
|
|
"SVlocal_configuration_pragmas#" &
|
|
|
|
-- package Builder
|
|
|
|
"Pbuilder#" &
|
|
"Ladefault_switches#" &
|
|
"Lbswitches#" &
|
|
"SAexecutable#" &
|
|
"SVexecutable_suffix#" &
|
|
"SVglobal_configuration_pragmas#" &
|
|
|
|
-- package gnatls
|
|
|
|
"Pgnatls#" &
|
|
"LVswitches#" &
|
|
|
|
-- package Binder
|
|
|
|
"Pbinder#" &
|
|
"Ladefault_switches#" &
|
|
"Lbswitches#" &
|
|
|
|
-- package Linker
|
|
|
|
"Plinker#" &
|
|
"Ladefault_switches#" &
|
|
"Lbswitches#" &
|
|
"LVlinker_options#" &
|
|
|
|
-- package Cross_Reference
|
|
|
|
"Pcross_reference#" &
|
|
"Ladefault_switches#" &
|
|
"Lbswitches#" &
|
|
|
|
-- package Finder
|
|
|
|
"Pfinder#" &
|
|
"Ladefault_switches#" &
|
|
"Lbswitches#" &
|
|
|
|
-- package Pretty_Printer
|
|
|
|
"Ppretty_printer#" &
|
|
"Ladefault_switches#" &
|
|
"Lbswitches#" &
|
|
|
|
-- package gnatstub
|
|
|
|
"Pgnatstub#" &
|
|
"Ladefault_switches#" &
|
|
"Lbswitches#" &
|
|
|
|
-- package Eliminate
|
|
|
|
"Peliminate#" &
|
|
"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#" &
|
|
|
|
"#";
|
|
|
|
----------------
|
|
-- Initialize --
|
|
----------------
|
|
|
|
procedure Initialize is
|
|
Start : Positive := Initialization_Data'First;
|
|
Finish : Positive := Start;
|
|
Current_Package : Package_Node_Id := Empty_Package;
|
|
Current_Attribute : Attribute_Node_Id := Empty_Attribute;
|
|
Is_An_Attribute : Boolean := False;
|
|
Kind_1 : Variable_Kind := Undefined;
|
|
Kind_2 : Attribute_Kind := Single;
|
|
Package_Name : Name_Id := No_Name;
|
|
Attribute_Name : Name_Id := No_Name;
|
|
First_Attribute : Attribute_Node_Id := Attribute_First;
|
|
|
|
begin
|
|
-- Make sure the two tables are empty
|
|
|
|
Attributes.Init;
|
|
Package_Attributes.Init;
|
|
|
|
while Initialization_Data (Start) /= '#' loop
|
|
Is_An_Attribute := True;
|
|
case Initialization_Data (Start) is
|
|
when 'P' =>
|
|
|
|
-- New allowed package
|
|
|
|
Start := Start + 1;
|
|
|
|
Finish := Start;
|
|
while Initialization_Data (Finish) /= '#' loop
|
|
Finish := Finish + 1;
|
|
end loop;
|
|
|
|
Name_Len := Finish - Start;
|
|
Name_Buffer (1 .. Name_Len) :=
|
|
To_Lower (Initialization_Data (Start .. Finish - 1));
|
|
Package_Name := Name_Find;
|
|
|
|
for Index in Package_First .. Package_Attributes.Last loop
|
|
if Package_Name = Package_Attributes.Table (Index).Name then
|
|
Write_Line ("Duplicate package name """ &
|
|
Initialization_Data (Start .. Finish - 1) &
|
|
""" in Prj.Attr body.");
|
|
raise Program_Error;
|
|
end if;
|
|
end loop;
|
|
|
|
Is_An_Attribute := False;
|
|
Current_Attribute := Empty_Attribute;
|
|
Package_Attributes.Increment_Last;
|
|
Current_Package := Package_Attributes.Last;
|
|
Package_Attributes.Table (Current_Package).Name :=
|
|
Package_Name;
|
|
Start := Finish + 1;
|
|
|
|
when 'S' =>
|
|
Kind_1 := Single;
|
|
|
|
when 'L' =>
|
|
Kind_1 := List;
|
|
|
|
when others =>
|
|
raise Program_Error;
|
|
end case;
|
|
|
|
if Is_An_Attribute then
|
|
|
|
-- New attribute
|
|
|
|
Start := Start + 1;
|
|
case Initialization_Data (Start) is
|
|
when 'V' =>
|
|
Kind_2 := Single;
|
|
|
|
when 'A' =>
|
|
Kind_2 := Associative_Array;
|
|
|
|
when 'a' =>
|
|
Kind_2 := Case_Insensitive_Associative_Array;
|
|
|
|
when 'b' =>
|
|
if File_Names_Case_Sensitive then
|
|
Kind_2 := Case_Insensitive_Associative_Array;
|
|
else
|
|
Kind_2 := Case_Insensitive_Associative_Array;
|
|
end if;
|
|
|
|
when others =>
|
|
raise Program_Error;
|
|
end case;
|
|
|
|
Start := Start + 1;
|
|
Finish := Start;
|
|
|
|
while Initialization_Data (Finish) /= '#' loop
|
|
Finish := Finish + 1;
|
|
end loop;
|
|
|
|
Name_Len := Finish - Start;
|
|
Name_Buffer (1 .. Name_Len) :=
|
|
To_Lower (Initialization_Data (Start .. Finish - 1));
|
|
Attribute_Name := Name_Find;
|
|
Attributes.Increment_Last;
|
|
if Current_Attribute = Empty_Attribute then
|
|
First_Attribute := Attributes.Last;
|
|
|
|
if Current_Package /= Empty_Package then
|
|
Package_Attributes.Table (Current_Package).First_Attribute
|
|
:= Attributes.Last;
|
|
end if;
|
|
|
|
else
|
|
-- Check that there are no duplicate attributes
|
|
|
|
for Index in First_Attribute .. Attributes.Last - 1 loop
|
|
if Attribute_Name =
|
|
Attributes.Table (Index).Name then
|
|
Write_Line ("Duplicate attribute name """ &
|
|
Initialization_Data (Start .. Finish - 1) &
|
|
""" in Prj.Attr body.");
|
|
raise Program_Error;
|
|
end if;
|
|
end loop;
|
|
|
|
Attributes.Table (Current_Attribute).Next :=
|
|
Attributes.Last;
|
|
end if;
|
|
|
|
Current_Attribute := Attributes.Last;
|
|
Attributes.Table (Current_Attribute) :=
|
|
(Name => Attribute_Name,
|
|
Kind_1 => Kind_1,
|
|
Kind_2 => Kind_2,
|
|
Next => Empty_Attribute);
|
|
Start := Finish + 1;
|
|
end if;
|
|
end loop;
|
|
end Initialize;
|
|
|
|
end Prj.Attr;
|