8sa1-gcc/gcc/ada/prj-attr.adb
Arnaud Charlet 19f0526a54 [multiple changes]
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
2003-11-20 10:54:03 +01:00

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;