Skip to content

R
riscv-gcc-1
Commit b30668b7 by Vincent Celier Committed by Geert Bosch
Options

* make.adb: 

	(Add_Switches): reflect the changes for the switches attributes
	Default_Switches indexed by the programming language,
	Switches indexed by the file name.
	(Collect_Arguments_And_Compile): Idem.
	Reflect the attribute name changes.

	* prj-attr.adb:
	(Initialisation_Data): Change the names of some packages and
	attributes.
	(Initialize): process case insensitive associative arrays.

	* prj-attr.ads:
	(Attribute_Kind): Remove Both, add Case_Insensitive_Associative_Array.

	* prj-dect.adb:
	(Parse_Attribute_Declaration): For case insensitive associative
	 arrays, set the index string to lower case.

	* prj-env.adb:
	Reflect the changes of the project attributes.

	* prj-nmsc.adb:
	Replace Check_Naming_Scheme by Ada_Check and
	Language_Independent_Check.

	* prj-nmsc.ads:
	Replaced Check_Naming_Scheme by 2 procedures:
	Ada_Check and Language_Independent_Check.

	* prj-proc.adb:
	(Process_Declarative_Items): For case-insensitive associative
	arrays, set the index string to lower case.
	(Recursive_Check): Call Prj.Nmsc.Ada_Check, instead of
	Prj.Nmsc.Check_Naming_Scheme.

	* prj-tree.adb:
	(Case_Insensitive): New function
	(Set_Case_Insensitive): New procedure

	* prj-tree.ads:
	(Case_Insensitive): New function
	(Set_Case_Insensitive): New procedure
	(Project_Node_Record): New flag Case_Insensitive.

	* prj-util.adb:
	(Value_Of): new function to get the string value of a single
	string variable or attribute.

	* prj-util.ads:
	(Value_Of): new function to get the string value of a single
	string variable or attribute.

	* prj.adb:
	(Ada_Default_Spec_Suffix): New function
	(Ada_Default_Impl_Suffix): New function
	Change definitions of several constants to reflect
	new components of record types.

	* prj.ads:
	(Naming_Data): Change several components to reflect new
	elements of naming schemes.
	(Project_Data): New flags Sources_Present and
	Language_Independent_Checked.
	(Ada_Default_Spec_Suffix): New function.
	(Ada_Default_Impl_Suffix): New function.

	* snames.ads:
	Modification of predefined names for project manager: added
	Implementation, Specification_Exceptions, Implementation_Exceptions,
	Specification_Suffix, Implementation_Suffix, Separate_Suffix,
	Default_Switches, _Languages, Builder, Cross_Reference,
	Finder. Removed Body_Part, Specification_Append, Body_Append,
	Separate_Append, Gnatmake, Gnatxref, Gnatfind, Gnatbind,
	Gnatlink.

	* prj.ads: (Ada_Default_Spec_Suffix, Ada_Default_Impl_Suffix):
	Add comments.

	* prj-nmsc.adb (Ada_Check): Test that Separate_Suffix is defaulted,
	not that it is Nil_Variable_Value.

	* prj.ads: Add ??? for uncommented declarations

From-SVN: r46169
parent 662e57b4
Showing with 435 additions and 186 deletions
gcc/ada/ChangeLog
2001-10-10 Vincent Celier <celier@gnat.com>
* make.adb:
(Add_Switches): reflect the changes for the switches attributes
Default_Switches indexed by the programming language,
Switches indexed by the file name.
(Collect_Arguments_And_Compile): Idem.
Reflect the attribute name changes.
* prj-attr.adb:
(Initialisation_Data): Change the names of some packages and
attributes.
(Initialize): process case insensitive associative arrays.
* prj-attr.ads:
(Attribute_Kind): Remove Both, add Case_Insensitive_Associative_Array.
* prj-dect.adb:
(Parse_Attribute_Declaration): For case insensitive associative
arrays, set the index string to lower case.
* prj-env.adb:
Reflect the changes of the project attributes.
* prj-nmsc.adb:
Replace Check_Naming_Scheme by Ada_Check and
Language_Independent_Check.
* prj-nmsc.ads:
Replaced Check_Naming_Scheme by 2 procedures:
Ada_Check and Language_Independent_Check.
* prj-proc.adb:
(Process_Declarative_Items): For case-insensitive associative
arrays, set the index string to lower case.
(Recursive_Check): Call Prj.Nmsc.Ada_Check, instead of
Prj.Nmsc.Check_Naming_Scheme.
* prj-tree.adb:
(Case_Insensitive): New function
(Set_Case_Insensitive): New procedure
* prj-tree.ads:
(Case_Insensitive): New function
(Set_Case_Insensitive): New procedure
(Project_Node_Record): New flag Case_Insensitive.
* prj-util.adb:
(Value_Of): new function to get the string value of a single
string variable or attribute.
* prj-util.ads:
(Value_Of): new function to get the string value of a single
string variable or attribute.
* prj.adb:
(Ada_Default_Spec_Suffix): New function
(Ada_Default_Impl_Suffix): New function
Change definitions of several constants to reflect
new components of record types.
* prj.ads:
(Naming_Data): Change several components to reflect new
elements of naming schemes.
(Project_Data): New flags Sources_Present and
Language_Independent_Checked.
(Ada_Default_Spec_Suffix): New function.
(Ada_Default_Impl_Suffix): New function.
* snames.ads:
Modification of predefined names for project manager: added
Implementation, Specification_Exceptions, Implementation_Exceptions,
Specification_Suffix, Implementation_Suffix, Separate_Suffix,
Default_Switches, _Languages, Builder, Cross_Reference,
Finder. Removed Body_Part, Specification_Append, Body_Append,
Separate_Append, Gnatmake, Gnatxref, Gnatfind, Gnatbind,
Gnatlink.
* prj.ads: (Ada_Default_Spec_Suffix, Ada_Default_Impl_Suffix):
Add comments.
* prj-nmsc.adb (Ada_Check): Test that Separate_Suffix is defaulted,
not that it is Nil_Variable_Value.
* prj.ads: Add ??? for uncommented declarations
2001-10-10 Ed Schonberg <schonber@gnat.com>
* sem_prag.adb: (Analyze_Pragma, case External): If entity is a
......
gcc/ada/make.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.172 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
......@@ -623,15 +623,27 @@ package body Make is
Switch_List : String_List_Id;
Element : String_Element;
Switches_Array : constant Array_Element_Id :=
Prj.Util.Value_Of
(Name => Name_Switches,
In_Arrays => Packages.Table (The_Package).Decl.Arrays);
Default_Switches_Array : constant Array_Element_Id :=
Prj.Util.Value_Of
(Name => Name_Default_Switches,
In_Arrays => Packages.Table (The_Package).Decl.Arrays);
begin
if File_Name'Length > 0 then
Name_Len := File_Name'Length;
Name_Buffer (1 .. Name_Len) := File_Name;
Switches :=
Prj.Util.Value_Of
(Name => Name_Find,
Attribute_Or_Array_Name => Name_Switches,
In_Package => The_Package);
Prj.Util.Value_Of (Index => Name_Find, In_Array => Switches_Array);
if Switches = Nil_Variable_Value then
Switches := Prj.Util.Value_Of
(Index => Name_Ada,
In_Array => Default_Switches_Array);
end if;
case Switches.Kind is
when Undefined =>
......@@ -1660,11 +1672,32 @@ package body Make is
-- the specific switches for the current source,
-- or the global switches, if any.
Switches :=
Prj.Util.Value_Of
(Name => Source_File,
Attribute_Or_Array_Name => Name_Switches,
In_Package => Compiler_Package);
declare
Defaults : constant Array_Element_Id :=
Prj.Util.Value_Of
(Name => Name_Default_Switches,
In_Arrays => Packages.Table
(Compiler_Package).Decl.Arrays);
Switches_Array : constant Array_Element_Id :=
Prj.Util.Value_Of
(Name => Name_Switches,
In_Arrays => Packages.Table
(Compiler_Package).Decl.Arrays);
begin
Switches :=
Prj.Util.Value_Of
(Index => Source_File,
In_Array => Switches_Array);
if Switches = Nil_Variable_Value then
Switches :=
Prj.Util.Value_Of
(Index => Name_Ada, In_Array => Defaults);
end if;
end;
end if;
case Switches.Kind is
......@@ -2609,17 +2642,17 @@ package body Make is
Gnatmake : constant Prj.Package_Id :=
Prj.Util.Value_Of
(Name => Name_Gnatmake,
(Name => Name_Builder,
In_Packages => The_Packages);
Binder_Package : constant Prj.Package_Id :=
Prj.Util.Value_Of
(Name => Name_Gnatbind,
(Name => Name_Binder,
In_Packages => The_Packages);
Linker_Package : constant Prj.Package_Id :=
Prj.Util.Value_Of
(Name => Name_Gnatlink,
(Name => Name_Linker,
In_Packages => The_Packages);
begin
......@@ -2924,12 +2957,13 @@ package body Make is
Body_Append : constant String :=
Get_Name_String
(Projects.Table
(Main_Project).Naming.Body_Append);
(Main_Project).
Naming.Current_Impl_Suffix);
Spec_Append : constant String :=
Get_Name_String
(Projects.Table
(Main_Project).
Naming.Specification_Append);
Naming.Current_Spec_Suffix);
begin
Get_Name_String (Main_Source_File);
......@@ -3444,7 +3478,7 @@ package body Make is
-- Avoid looking in the current directory for ALI files
Opt.Look_In_Primary_Dir := False;
-- Opt.Look_In_Primary_Dir := False;
-- Set the project parsing verbosity to whatever was specified
-- by a possible -vP switch.
......
gcc/ada/prj-attr.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.4 $
-- $Revision$
-- --
-- Copyright (C) 2001 Free Software Foundation, Inc. --
-- --
......@@ -36,7 +36,8 @@ package body Prj.Attr is
-- Package names are preceded by 'P'
-- Attribute names are preceded by two capital letters:
-- 'S' for Single or 'L' for list, then
-- 'V' for single variable, 'A' for associative array, or 'B' for both.
-- 'V' for single variable, 'A' for associative array or
-- 'a' for case insensitive associative array.
-- End is indicated by two consecutive '#'.
Initialisation_Data : constant String :=
......@@ -53,28 +54,33 @@ package body Prj.Attr is
"SVlibrary_elaboration#" &
"SVlibrary_version#" &
"LVmain#" &
"LVlanguages#" &
-- package Naming
"Pnaming#" &
"SVspecification_append#" &
"SVbody_append#" &
"SVseparate_append#" &
"Saspecification_suffix#" &
"Saimplementation_suffix#" &
"SVseparate_suffix#" &
"SVcasing#" &
"SVdot_replacement#" &
"SAspecification#" &
"SAbody_part#" &
"SAimplementation#" &
"LAspecification_exceptions#" &
"LAimplementation_exceptions#" &
-- package Compiler
"Pcompiler#" &
"LBswitches#" &
"Ladefault_switches#" &
"LAswitches#" &
"SVlocal_configuration_pragmas#" &
-- package gnatmake
-- package Builder
"Pgnatmake#" &
"LBswitches#" &
"Pbuilder#" &
"Ladefault_switches#" &
"LAswitches#" &
"SVglobal_configuration_pragmas#" &
-- package gnatls
......@@ -82,15 +88,29 @@ package body Prj.Attr is
"Pgnatls#" &
"LVswitches#" &
-- package gnatbind
-- package Binder
"Pgnatbind#" &
"LBswitches#" &
"Pbinder#" &
"Ladefault_switches#" &
"LAswitches#" &
-- package gnatlink
-- package Linker
"Pgnatlink#" &
"LBswitches#" &
"Plinker#" &
"Ladefault_switches#" &
"LAswitches#" &
-- package Cross_Reference
"Pcross_reference#" &
"Ladefault_switches#" &
"LAswitches#" &
-- package Finder
"Pfinder#" &
"Ladefault_switches#" &
"LAswitches#" &
"#";
......@@ -162,8 +182,8 @@ package body Prj.Attr is
Kind_2 := Single;
when 'A' =>
Kind_2 := Associative_Array;
when 'B' =>
Kind_2 := Both;
when 'a' =>
Kind_2 := Case_Insensitive_Associative_Array;
when others =>
raise Program_Error;
end case;
......
gcc/ada/prj-attr.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.1 $
-- $Revision$
-- --
-- Copyright (C) 2001 Free Software Foundation, Inc. --
-- --
......@@ -51,7 +51,10 @@ package Prj.Attr is
Empty_Attribute : constant Attribute_Node_Id
:= Attribute_Node_Low_Bound;
type Attribute_Kind is (Single, Associative_Array, Both);
type Attribute_Kind is
(Single,
Associative_Array,
Case_Insensitive_Associative_Array);
type Attribute_Record is record
Name : Name_Id;
......
gcc/ada/prj-dect.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.5 $
-- $Revision$
-- --
-- Copyright (C) 2001 Free Software Foundation, Inc. --
-- --
......@@ -131,6 +131,13 @@ package body Prj.Dect is
if Token = Tok_Identifier then
Set_Name_Of (Attribute, To => Token_Name);
Set_Location_Of (Attribute, To => Token_Ptr);
if Attributes.Table (Current_Attribute).Kind_2 =
Case_Insensitive_Associative_Array
then
Set_Case_Insensitive (Attribute, To => True);
end if;
while Current_Attribute /= Empty_Attribute
and then
Attributes.Table (Current_Attribute).Name /= Token_Name
......
gcc/ada/prj-env.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.17 $
-- $Revision$
-- --
-- Copyright (C) 2001 Free Software Foundation, Inc. --
-- --
......@@ -470,7 +470,7 @@ package body Prj.Env is
(File, "pragma Source_File_Name");
Put_Line
(File, " (Spec_File_Name => ""*" &
Namet.Get_Name_String (Data.Naming.Specification_Append) &
Namet.Get_Name_String (Data.Naming.Current_Spec_Suffix) &
""",");
Put_Line
(File, " Casing => " &
......@@ -486,7 +486,7 @@ package body Prj.Env is
(File, "pragma Source_File_Name");
Put_Line
(File, " (Body_File_Name => ""*" &
Namet.Get_Name_String (Data.Naming.Body_Append) &
Namet.Get_Name_String (Data.Naming.Current_Impl_Suffix) &
""",");
Put_Line
(File, " Casing => " &
......@@ -498,12 +498,14 @@ package body Prj.Env is
-- and maybe separate
if Data.Naming.Body_Append /= Data.Naming.Separate_Append then
if
Data.Naming.Current_Impl_Suffix /= Data.Naming.Separate_Suffix
then
Put_Line
(File, "pragma Source_File_Name");
Put_Line
(File, " (Subunit_File_Name => ""*" &
Namet.Get_Name_String (Data.Naming.Separate_Append) &
Namet.Get_Name_String (Data.Naming.Separate_Suffix) &
""",");
Put_Line
(File, " Casing => " &
......@@ -714,7 +716,7 @@ package body Prj.Env is
The_Packages := Projects.Table (Main_Project).Decl.Packages;
Gnatmake :=
Prj.Util.Value_Of
(Name => Name_Gnatmake,
(Name => Name_Builder,
In_Packages => The_Packages);
if Gnatmake /= No_Package then
......@@ -800,10 +802,10 @@ package body Prj.Env is
Extended_Spec_Name : String :=
Name & Namet.Get_Name_String
(Data.Naming.Specification_Append);
(Data.Naming.Current_Spec_Suffix);
Extended_Body_Name : String :=
Name & Namet.Get_Name_String
(Data.Naming.Body_Append);
(Data.Naming.Current_Impl_Suffix);
Unit : Unit_Data;
......@@ -1252,10 +1254,10 @@ package body Prj.Env is
Extended_Spec_Name : String :=
Name & Namet.Get_Name_String
(Data.Naming.Specification_Append);
(Data.Naming.Current_Spec_Suffix);
Extended_Body_Name : String :=
Name & Namet.Get_Name_String
(Data.Naming.Body_Append);
(Data.Naming.Current_Impl_Suffix);
First : Unit_Id := Units.First;
Current : Unit_Id;
......
gcc/ada/prj-nmsc.adb
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/prj-nmsc.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.3 $
-- $Revision$
-- --
-- Copyright (C) 2000-2001 Free Software Foundation, Inc. --
-- --
......@@ -31,12 +31,21 @@
private package Prj.Nmsc is
procedure Check_Naming_Scheme
procedure Ada_Check
(Project : Project_Id;
Report_Error : Put_Line_Access);
-- Check that the Naming Scheme of a project is legal. Find the
-- object directory, the source directories, and the source files.
-- Check the source files against the Naming Scheme.
-- Call Language_Independent_Check.
-- Check the naming scheme for Ada.
-- Find the Ada source files if any.
-- If Report_Error is null , use the standard error reporting mechanism
-- (Errout). Otherwise, report errors using Report_Error.
procedure Language_Independent_Check
(Project : Project_Id;
Report_Error : Put_Line_Access);
-- Check the object directory and the source directories.
-- Check the library attributes, including the library directory if any.
-- Get the set of specification and implementation suffixs, if any.
-- If Report_Error is null , use the standard error reporting mechanism
-- (Errout). Otherwise, report errors using Report_Error.
......
gcc/ada/prj-proc.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.16 $
-- $Revision$
-- --
-- Copyright (C) 2001 Free Software Foundation, Inc. --
-- --
......@@ -27,6 +27,7 @@
------------------------------------------------------------------------------
with Errout; use Errout;
with GNAT.Case_Util;
with Namet; use Namet;
with Opt;
with Output; use Output;
......@@ -1015,6 +1016,10 @@ package body Prj.Proc is
String_To_Name_Buffer
(Associative_Array_Index_Of (Current_Item));
if Case_Insensitive (Current_Item) then
GNAT.Case_Util.To_Lower (Name_Buffer (1 .. Name_Len));
end if;
declare
The_Array : Array_Id;
......@@ -1260,7 +1265,7 @@ package body Prj.Proc is
Write_Line ("""");
end if;
Prj.Nmsc.Check_Naming_Scheme (Project, Error_Report);
Prj.Nmsc.Ada_Check (Project, Error_Report);
end if;
end Recursive_Check;
......
gcc/ada/prj-tree.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.7 $
-- $Revision$
-- --
-- Copyright (C) 2001 Free Software Foundation, Inc. --
-- --
......@@ -48,6 +48,19 @@ package body Prj.Tree is
return Project_Nodes.Table (Node).Value;
end Associative_Array_Index_Of;
----------------------
-- Case_Insensitive --
----------------------
function Case_Insensitive (Node : Project_Node_Id) return Boolean is
begin
pragma Assert
(Node /= Empty_Node
and then
(Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
return Project_Nodes.Table (Node).Case_Insensitive;
end Case_Insensitive;
--------------------------------
-- Case_Variable_Reference_Of --
--------------------------------
......@@ -108,19 +121,20 @@ package body Prj.Tree is
begin
Project_Nodes.Increment_Last;
Project_Nodes.Table (Project_Nodes.Last) :=
(Kind => Of_Kind,
Location => No_Location,
Directory => No_Name,
Expr_Kind => And_Expr_Kind,
Variables => Empty_Node,
Packages => Empty_Node,
Pkg_Id => Empty_Package,
Name => No_Name,
Path_Name => No_Name,
Value => No_String,
Field1 => Empty_Node,
Field2 => Empty_Node,
Field3 => Empty_Node);
(Kind => Of_Kind,
Location => No_Location,
Directory => No_Name,
Expr_Kind => And_Expr_Kind,
Variables => Empty_Node,
Packages => Empty_Node,
Pkg_Id => Empty_Package,
Name => No_Name,
Path_Name => No_Name,
Value => No_String,
Field1 => Empty_Node,
Field2 => Empty_Node,
Field3 => Empty_Node,
Case_Insensitive => False);
return Project_Nodes.Last;
end Default_Project_Node;
......@@ -723,6 +737,22 @@ package body Prj.Tree is
Project_Nodes.Table (Node).Value := To;
end Set_Associative_Array_Index_Of;
--------------------------
-- Set_Case_Insensitive --
--------------------------
procedure Set_Case_Insensitive
(Node : Project_Node_Id;
To : Boolean)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Attribute_Declaration);
Project_Nodes.Table (Node).Case_Insensitive := To;
end Set_Case_Insensitive;
------------------------------------
-- Set_Case_Variable_Reference_Of --
------------------------------------
......
gcc/ada/prj-tree.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.9 $
-- $Revision$
-- --
-- Copyright (C) 2001 Free Software Foundation, Inc. --
-- --
......@@ -306,6 +306,9 @@ package Prj.Tree is
return Project_Node_Id;
-- Only valid for N_Case_Item nodes
function Case_Insensitive (Node : Project_Node_Id) return Boolean;
-- Only valid for N_Attribute_Declaration nodes
--------------------
-- Set Procedures --
--------------------
......@@ -480,6 +483,10 @@ package Prj.Tree is
(Node : Project_Node_Id;
To : Project_Node_Id);
procedure Set_Case_Insensitive
(Node : Project_Node_Id;
To : Boolean);
-------------------------------
-- Restricted Access Section --
-------------------------------
......@@ -491,43 +498,47 @@ package Prj.Tree is
type Project_Node_Record is record
Kind : Project_Node_Kind;
Kind : Project_Node_Kind;
Location : Source_Ptr := No_Location;
Location : Source_Ptr := No_Location;
Directory : Name_Id := No_Name;
Directory : Name_Id := No_Name;
-- Only for N_Project
Expr_Kind : Variable_Kind := Undefined;
Expr_Kind : Variable_Kind := Undefined;
-- See below for what Project_Node_Kind it is used
Variables : Variable_Node_Id := Empty_Node;
Variables : Variable_Node_Id := Empty_Node;
-- First variable in a project or a package
Packages : Package_Declaration_Id := Empty_Node;
Packages : Package_Declaration_Id := Empty_Node;
-- First package declaration in a project
Pkg_Id : Package_Node_Id := Empty_Package;
Pkg_Id : Package_Node_Id := Empty_Package;
-- Only use in Package_Declaration
Name : Name_Id := No_Name;
Name : Name_Id := No_Name;
-- See below for what Project_Node_Kind it is used
Path_Name : Name_Id := No_Name;
Path_Name : Name_Id := No_Name;
-- See below for what Project_Node_Kind it is used
Value : String_Id := No_String;
Value : String_Id := No_String;
-- See below for what Project_Node_Kind it is used
Field1 : Project_Node_Id := Empty_Node;
Field1 : Project_Node_Id := Empty_Node;
-- See below the meaning for each Project_Node_Kind
Field2 : Project_Node_Id := Empty_Node;
Field2 : Project_Node_Id := Empty_Node;
-- See below the meaning for each Project_Node_Kind
Field3 : Project_Node_Id := Empty_Node;
Field3 : Project_Node_Id := Empty_Node;
-- See below the meaning for each Project_Node_Kind
Case_Insensitive : Boolean := False;
-- Indicates, for an associative array attribute, that the
-- index is case insensitive.
end record;
-- type Project_Node_Kind is
......
gcc/ada/prj-util.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.8 $ --
-- $Revision$ --
-- --
-- Copyright (C) 2001 Free Software Foundation, Inc. --
-- --
......@@ -188,6 +188,22 @@ package body Prj.Util is
--------------
function Value_Of
(Variable : Variable_Value;
Default : String)
return String is
begin
if Variable.Kind /= Single
or else Variable.Default
or else Variable.Value = No_String then
return Default;
else
String_To_Name_Buffer (Variable.Value);
return Name_Buffer (1 .. Name_Len);
end if;
end Value_Of;
function Value_Of
(Index : Name_Id;
In_Array : Array_Element_Id)
return Name_Id
......
gcc/ada/prj-util.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.6 $
-- $Revision$
-- --
-- Copyright (C) 2001 Free Software Foundation, Inc. --
-- --
......@@ -34,6 +34,13 @@ with Types; use Types;
package Prj.Util is
function Value_Of
(Variable : Variable_Value;
Default : String)
return String;
-- Get the value of a single string variable. If Variable is
-- Nil_Variable_Value, is a string list or is defaulted, return Default.
function Value_Of
(Index : Name_Id;
In_Array : Array_Element_Id)
return Name_Id;
......@@ -53,7 +60,7 @@ package Prj.Util is
(Name : Name_Id;
Attribute_Or_Array_Name : Name_Id;
In_Package : Package_Id)
return Variable_Value;
return Variable_Value;
-- In a specific package,
-- - if there exists an array Variable_Or_Array_Name with an index
-- Name, returns the corresponding component,
......@@ -76,41 +83,36 @@ package Prj.Util is
(Name : Name_Id;
In_Arrays : Array_Id)
return Array_Element_Id;
-- Returns a specified array in an array list.
-- Returns No_Array_Element if In_Arrays is null or if Name is not the
-- name of an array in In_Arrays.
-- Assumption: Name is in lower case.
-- Returns a specified array in an array list. Returns No_Array_Element
-- if In_Arrays is null or if Name is not the name of an array in
-- In_Arrays. The caller must ensure that Name is in lower case.
function Value_Of
(Name : Name_Id;
In_Packages : Package_Id)
return Package_Id;
-- Returns a specified package in a package list.
-- Returns No_Package if In_Packages is null or if Name is not the
-- name of a package in Package_List.
-- Assumption: Name is in lower case.
-- Returns a specified package in a package list. Returns No_Package
-- if In_Packages is null or if Name is not the name of a package in
-- Package_List. The caller must ensure that Name is in lower case.
function Value_Of
(Variable_Name : Name_Id;
In_Variables : Variable_Id)
return Variable_Value;
-- Returns a specified variable in a variable list.
-- Returns null if In_Variables is null or if Variable_Name
-- is not the name of a variable in In_Variables.
-- Assumption: Variable_Name is in lower case.
-- Returns a specified variable in a variable list. Returns null if
-- In_Variables is null or if Variable_Name is not the name of a
-- variable in In_Variables. Caller must ensure that Name is lower case.
procedure Write_Str
(S : String;
Max_Length : Positive;
Separator : Character);
-- Output string S using Output.Write_Str.
-- If S is too long to fit in one line of Max_Length, cut it in
-- several lines, using Separator as the last character of each line,
-- if possible.
-- Output string S using Output.Write_Str. If S is too long to fit in
-- one line of Max_Length, cut it in several lines, using Separator as
-- the last character of each line, if possible.
type Text_File is limited private;
-- Represents a text file.
-- Default is invalid text file.
-- Represents a text file. Default is invalid text file.
function Is_Valid (File : Text_File) return Boolean;
-- Returns True if File designates an open text file that
......
gcc/ada/prj.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.16 $
-- $Revision$
-- --
-- Copyright (C) 2001 Free Software Foundation, Inc. --
-- --
......@@ -30,7 +30,6 @@ with Ada.Characters.Handling; use Ada.Characters.Handling;
with Errout; use Errout;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with Namet; use Namet;
with Osint; use Osint;
with Prj.Attr;
with Prj.Com;
with Prj.Env;
......@@ -42,7 +41,10 @@ with Snames; use Snames;
package body Prj is
The_Empty_String : String_Id;
The_Empty_String : String_Id;
Default_Ada_Spec_Suffix : Name_Id := No_Name;
Default_Ada_Impl_Suffix : Name_Id := No_Name;
subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
......@@ -55,52 +57,74 @@ package body Prj is
Standard_Dot_Replacement : constant Name_Id :=
First_Name_Id + Character'Pos ('-');
Standard_Specification_Append : Name_Id;
Standard_Body_Append : Name_Id;
Std_Naming_Data : Naming_Data :=
(Dot_Replacement => Standard_Dot_Replacement,
Dot_Repl_Loc => No_Location,
Casing => All_Lower_Case,
Specification_Append => No_Name,
Spec_Append_Loc => No_Location,
Body_Append => No_Name,
Body_Append_Loc => No_Location,
Separate_Append => No_Name,
Sep_Append_Loc => No_Location,
Specifications => No_Array_Element,
Bodies => No_Array_Element);
Project_Empty : Project_Data :=
(First_Referred_By => No_Project,
Name => No_Name,
Path_Name => No_Name,
Location => No_Location,
Directory => No_Name,
File_Name => No_Name,
Library => False,
Library_Dir => No_Name,
Library_Name => No_Name,
Library_Kind => Static,
Lib_Internal_Name => No_Name,
Lib_Elaboration => False,
Sources => Nil_String,
Source_Dirs => Nil_String,
Object_Directory => No_Name,
Modifies => No_Project,
Modified_By => No_Project,
Naming => Std_Naming_Data,
Decl => No_Declarations,
Imported_Projects => Empty_Project_List,
Include_Path => null,
Objects_Path => null,
Config_File_Name => No_Name,
Config_File_Temp => False,
Config_Checked => False,
Checked => False,
Seen => False,
Flag1 => False,
Flag2 => False);
(Current_Language => No_Name,
Dot_Replacement => Standard_Dot_Replacement,
Dot_Repl_Loc => No_Location,
Casing => All_Lower_Case,
Specification_Suffix => No_Array_Element,
Current_Spec_Suffix => No_Name,
Spec_Suffix_Loc => No_Location,
Implementation_Suffix => No_Array_Element,
Current_Impl_Suffix => No_Name,
Impl_Suffix_Loc => No_Location,
Separate_Suffix => No_Name,
Sep_Suffix_Loc => No_Location,
Specifications => No_Array_Element,
Bodies => No_Array_Element,
Specification_Exceptions => No_Array_Element,
Implementation_Exceptions => No_Array_Element);
Project_Empty : constant Project_Data :=
(First_Referred_By => No_Project,
Name => No_Name,
Path_Name => No_Name,
Location => No_Location,
Directory => No_Name,
Library => False,
Library_Dir => No_Name,
Library_Name => No_Name,
Library_Kind => Static,
Lib_Internal_Name => No_Name,
Lib_Elaboration => False,
Sources_Present => True,
Sources => Nil_String,
Source_Dirs => Nil_String,
Object_Directory => No_Name,
Modifies => No_Project,
Modified_By => No_Project,
Naming => Std_Naming_Data,
Decl => No_Declarations,
Imported_Projects => Empty_Project_List,
Include_Path => null,
Objects_Path => null,
Config_File_Name => No_Name,
Config_File_Temp => False,
Config_Checked => False,
Language_Independent_Checked => False,
Checked => False,
Seen => False,
Flag1 => False,
Flag2 => False);
-----------------------------
-- Ada_Default_Spec_Suffix --
-----------------------------
function Ada_Default_Spec_Suffix return Name_Id is
begin
return Default_Ada_Spec_Suffix;
end Ada_Default_Spec_Suffix;
-----------------------------
-- Ada_Default_Impl_Suffix --
-----------------------------
function Ada_Default_Impl_Suffix return Name_Id is
begin
return Default_Ada_Impl_Suffix;
end Ada_Default_Impl_Suffix;
-------------------
-- Empty_Project --
......@@ -192,15 +216,13 @@ package body Prj is
The_Empty_String := End_String;
Name_Len := 4;
Name_Buffer (1 .. 4) := ".ads";
Canonical_Case_File_Name (Name_Buffer (1 .. 4));
Standard_Specification_Append := Name_Find;
Name_Buffer (4) := 'b';
Canonical_Case_File_Name (Name_Buffer (1 .. 4));
Standard_Body_Append := Name_Find;
Std_Naming_Data.Specification_Append := Standard_Specification_Append;
Std_Naming_Data.Body_Append := Standard_Body_Append;
Std_Naming_Data.Separate_Append := Standard_Body_Append;
Project_Empty.Naming := Std_Naming_Data;
Default_Ada_Spec_Suffix := Name_Find;
Name_Len := 4;
Name_Buffer (1 .. 4) := ".adb";
Default_Ada_Impl_Suffix := Name_Find;
Std_Naming_Data.Current_Spec_Suffix := Default_Ada_Spec_Suffix;
Std_Naming_Data.Current_Impl_Suffix := Default_Ada_Impl_Suffix;
Std_Naming_Data.Separate_Suffix := Default_Ada_Impl_Suffix;
Prj.Env.Initialize;
Prj.Attr.Initialize;
Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
......@@ -236,9 +258,9 @@ package body Prj is
begin
return Left.Dot_Replacement = Right.Dot_Replacement
and then Left.Casing = Right.Casing
and then Left.Specification_Append = Right.Specification_Append
and then Left.Body_Append = Right.Body_Append
and then Left.Separate_Append = Right.Separate_Append;
and then Left.Current_Spec_Suffix = Right.Current_Spec_Suffix
and then Left.Current_Impl_Suffix = Right.Current_Impl_Suffix
and then Left.Separate_Suffix = Right.Separate_Suffix;
end Same_Naming_Scheme;
----------
......
gcc/ada/snames.ads
......@@ -862,7 +862,7 @@ package Snames is
Name_Project : constant Name_Id := N + 523;
Name_Modifying : constant Name_Id := N + 524;
-- Name_External is already declared as N + 243
-- Name_External is already declared as N + 161
-- Names used in GNAT Project Files
......@@ -870,32 +870,34 @@ package Snames is
Name_Object_Dir : constant Name_Id := N + 526;
Name_Source_Dirs : constant Name_Id := N + 527;
Name_Specification : constant Name_Id := N + 528;
Name_Body_Part : constant Name_Id := N + 529;
Name_Specification_Append : constant Name_Id := N + 530;
Name_Body_Append : constant Name_Id := N + 531;
Name_Separate_Append : constant Name_Id := N + 532;
Name_Source_Files : constant Name_Id := N + 533;
Name_Source_List_File : constant Name_Id := N + 534;
Name_Switches : constant Name_Id := N + 535;
Name_Library_Dir : constant Name_Id := N + 536;
Name_Library_Name : constant Name_Id := N + 537;
Name_Library_Kind : constant Name_Id := N + 538;
Name_Library_Version : constant Name_Id := N + 539;
Name_Library_Elaboration : constant Name_Id := N + 540;
Name_Gnatmake : constant Name_Id := N + 541;
Name_Gnatls : constant Name_Id := N + 542;
Name_Gnatxref : constant Name_Id := N + 543;
Name_Gnatfind : constant Name_Id := N + 544;
Name_Gnatbind : constant Name_Id := N + 545;
Name_Gnatlink : constant Name_Id := N + 546;
Name_Compiler : constant Name_Id := N + 547;
Name_Binder : constant Name_Id := N + 548;
Name_Linker : constant Name_Id := N + 549;
Name_Implementation : constant Name_Id := N + 529;
Name_Specification_Exceptions : constant Name_Id := N + 530;
Name_Implementation_Exceptions : constant Name_Id := N + 531;
Name_Specification_Suffix : constant Name_Id := N + 532;
Name_Implementation_Suffix : constant Name_Id := N + 533;
Name_Separate_Suffix : constant Name_Id := N + 534;
Name_Source_Files : constant Name_Id := N + 535;
Name_Source_List_File : constant Name_Id := N + 536;
Name_Default_Switches : constant Name_Id := N + 537;
Name_Switches : constant Name_Id := N + 538;
Name_Library_Dir : constant Name_Id := N + 539;
Name_Library_Name : constant Name_Id := N + 540;
Name_Library_Kind : constant Name_Id := N + 541;
Name_Library_Version : constant Name_Id := N + 542;
Name_Library_Elaboration : constant Name_Id := N + 543;
Name_Languages : constant Name_Id := N + 544;
Name_Builder : constant Name_Id := N + 545;
Name_Gnatls : constant Name_Id := N + 546;
Name_Cross_Reference : constant Name_Id := N + 547;
Name_Finder : constant Name_Id := N + 548;
Name_Binder : constant Name_Id := N + 549;
Name_Linker : constant Name_Id := N + 550;
Name_Compiler : constant Name_Id := N + 551;
-- Mark last defined name for consistency check in Snames body
Last_Predefined_Name : constant Name_Id := N + 549;
Last_Predefined_Name : constant Name_Id := N + 551;
subtype Any_Operator_Name is Name_Id range
First_Operator_Name .. Last_Operator_Name;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment