Skip to content

R
riscv-gcc-1
Commit 944f7f28 by Vincent Celier Committed by Arnaud Charlet
Options

gnatcmd.adb: Add processing for GNAT SYNC 

2008-03-26  Vincent Celier  <celier@adacore.com>

	* gnatcmd.adb: Add processing for GNAT SYNC

	* vms_conv.ads: (Command_Type): Add command Sync

	* vms_conv.adb (Initialize): Add Command_List data for new command Sync

	* vms_data.ads: Add entries for -gnatw.w
	Add qualifier for gnatstub --header-file option
	Add switches for GNAT SYNC

	* prj-attr.ads, prj-attr.adb: Add new package Synchronize for GNAT SYNC
	(Add_Package_Name): New procedure
	(Package_Name_List): New function
	(Initialize): Add known package names to the list
	(Register_New_Package): Add the new package name to the list

From-SVN: r133567
parent 26658d3a
Showing with 104 additions and 20 deletions
gcc/ada/gnatcmd.adb
......@@ -118,19 +118,22 @@ procedure GNATCmd is
-- tool. We allocate objects because we cannot declare aliased objects
-- as we are in a procedure, not a library level package.
Naming_String : constant String_Access := new String'("naming");
Binder_String : constant String_Access := new String'("binder");
Compiler_String : constant String_Access := new String'("compiler");
Check_String : constant String_Access := new String'("check");
Eliminate_String : constant String_Access := new String'("eliminate");
Finder_String : constant String_Access := new String'("finder");
Linker_String : constant String_Access := new String'("linker");
Gnatls_String : constant String_Access := new String'("gnatls");
Pretty_String : constant String_Access := new String'("pretty_printer");
Stack_String : constant String_Access := new String'("stack");
Gnatstub_String : constant String_Access := new String'("gnatstub");
Metric_String : constant String_Access := new String'("metrics");
Xref_String : constant String_Access := new String'("cross_reference");
subtype SA is String_Access;
Naming_String : constant SA := new String'("naming");
Binder_String : constant SA := new String'("binder");
Compiler_String : constant SA := new String'("compiler");
Check_String : constant SA := new String'("check");
Synchronize_String : constant SA := new String'("synchronize");
Eliminate_String : constant SA := new String'("eliminate");
Finder_String : constant SA := new String'("finder");
Linker_String : constant SA := new String'("linker");
Gnatls_String : constant SA := new String'("gnatls");
Pretty_String : constant SA := new String'("pretty_printer");
Stack_String : constant SA := new String'("stack");
Gnatstub_String : constant SA := new String'("gnatstub");
Metric_String : constant SA := new String'("metrics");
Xref_String : constant SA := new String'("cross_reference");
Packages_To_Check_By_Binder : constant String_List_Access :=
new String_List'((Naming_String, Binder_String));
......@@ -138,6 +141,9 @@ procedure GNATCmd is
Packages_To_Check_By_Check : constant String_List_Access :=
new String_List'((Naming_String, Check_String, Compiler_String));
Packages_To_Check_By_Sync : constant String_List_Access :=
new String_List'((Naming_String, Synchronize_String, Compiler_String));
Packages_To_Check_By_Eliminate : constant String_List_Access :=
new String_List'((Naming_String, Eliminate_String, Compiler_String));
......@@ -549,8 +555,9 @@ procedure GNATCmd is
end if;
else
-- For gnatcheck, gnatpp and gnatmetric, put all sources
-- of the project, or of all projects if -U was specified.
-- For gnatcheck, gnatsync, gnatpp and gnatmetric, put all
-- sources of the project, or of all projects if -U was
-- specified.
for Kind in Spec_Or_Body loop
if Check_Project
......@@ -1561,6 +1568,7 @@ begin
if The_Command = Bind
or else The_Command = Check
or else The_Command = Sync
or else The_Command = Elim
or else The_Command = Find
or else The_Command = Link
......@@ -1578,6 +1586,9 @@ begin
when Check =>
Tool_Package_Name := Name_Check;
Packages_To_Check := Packages_To_Check_By_Check;
when Sync =>
Tool_Package_Name := Name_Synchronize;
Packages_To_Check := Packages_To_Check_By_Sync;
when Elim =>
Tool_Package_Name := Name_Eliminate;
Packages_To_Check := Packages_To_Check_By_Eliminate;
......@@ -1761,6 +1772,7 @@ begin
elsif
(The_Command = Check or else
The_Command = Sync or else
The_Command = Pretty or else
The_Command = Metric or else
The_Command = Stack or else
......@@ -1776,6 +1788,7 @@ begin
end if;
elsif ((The_Command = Check and then Argv (Argv'First) /= '+')
or else The_Command = Sync
or else The_Command = Metric
or else The_Command = Pretty)
and then Project_File /= null
......@@ -1938,6 +1951,7 @@ begin
or else The_Command = Stub
or else The_Command = Elim
or else The_Command = Check
or else The_Command = Sync
then
-- If there are switches in package Compiler, put them in the
-- Carg_Switches table.
......@@ -2295,8 +2309,8 @@ begin
end;
end if;
-- For gnat check, metric or pretty with -U + a main, get the list
-- of sources from the closure and add them to the arguments.
-- For gnat check, sync, metric or pretty with -U + a main, get the
-- list of sources from the closure and add them to the arguments.
if ASIS_Main /= null then
Get_Closure;
......@@ -2315,11 +2329,12 @@ begin
(Project, Project_Tree, Including_Libraries => False);
end if;
-- For gnat check, gnat pretty, gnat metric, gnat list, and gnat
-- stack, if no file has been put on the command line, call tool
-- with all the sources of the main project.
-- For gnat check, gnat sync, gnat pretty, gnat metric, gnat list,
-- and gnat stack, if no file has been put on the command line, call
-- tool with all the sources of the main project.
elsif The_Command = Check or else
The_Command = Sync or else
The_Command = Pretty or else
The_Command = Metric or else
The_Command = List or else
......
gcc/ada/prj-attr.adb
......@@ -260,6 +260,12 @@ package body Prj.Attr is
"Ladefault_switches#" &
"Lbswitches#" &
-- package Synchronize
"Psynchronize#" &
"Ladefault_switches#" &
"Lbswitches#" &
-- package Eliminate
"Peliminate#" &
......@@ -296,9 +302,38 @@ package body Prj.Attr is
Initialized : Boolean := False;
-- A flag to avoid multiple initialization
Package_Names : String_List_Access := new Strings.String_List (1 .. 20);
Last_Package_Name : Natural := 0;
-- Package_Names (1 .. Last_Package_Name) contains the list of the known
-- package names, coming from the Initialization_Data string or from
-- calls to one of the two procedures Register_New_Package.
procedure Add_Package_Name (Name : String);
-- Add a package name in the Package_Name list, extending it, if necessary
function Name_Id_Of (Name : String) return Name_Id;
-- Returns the Name_Id for Name in lower case
----------------------
-- Add_Package_Name --
----------------------
procedure Add_Package_Name (Name : String) is
begin
if Last_Package_Name = Package_Names'Last then
declare
New_List : constant Strings.String_List_Access :=
new Strings.String_List (1 .. Package_Names'Last * 2);
begin
New_List (Package_Names'Range) := Package_Names.all;
Package_Names := New_List;
end;
end if;
Last_Package_Name := Last_Package_Name + 1;
Package_Names (Last_Package_Name) := new String'(Name);
end Add_Package_Name;
-----------------------
-- Attribute_Kind_Of --
-----------------------
......@@ -433,6 +468,8 @@ package body Prj.Attr is
First_Attribute => Empty_Attr);
Start := Finish + 1;
Add_Package_Name (Get_Name_String (Package_Name));
when 'S' =>
Var_Kind := Single;
Optional_Index := False;
......@@ -594,6 +631,15 @@ package body Prj.Attr is
end if;
end Optional_Index_Of;
-----------------------
-- Package_Name_List --
-----------------------
function Package_Name_List return Strings.String_List is
begin
return Package_Names (1 .. Last_Package_Name);
end Package_Name_List;
------------------------
-- Package_Node_Id_Of --
------------------------
......@@ -729,6 +775,8 @@ package body Prj.Attr is
(Name => Pkg_Name,
Known => True,
First_Attribute => Empty_Attr);
Add_Package_Name (Get_Name_String (Pkg_Name));
end Register_New_Package;
procedure Register_New_Package
......@@ -805,6 +853,8 @@ package body Prj.Attr is
(Name => Pkg_Name,
Known => True,
First_Attribute => First_Attr);
Add_Package_Name (Get_Name_String (Pkg_Name));
end Register_New_Package;
---------------------------
......
gcc/ada/prj-attr.ads
......@@ -28,10 +28,18 @@
-- It is also possible to define new packages with their attributes
with System.Strings;
with Table;
package Prj.Attr is
use System;
function Package_Name_List return 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 feeed.
procedure Initialize;
-- Initialize the predefined project level attributes and the predefined
-- packages and their attribute. This procedure should be called by
......
gcc/ada/vms_conv.adb
......@@ -397,6 +397,16 @@ package body VMS_Conv is
Params => new Parameter_Array'(1 => Unlimited_Files),
Defext => " "),
Sync =>
(Cname => new S'("SYNC"),
Usage => new S'("GNAT SYNC name /qualifiers"),
VMS_Only => False,
Unixcmd => new S'("gnatsync"),
Unixsws => null,
Switches => Sync_Switches'Access,
Params => new Parameter_Array'(1 => Unlimited_Files),
Defext => " "),
Elim =>
(Cname => new S'("ELIM"),
Usage => new S'("GNAT ELIM name /qualifiers"),
......
gcc/ada/vms_conv.ads
......@@ -98,6 +98,7 @@ package VMS_Conv is
Clean,
Compile,
Check,
Sync,
Elim,
Find,
Krunch,
......
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