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 250 additions and 22 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,
......
gcc/ada/vms_data.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1996-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1996-2008, 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- --
......@@ -847,6 +847,137 @@ package VMS_Data is
S_Check_Verb 'Access);
----------------------------
-- Switches for GNAT SYNC --
----------------------------
S_Sync_Add : aliased constant S := "/ADD_PROJECT_SEARCH_DIR=*" &
"-aP*";
-- /ADD_PROJECT_SEARCH_PATH==(directory[,...])
--
-- Add directories to the project search path.
S_Sync_All : aliased constant S := "/ALL " &
"-a";
-- /NOALL (D)
-- /ALL
--
-- Also check the components of the GNAT run time and process the needed
-- components of the GNAT RTL when building and analyzing the global
-- structure for checking the global rules.
S_Sync_Ext : aliased constant S := "/EXTERNAL_REFERENCE=" & '"' &
"-X" & '"';
-- /EXTERNAL_REFERENCE="name=val"
--
-- Specifies an external reference to the project manager. Useful only if
-- /PROJECT_FILE is used.
--
-- Example:
-- /EXTERNAL_REFERENCE="DEBUG=TRUE"
S_Sync_Files : aliased constant S := "/FILES=@" &
"-files=@";
-- /FILES=filename
--
-- Take as arguments the files that are listed in the specified
-- text file.
S_Sync_Mess : aliased constant S := "/MESSAGES_PROJECT_FILE=" &
"DEFAULT " &
"-vP0 " &
"MEDIUM " &
"-vP1 " &
"HIGH " &
"-vP2";
-- /MESSAGES_PROJECT_FILE[=messages-option]
--
-- Specifies the "verbosity" of the parsing of project files.
-- messages-option may be one of the following:
--
-- DEFAULT (D) No messages are output if there is no error or warning.
--
-- MEDIUM A small number of messages are output.
--
-- HIGH A great number of messages are output, most of them not
-- being useful for the user.
S_Sync_Project : aliased constant S := "/PROJECT_FILE=<" &
"-P>";
-- /PROJECT_FILE=filename
--
-- Specifies the main project file to be used. The project files rooted
-- at the main project file will be parsed before the invocation of the
-- gnatcheck. The source directories to be searched will be communicated
-- to gnatcheck through logical name ADA_PRJ_INCLUDE_FILE.
S_Sync_Quiet : aliased constant S := "/QUIET " &
"-q";
-- /NOQUIET (D)
-- /QUIET
--
-- Work quietly, only output warnings and errors.
S_Sync_Verb : aliased constant S := "/VERBOSE " &
"-v";
-- /NOVERBOSE (D)
-- /VERBOSE
--
-- The version number and copyright notice are output, as well as exact
-- copies of the gnat1 commands spawned to obtain the chop control
-- information.
S_Sync_Exec : aliased constant S := "/EXECUTION_TIME " &
"-t";
-- /NOEXECUTION_TIME (D)
-- /EXECUTION_TIME
--
-- Output the execution time
S_Sync_Details : aliased constant S := "/DETAILs=" &
"MEDIUM " &
"-om " &
"SHORT " &
"-os " &
"FULL " &
"-of";
-- /DETAILS[=options]
--
-- Specifies the details of the output.
-- Options may be one of the following:
--
-- MEDIUM (D)
-- SHORT
-- FULL
S_Sync_Warnoff : aliased constant S := "/WARNINGS_OFF " &
"-wq";
--
-- /WARNINGS_OFF
--
-- Turn warnings off
S_Sync_Output : aliased constant S := "/OUTPUT_FILE=<" &
"-out_file=>";
--
-- /OUTPUT_FILE=filename
--
-- Redirect output to a text file
Sync_Switches : aliased constant Switches :=
(S_Sync_Add 'Access,
S_Sync_All 'Access,
S_Sync_Ext 'Access,
S_Sync_Files 'Access,
S_Sync_Mess 'Access,
S_Sync_Project 'Access,
S_Sync_Quiet 'Access,
S_Sync_Verb 'Access,
S_Sync_Exec 'Access,
S_Sync_Details 'Access,
S_Sync_Warnoff 'Access,
S_Sync_Output 'Access);
----------------------------
-- Switches for GNAT CHOP --
----------------------------
......@@ -2715,6 +2846,10 @@ package VMS_Data is
"-gnatww " &
"NOLOWBOUND_ASSUMED " &
"-gnatwW " &
"WARNINGS_OFF_PRAGMAS " &
"-gnatw.w " &
"NO_WARNINGS_OFF_PRAGMAS " &
"-gnatw.W " &
"IMPORT_EXPORT_PRAGMAS " &
"-gnatwx " &
"NOIMPORT_EXPORT_PRAGMAS " &
......@@ -4737,7 +4872,7 @@ package VMS_Data is
"CYCLOMATIC_ON " &
"--complexity-cyclomatic " &
"CYCLOMATIC_OFF " &
"--no-complexity-cyclomatic " &
"--no-complexity-cyclomatic "&
"ESSENTIAL_ON " &
"--complexity-essential " &
"ESSENTIAL_OFF " &
......@@ -5983,6 +6118,14 @@ package VMS_Data is
-- preceding the compilation unit) from the source of the
-- library unit declaration into the body stub.
S_Stub_Header_File : aliased constant S := "/FROM_HEADER_FILE=<" &
"--header-file=>";
-- /FROM_HEADER_FILE==filename
--
-- Use the content of the file as the comment header for a generated body
-- stub.
S_Stub_Indent : aliased constant S := "/INDENTATION=#" &
"-i#";
-- /INDENTATION=nnn
......@@ -6105,6 +6248,7 @@ package VMS_Data is
S_Stub_Ext 'Access,
S_Stub_Full 'Access,
S_Stub_Header 'Access,
S_Stub_Header_File'Access,
S_Stub_Indent 'Access,
S_Stub_Keep 'Access,
S_Stub_Length 'Access,
......
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