Skip to content

R
riscv-gcc-1
Commit 85c3f0b9 by Arnaud Charlet
Options

[multiple changes] 

2010-10-12  Javier Miranda  <miranda@adacore.com>

	* exp_util.adb (Side_Effect_Free): Return true for object renaming
	declarations that were previously generated by Remove_Side_Effects.

2010-10-12  Emmanuel Briot  <briot@adacore.com>

	* xref_lib.adb (Get_Full_Type): Display "private variable" instead of
	"???" when an entity is defined as "*" in the ALI file.
	* g-comlin.ads, g-comlin.adb: Fix handling of null parameters.
	Minor reformatting.

From-SVN: r165371
parent b799980e
Showing with 286 additions and 179 deletions
gcc/ada/ChangeLog
2010-10-12 Javier Miranda <miranda@adacore.com>
* exp_util.adb (Side_Effect_Free): Return true for object renaming
declarations that were previously generated by Remove_Side_Effects.
2010-10-12 Emmanuel Briot <briot@adacore.com>
* xref_lib.adb (Get_Full_Type): Display "private variable" instead of
"???" when an entity is defined as "*" in the ALI file.
* g-comlin.ads, g-comlin.adb: Fix handling of null parameters.
Minor reformatting.
2010-10-12 Emmanuel Briot <briot@adacore.com> 2010-10-12 Emmanuel Briot <briot@adacore.com>
* g-comlin.adb, g-comlin.ads (Display_Help, Getopt, Current_Section, * g-comlin.adb, g-comlin.ads (Display_Help, Getopt, Current_Section,
......
gcc/ada/exp_util.adb
...@@ -4645,6 +4645,20 @@ package body Exp_Util is ...@@ -4645,6 +4645,20 @@ package body Exp_Util is
and then Ekind (Entity (Original_Node (N))) /= E_Constant and then Ekind (Entity (Original_Node (N))) /= E_Constant
then then
return False; return False;
-- Remove_Side_Effects generates an object renaming declaration to
-- capture the expression of a class-wide expression. In VM targets
-- the frontend performs no expansion for dispatching calls to
-- class-wide types since they are handled by the VM. Hence, we must
-- locate here if this node corresponds to a previous invocation of
-- Remove_Side_Effects to avoid a never ending loop in the frontend.
elsif VM_Target /= No_VM
and then not Comes_From_Source (N)
and then Is_Class_Wide_Type (Etype (N))
and then Nkind (Parent (N)) = N_Object_Renaming_Declaration
then
return True;
end if; end if;
-- For other than entity names and compile time known values, -- For other than entity names and compile time known values,
......
gcc/ada/g-comlin.adb
...@@ -29,10 +29,11 @@ ...@@ -29,10 +29,11 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Strings.Unbounded; with Ada.Strings.Unbounded;
with Ada.Text_IO; use Ada.Text_IO; with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Deallocation; with Ada.Unchecked_Deallocation;
with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.OS_Lib; use GNAT.OS_Lib; with GNAT.OS_Lib; use GNAT.OS_Lib;
...@@ -114,10 +115,12 @@ package body GNAT.Command_Line is ...@@ -114,10 +115,12 @@ package body GNAT.Command_Line is
-- Add a new element to Line. If Before is True, the item is inserted at -- Add a new element to Line. If Before is True, the item is inserted at
-- the beginning, else it is appended. -- the beginning, else it is appended.
procedure Add (Config : in out Command_Line_Configuration; procedure Add
Switch : Switch_Definition); (Config : in out Command_Line_Configuration;
procedure Add (Def : in out Alias_Definitions_List; Switch : Switch_Definition);
Alias : Alias_Definition); procedure Add
(Def : in out Alias_Definitions_List;
Alias : Alias_Definition);
-- Add a new element to Def. -- Add a new element to Def.
procedure Initialize_Switch_Def procedure Initialize_Switch_Def
...@@ -260,9 +263,10 @@ package body GNAT.Command_Line is ...@@ -260,9 +263,10 @@ package body GNAT.Command_Line is
if Current = 1 then if Current = 1 then
return String'(1 .. 0 => ' '); return String'(1 .. 0 => ' ');
else
-- Otherwise continue with the directory at the previous level
-- Otherwise continue with the directory at the previous level
else
Current := Current - 1; Current := Current - 1;
It.Current_Depth := Current; It.Current_Depth := Current;
end if; end if;
...@@ -272,8 +276,8 @@ package body GNAT.Command_Line is ...@@ -272,8 +276,8 @@ package body GNAT.Command_Line is
elsif Is_Directory elsif Is_Directory
(It.Dir_Name (1 .. It.Levels (Current).Name_Last) & S (1 .. Last)) (It.Dir_Name (1 .. It.Levels (Current).Name_Last) & S (1 .. Last))
and then S (1 .. Last) /= "." and then S (1 .. Last) /= "."
and then S (1 .. Last) /= ".." and then S (1 .. Last) /= ".."
then then
-- We can go to the next level only if we have not reached the -- We can go to the next level only if we have not reached the
-- maximum depth, -- maximum depth,
...@@ -327,7 +331,8 @@ package body GNAT.Command_Line is ...@@ -327,7 +331,8 @@ package body GNAT.Command_Line is
--------------------- ---------------------
function Current_Section function Current_Section
(Parser : Opt_Parser := Command_Line_Parser) return String is (Parser : Opt_Parser := Command_Line_Parser) return String
is
begin begin
if Parser.Current_Section = 1 then if Parser.Current_Section = 1 then
return ""; return "";
...@@ -391,7 +396,7 @@ package body GNAT.Command_Line is ...@@ -391,7 +396,7 @@ package body GNAT.Command_Line is
Parser.Current_Argument := 1; Parser.Current_Argument := 1;
while Parser.Current_Argument <= Parser.Arg_Count while Parser.Current_Argument <= Parser.Arg_Count
and then Parser.Section (Parser.Current_Argument) /= and then Parser.Section (Parser.Current_Argument) /=
Parser.Current_Section Parser.Current_Section
loop loop
Parser.Current_Argument := Parser.Current_Argument + 1; Parser.Current_Argument := Parser.Current_Argument + 1;
end loop; end loop;
...@@ -402,7 +407,7 @@ package body GNAT.Command_Line is ...@@ -402,7 +407,7 @@ package body GNAT.Command_Line is
elsif Parser.Section (Parser.Current_Argument) = 0 then elsif Parser.Section (Parser.Current_Argument) = 0 then
while Parser.Current_Argument <= Parser.Arg_Count while Parser.Current_Argument <= Parser.Arg_Count
and then Parser.Section (Parser.Current_Argument) /= and then Parser.Section (Parser.Current_Argument) /=
Parser.Current_Section Parser.Current_Section
loop loop
Parser.Current_Argument := Parser.Current_Argument + 1; Parser.Current_Argument := Parser.Current_Argument + 1;
end loop; end loop;
...@@ -462,6 +467,12 @@ package body GNAT.Command_Line is ...@@ -462,6 +467,12 @@ package body GNAT.Command_Line is
Switch_Last : out Integer) Switch_Last : out Integer)
is is
begin begin
if Switch = "" then
Parameter_Type := Parameter_None;
Switch_Last := Switch'Last;
return;
end if;
case Switch (Switch'Last) is case Switch (Switch'Last) is
when ':' => when ':' =>
Parameter_Type := Parameter_With_Optional_Space; Parameter_Type := Parameter_With_Optional_Space;
...@@ -676,7 +687,7 @@ package body GNAT.Command_Line is ...@@ -676,7 +687,7 @@ package body GNAT.Command_Line is
(Parser.The_Switch, (Parser.The_Switch,
Arg_Num => Parser.Current_Argument, Arg_Num => Parser.Current_Argument,
First => Parser.Current_Index, First => Parser.Current_Index,
Last => Arg'Last); Last => End_Index);
Parser.Current_Index := End_Index + 1; Parser.Current_Index := End_Index + 1;
raise Invalid_Switch; raise Invalid_Switch;
...@@ -722,7 +733,6 @@ package body GNAT.Command_Line is ...@@ -722,7 +733,6 @@ package body GNAT.Command_Line is
-- If the switch is of the form <switch>=xxx -- If the switch is of the form <switch>=xxx
if End_Index < Arg'Last then if End_Index < Arg'Last then
if Arg (End_Index + 1) = '=' if Arg (End_Index + 1) = '='
and then End_Index + 1 < Arg'Last and then End_Index + 1 < Arg'Last
then then
...@@ -759,7 +769,6 @@ package body GNAT.Command_Line is ...@@ -759,7 +769,6 @@ package body GNAT.Command_Line is
end if; end if;
when Parameter_No_Space => when Parameter_No_Space =>
if End_Index < Arg'Last then if End_Index < Arg'Last then
Set_Parameter Set_Parameter
(Parser.The_Parameter, (Parser.The_Parameter,
...@@ -774,7 +783,6 @@ package body GNAT.Command_Line is ...@@ -774,7 +783,6 @@ package body GNAT.Command_Line is
end if; end if;
when Parameter_Optional => when Parameter_Optional =>
if End_Index < Arg'Last then if End_Index < Arg'Last then
Set_Parameter Set_Parameter
(Parser.The_Parameter, (Parser.The_Parameter,
...@@ -786,7 +794,6 @@ package body GNAT.Command_Line is ...@@ -786,7 +794,6 @@ package body GNAT.Command_Line is
Dummy := Goto_Next_Argument_In_Section (Parser); Dummy := Goto_Next_Argument_In_Section (Parser);
when Parameter_None => when Parameter_None =>
if Concatenate or else End_Index = Arg'Last then if Concatenate or else End_Index = Arg'Last then
Parser.Current_Index := End_Index + 1; Parser.Current_Index := End_Index + 1;
...@@ -1195,6 +1202,7 @@ package body GNAT.Command_Line is ...@@ -1195,6 +1202,7 @@ package body GNAT.Command_Line is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Switch_Definitions, Switch_Definitions_List); (Switch_Definitions, Switch_Definitions_List);
Tmp : Switch_Definitions_List; Tmp : Switch_Definitions_List;
begin begin
if Config = null then if Config = null then
Config := new Command_Line_Configuration_Record; Config := new Command_Line_Configuration_Record;
...@@ -1223,6 +1231,7 @@ package body GNAT.Command_Line is ...@@ -1223,6 +1231,7 @@ package body GNAT.Command_Line is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Alias_Definitions, Alias_Definitions_List); (Alias_Definitions, Alias_Definitions_List);
Tmp : Alias_Definitions_List := Def; Tmp : Alias_Definitions_List := Def;
begin begin
if Tmp = null then if Tmp = null then
Def := new Alias_Definitions (1 .. 1); Def := new Alias_Definitions (1 .. 1);
...@@ -1246,8 +1255,9 @@ package body GNAT.Command_Line is ...@@ -1246,8 +1255,9 @@ package body GNAT.Command_Line is
Help : String := ""; Help : String := "";
Section : String := "") Section : String := "")
is is
P1, P2 : Switch_Parameter_Type := Parameter_None; P1, P2 : Switch_Parameter_Type := Parameter_None;
Last1, Last2 : Integer; Last1, Last2 : Integer;
begin begin
if Switch /= "" then if Switch /= "" then
Def.Switch := new String'(Switch); Def.Switch := new String'(Switch);
...@@ -1291,7 +1301,7 @@ package body GNAT.Command_Line is ...@@ -1291,7 +1301,7 @@ package body GNAT.Command_Line is
Help : String := ""; Help : String := "";
Section : String := "") Section : String := "")
is is
Def : Switch_Definition; Def : Switch_Definition;
begin begin
if Switch /= "" or else Long_Switch /= "" then if Switch /= "" or else Long_Switch /= "" then
Initialize_Switch_Def (Def, Switch, Long_Switch, Help, Section); Initialize_Switch_Def (Def, Switch, Long_Switch, Help, Section);
...@@ -1418,8 +1428,8 @@ package body GNAT.Command_Line is ...@@ -1418,8 +1428,8 @@ package body GNAT.Command_Line is
function Get_Switches function Get_Switches
(Config : Command_Line_Configuration; (Config : Command_Line_Configuration;
Section : String := ""; Switch_Char : Character := '-';
Switch_Char : Character := '-') return String Section : String := "") return String
is is
Ret : Ada.Strings.Unbounded.Unbounded_String; Ret : Ada.Strings.Unbounded.Unbounded_String;
use Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
...@@ -1427,6 +1437,10 @@ package body GNAT.Command_Line is ...@@ -1427,6 +1437,10 @@ package body GNAT.Command_Line is
function Add_Switch (S : String; Index : Integer) return Boolean; function Add_Switch (S : String; Index : Integer) return Boolean;
-- Add a switch to Ret -- Add a switch to Ret
----------------
-- Add_Switch --
----------------
function Add_Switch (S : String; Index : Integer) return Boolean is function Add_Switch (S : String; Index : Integer) return Boolean is
pragma Unreferenced (Index); pragma Unreferenced (Index);
begin begin
...@@ -1442,10 +1456,14 @@ package body GNAT.Command_Line is ...@@ -1442,10 +1456,14 @@ package body GNAT.Command_Line is
Tmp : Boolean; Tmp : Boolean;
pragma Unreferenced (Tmp); pragma Unreferenced (Tmp);
-- Start of processing for Get_Switches
begin begin
Foreach_Switch (Config, Add_Switch'Access, Section => Section); Foreach_Switch (Config, Add_Switch'Access, Section => Section);
-- Adding relevant aliases -- Adding relevant aliases
if Config.Aliases /= null then if Config.Aliases /= null then
for A in Config.Aliases'Range loop for A in Config.Aliases'Range loop
if Config.Aliases (A).Section.all = Section then if Config.Aliases (A).Section.all = Section then
...@@ -1462,10 +1480,11 @@ package body GNAT.Command_Line is ...@@ -1462,10 +1480,11 @@ package body GNAT.Command_Line is
------------------------ ------------------------
function Section_Delimiters function Section_Delimiters
(Config : Command_Line_Configuration) return String (Config : Command_Line_Configuration) return String
is is
use Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
Result : Unbounded_String; Result : Unbounded_String;
begin begin
if Config /= null and then Config.Sections /= null then if Config /= null and then Config.Sections /= null then
for S in Config.Sections'Range loop for S in Config.Sections'Range loop
...@@ -1493,7 +1512,8 @@ package body GNAT.Command_Line is ...@@ -1493,7 +1512,8 @@ package body GNAT.Command_Line is
----------------------- -----------------------
function Get_Configuration function Get_Configuration
(Cmd : Command_Line) return Command_Line_Configuration is (Cmd : Command_Line) return Command_Line_Configuration
is
begin begin
return Cmd.Config; return Cmd.Config;
end Get_Configuration; end Get_Configuration;
...@@ -1574,29 +1594,10 @@ package body GNAT.Command_Line is ...@@ -1574,29 +1594,10 @@ package body GNAT.Command_Line is
if not Is_Section then if not Is_Section then
if Section = null then if Section = null then
Add_Switch (Cmd, Sw, Parameter (Parser));
-- Work around some weird cases: some switches may
-- expect parameters, but have the same value as
-- longer switches: -gnaty3 (-gnaty, parameter=3) and
-- -gnatya (-gnatya, no parameter).
-- So we are calling add_switch here with parameter
-- attached. This will be anyway correctly handled by
-- Add_Switch if -gnaty3 is actually provided.
if Separator (Parser) = ASCII.NUL then
Add_Switch (Cmd, Sw & Parameter (Parser), "");
else
Add_Switch (Cmd, Sw, Parameter (Parser));
end if;
else else
if Separator (Parser) = ASCII.NUL then Add_Switch
Add_Switch (Cmd, Sw, Parameter (Parser), Section.all);
(Cmd, Sw & Parameter (Parser), "", Section.all);
else
Add_Switch
(Cmd, Sw, Parameter (Parser), Section.all);
end if;
end if; end if;
end if; end if;
end; end;
...@@ -1633,7 +1634,8 @@ package body GNAT.Command_Line is ...@@ -1633,7 +1634,8 @@ package body GNAT.Command_Line is
function Looking_At function Looking_At
(Type_Str : String; (Type_Str : String;
Index : Natural; Index : Natural;
Substring : String) return Boolean is Substring : String) return Boolean
is
begin begin
return Index + Substring'Length - 1 <= Type_Str'Last return Index + Substring'Length - 1 <= Type_Str'Last
and then Type_Str (Index .. Index + Substring'Length - 1) = Substring; and then Type_Str (Index .. Index + Substring'Length - 1) = Substring;
...@@ -1734,6 +1736,10 @@ package body GNAT.Command_Line is ...@@ -1734,6 +1736,10 @@ package body GNAT.Command_Line is
function Analyze_Simple_Switch function Analyze_Simple_Switch
(Switch : String; Index : Integer) return Boolean; (Switch : String; Index : Integer) return Boolean;
---------------------------
-- Analyze_Simple_Switch --
---------------------------
function Analyze_Simple_Switch function Analyze_Simple_Switch
(Switch : String; Index : Integer) return Boolean (Switch : String; Index : Integer) return Boolean
is is
...@@ -1810,6 +1816,8 @@ package body GNAT.Command_Line is ...@@ -1810,6 +1816,8 @@ package body GNAT.Command_Line is
return True; return True;
end Analyze_Simple_Switch; end Analyze_Simple_Switch;
-- Start of processing for Group_Analysis
begin begin
Idx := Group'First; Idx := Group'First;
while Idx <= Group'Last loop while Idx <= Group'Last loop
...@@ -1834,8 +1842,9 @@ package body GNAT.Command_Line is ...@@ -1834,8 +1842,9 @@ package body GNAT.Command_Line is
function Is_In_Config function Is_In_Config
(Config_Switch : String; Index : Integer) return Boolean (Config_Switch : String; Index : Integer) return Boolean
is is
Last : Natural; Last : Natural;
P : Switch_Parameter_Type; P : Switch_Parameter_Type;
begin begin
Decompose_Switch (Config_Switch, P, Last); Decompose_Switch (Config_Switch, P, Last);
...@@ -1869,6 +1878,7 @@ package body GNAT.Command_Line is ...@@ -1869,6 +1878,7 @@ package body GNAT.Command_Line is
return False; return False;
end case; end case;
end if; end if;
return True; return True;
end Is_In_Config; end Is_In_Config;
...@@ -1882,22 +1892,29 @@ package body GNAT.Command_Line is ...@@ -1882,22 +1892,29 @@ package body GNAT.Command_Line is
Last : Natural; Last : Natural;
Param : Natural; Param : Natural;
P : Switch_Parameter_Type; P : Switch_Parameter_Type;
begin begin
-- This function is called when we believe the parameter was -- This function is called when we believe the parameter was
-- specified as part of the switch, instead of separately. Thus we -- specified as part of the switch, instead of separately. Thus we
-- look in the config to find all possible switches. -- look in the config to find all possible switches.
Decompose_Switch (Config_Switch, P, Last); Decompose_Switch (Config_Switch, P, Last);
if Looking_At if Looking_At
(Switch, Switch'First, Config_Switch (Config_Switch'First .. Last)) (Switch, Switch'First, Config_Switch (Config_Switch'First .. Last))
then then
Param := Switch'First + Last; -- First char of parameter -- Set first char of Param, and last char of Switch
Param := Switch'First + Last;
Last := Switch'First + Last - Config_Switch'First; Last := Switch'First + Last - Config_Switch'First;
-- last char of Switch
case P is case P is
-- None is already handled in Is_In_Config
when Parameter_None => when Parameter_None =>
null; -- Already handled in Is_In_Config null;
when Parameter_With_Space_Or_Equal => when Parameter_With_Space_Or_Equal =>
if Switch (Param) = ' ' if Switch (Param) = ' '
or else Switch (Param) = '=' or else Switch (Param) = '='
...@@ -1909,7 +1926,7 @@ package body GNAT.Command_Line is ...@@ -1909,7 +1926,7 @@ package body GNAT.Command_Line is
end if; end if;
when Parameter_With_Optional_Space => when Parameter_With_Optional_Space =>
if Switch (Param) = ' ' then if Param <= Switch'Last and then Switch (Param) = ' ' then
Param := Param + 1; Param := Param + 1;
end if; end if;
...@@ -1928,11 +1945,14 @@ package body GNAT.Command_Line is ...@@ -1928,11 +1945,14 @@ package body GNAT.Command_Line is
return True; return True;
end Starts_With; end Starts_With;
-- Start of processing for For_Each_Simple_Switch
begin begin
-- First determine if the switch corresponds to one belonging to the -- First determine if the switch corresponds to one belonging to the
-- configuration. If so, run callback and exit. -- configuration. If so, run callback and exit.
Foreach_Switch (Config, Is_In_Config'Access, Section); Foreach_Switch (Config, Is_In_Config'Access, Section);
if Found_In_Config then if Found_In_Config then
return; return;
end if; end if;
...@@ -2031,8 +2051,7 @@ package body GNAT.Command_Line is ...@@ -2031,8 +2051,7 @@ package body GNAT.Command_Line is
Success : Boolean; Success : Boolean;
pragma Unreferenced (Success); pragma Unreferenced (Success);
begin begin
Add_Switch Add_Switch (Cmd, Switch, Parameter, Section, Add_Before, Success);
(Cmd, Switch, Parameter, Section, Add_Before, Success);
end Add_Switch; end Add_Switch;
---------------- ----------------
...@@ -2048,7 +2067,10 @@ package body GNAT.Command_Line is ...@@ -2048,7 +2067,10 @@ package body GNAT.Command_Line is
Success : out Boolean) Success : out Boolean)
is is
procedure Add_Simple_Switch procedure Add_Simple_Switch
(Simple, Separator, Param : String; Index : Integer); (Simple : String;
Separator : String;
Param : String;
Index : Integer);
-- Add a new switch that has had all its aliases expanded, and switches -- Add a new switch that has had all its aliases expanded, and switches
-- ungrouped. We know there are no more aliases in Switches. -- ungrouped. We know there are no more aliases in Switches.
...@@ -2057,27 +2079,29 @@ package body GNAT.Command_Line is ...@@ -2057,27 +2079,29 @@ package body GNAT.Command_Line is
----------------------- -----------------------
procedure Add_Simple_Switch procedure Add_Simple_Switch
(Simple, Separator, Param : String; Index : Integer) (Simple : String;
Separator : String;
Param : String;
Index : Integer)
is is
pragma Unreferenced (Index); pragma Unreferenced (Index);
begin begin
if Cmd.Expanded = null then if Cmd.Expanded = null then
Cmd.Expanded := new Argument_List'(1 .. 1 => new String'(Simple)); Cmd.Expanded := new Argument_List'(1 .. 1 => new String'(Simple));
if Param /= "" then if Param /= "" then
Cmd.Params := new Argument_List' Cmd.Params :=
(1 .. 1 => new String'(Separator & Param)); new Argument_List'(1 .. 1 => new String'(Separator & Param));
else else
Cmd.Params := new Argument_List'(1 .. 1 => null); Cmd.Params := new Argument_List'(1 .. 1 => null);
end if; end if;
if Section = "" then if Section = "" then
Cmd.Sections := new Argument_List'(1 .. 1 => null); Cmd.Sections := new Argument_List'(1 .. 1 => null);
else else
Cmd.Sections := new Argument_List' Cmd.Sections :=
(1 .. 1 => new String'(Section)); new Argument_List'(1 .. 1 => new String'(Section));
end if; end if;
else else
...@@ -2110,7 +2134,6 @@ package body GNAT.Command_Line is ...@@ -2110,7 +2134,6 @@ package body GNAT.Command_Line is
(Cmd.Params, (Cmd.Params,
new String'(Separator & Param), new String'(Separator & Param),
Add_Before); Add_Before);
else else
Add Add
(Cmd.Params, (Cmd.Params,
...@@ -2135,9 +2158,12 @@ package body GNAT.Command_Line is ...@@ -2135,9 +2158,12 @@ package body GNAT.Command_Line is
procedure Add_Simple_Switches is procedure Add_Simple_Switches is
new For_Each_Simple_Switch (Add_Simple_Switch); new For_Each_Simple_Switch (Add_Simple_Switch);
-- Start of processing for Add_Switch -- Local Variables
Section_Valid : Boolean := False; Section_Valid : Boolean := False;
-- Start of processing for Add_Switch
begin begin
if Section /= "" and then Cmd.Config /= null then if Section /= "" and then Cmd.Config /= null then
for S in Cmd.Config.Sections'Range loop for S in Cmd.Config.Sections'Range loop
...@@ -2363,7 +2389,7 @@ package body GNAT.Command_Line is ...@@ -2363,7 +2389,7 @@ package body GNAT.Command_Line is
-- Start of processing for Remove_Switch -- Start of processing for Remove_Switch
begin begin
Remove_Simple_Switches (Cmd.Config, Switch, Parameter); Remove_Simple_Switches (Cmd.Config, Section, Switch, Parameter);
Free (Cmd.Coalesce); Free (Cmd.Coalesce);
end Remove_Switch; end Remove_Switch;
...@@ -2464,10 +2490,10 @@ package body GNAT.Command_Line is ...@@ -2464,10 +2490,10 @@ package body GNAT.Command_Line is
Free (Result (C)); Free (Result (C));
else -- We changed section: we put the grouped switches to the first
-- We changed section: we put the grouped switches to the -- place, on continue with the new section.
-- first place, on continue with the new section.
else
Result (First) := Result (First) :=
new String' new String'
(Cmd.Config.Prefixes (P).all & (Cmd.Config.Prefixes (P).all &
...@@ -2521,6 +2547,7 @@ package body GNAT.Command_Line is ...@@ -2521,6 +2547,7 @@ package body GNAT.Command_Line is
(Switch, Separator, Param : String; Index : Integer) (Switch, Separator, Param : String; Index : Integer)
is is
pragma Unreferenced (Separator, Index); pragma Unreferenced (Separator, Index);
begin begin
if Found then if Found then
for E in Result'Range loop for E in Result'Range loop
...@@ -2546,18 +2573,20 @@ package body GNAT.Command_Line is ...@@ -2546,18 +2573,20 @@ package body GNAT.Command_Line is
procedure Remove_Cb (Switch, Separator, Param : String; Index : Integer) procedure Remove_Cb (Switch, Separator, Param : String; Index : Integer)
is is
pragma Unreferenced (Separator, Index); pragma Unreferenced (Separator, Index);
begin begin
for E in Result'Range loop for E in Result'Range loop
if Result (E) /= null if Result (E) /= null
and then and then
(Params (E) = null (Params (E) = null
or else Params (E) (Params (E)'First + 1 or else Params (E) (Params (E)'First + 1
.. Params (E)'Last) = Param) .. Params (E)'Last) = Param)
and then Result (E).all = Switch and then Result (E).all = Switch
then then
if First > E then if First > E then
First := E; First := E;
end if; end if;
Free (Result (E)); Free (Result (E));
Free (Params (E)); Free (Params (E));
return; return;
...@@ -2934,79 +2963,22 @@ package body GNAT.Command_Line is ...@@ -2934,79 +2963,22 @@ package body GNAT.Command_Line is
procedure Display_Help (Config : Command_Line_Configuration) is procedure Display_Help (Config : Command_Line_Configuration) is
function Switch_Name function Switch_Name
(Def : Switch_Definition; Section : String) return String; (Def : Switch_Definition;
Section : String) return String;
-- Return the "-short, --long=ARG" string for Def. -- Return the "-short, --long=ARG" string for Def.
-- Returns "" if the switch is not in the section -- Returns "" if the switch is not in the section.
function Param_Name function Param_Name
(P : Switch_Parameter_Type; Name : String := "ARG") return String; (P : Switch_Parameter_Type;
Name : String := "ARG") return String;
-- Return the display for a switch parameter -- Return the display for a switch parameter
procedure Display_Section_Help (Section : String); procedure Display_Section_Help (Section : String);
-- Display the help for a specific section ("" is the default section) -- Display the help for a specific section ("" is the default section)
function Param_Name --------------------------
(P : Switch_Parameter_Type; Name : String := "ARG") return String is -- Display_Section_Help --
begin --------------------------
case P is
when Parameter_None =>
return "";
when Parameter_With_Optional_Space =>
return " " & To_Upper (Name);
when Parameter_With_Space_Or_Equal =>
return "=" & To_Upper (Name);
when Parameter_No_Space =>
return To_Upper (Name);
when Parameter_Optional =>
return '[' & To_Upper (Name) & ']';
end case;
end Param_Name;
function Switch_Name
(Def : Switch_Definition; Section : String) return String
is
use Ada.Strings.Unbounded;
Result : Unbounded_String;
P1, P2 : Switch_Parameter_Type;
Last1, Last2 : Integer := 0;
begin
if (Section = "" and then Def.Section = null)
or else (Def.Section /= null and then Def.Section.all = Section)
then
if Def.Switch /= null
and then Def.Switch.all = "*"
then
return "[any switch]";
end if;
if Def.Switch /= null then
Decompose_Switch (Def.Switch.all, P1, Last1);
Append (Result, Def.Switch (Def.Switch'First .. Last1));
if Def.Long_Switch /= null then
Decompose_Switch (Def.Long_Switch.all, P2, Last2);
Append (Result, ", "
& Def.Long_Switch (Def.Long_Switch'First .. Last2));
Append (Result, Param_Name (P2, "ARG"));
else
Append (Result, Param_Name (P1, "ARG"));
end if;
else -- Long_Switch necessarily not null
Decompose_Switch (Def.Long_Switch.all, P2, Last2);
Append (Result,
Def.Long_Switch (Def.Long_Switch'First .. Last2));
Append (Result, Param_Name (P2, "ARG"));
end if;
end if;
return To_String (Result);
end Switch_Name;
procedure Display_Section_Help (Section : String) is procedure Display_Section_Help (Section : String) is
Max_Len : Natural := 0; Max_Len : Natural := 0;
...@@ -3072,6 +3044,83 @@ package body GNAT.Command_Line is ...@@ -3072,6 +3044,83 @@ package body GNAT.Command_Line is
end if; end if;
end Display_Section_Help; end Display_Section_Help;
----------------
-- Param_Name --
----------------
function Param_Name
(P : Switch_Parameter_Type;
Name : String := "ARG") return String
is
begin
case P is
when Parameter_None =>
return "";
when Parameter_With_Optional_Space =>
return " " & To_Upper (Name);
when Parameter_With_Space_Or_Equal =>
return "=" & To_Upper (Name);
when Parameter_No_Space =>
return To_Upper (Name);
when Parameter_Optional =>
return '[' & To_Upper (Name) & ']';
end case;
end Param_Name;
-----------------
-- Switch_Name --
-----------------
function Switch_Name
(Def : Switch_Definition;
Section : String) return String
is
use Ada.Strings.Unbounded;
Result : Unbounded_String;
P1, P2 : Switch_Parameter_Type;
Last1, Last2 : Integer := 0;
begin
if (Section = "" and then Def.Section = null)
or else (Def.Section /= null and then Def.Section.all = Section)
then
if Def.Switch /= null
and then Def.Switch.all = "*"
then
return "[any switch]";
end if;
if Def.Switch /= null then
Decompose_Switch (Def.Switch.all, P1, Last1);
Append (Result, Def.Switch (Def.Switch'First .. Last1));
if Def.Long_Switch /= null then
Decompose_Switch (Def.Long_Switch.all, P2, Last2);
Append (Result, ", "
& Def.Long_Switch (Def.Long_Switch'First .. Last2));
Append (Result, Param_Name (P2, "ARG"));
else
Append (Result, Param_Name (P1, "ARG"));
end if;
else -- Long_Switch necessarily not null
Decompose_Switch (Def.Long_Switch.all, P2, Last2);
Append (Result,
Def.Long_Switch (Def.Long_Switch'First .. Last2));
Append (Result, Param_Name (P2, "ARG"));
end if;
end if;
return To_String (Result);
end Switch_Name;
-- Start of processing for Display_Help
begin begin
if Config = null then if Config = null then
return; return;
...@@ -3091,6 +3140,7 @@ package body GNAT.Command_Line is ...@@ -3091,6 +3140,7 @@ package body GNAT.Command_Line is
end if; end if;
Display_Section_Help (""); Display_Section_Help ("");
if Config.Sections /= null and then Config.Switches /= null then if Config.Sections /= null and then Config.Switches /= null then
for S in Config.Sections'Range loop for S in Config.Sections'Range loop
Display_Section_Help (Config.Sections (S).all); Display_Section_Help (Config.Sections (S).all);
...@@ -3115,9 +3165,18 @@ package body GNAT.Command_Line is ...@@ -3115,9 +3165,18 @@ package body GNAT.Command_Line is
Section_Name : not null access constant String := Empty_Name'Access; Section_Name : not null access constant String := Empty_Name'Access;
procedure Simple_Callback procedure Simple_Callback
(Simple_Switch, Separator, Parameter : String; Index : Integer); (Simple_Switch : String;
Separator : String;
Parameter : String;
Index : Integer);
-- Needs comments ???
procedure Do_Callback (Switch, Parameter : String; Index : Integer); procedure Do_Callback (Switch, Parameter : String; Index : Integer);
-----------------
-- Do_Callback --
-----------------
procedure Do_Callback (Switch, Parameter : String; Index : Integer) is procedure Do_Callback (Switch, Parameter : String; Index : Integer) is
begin begin
-- Do automatic handling when possible -- Do automatic handling when possible
...@@ -3164,8 +3223,18 @@ package body GNAT.Command_Line is ...@@ -3164,8 +3223,18 @@ package body GNAT.Command_Line is
end if; end if;
end Do_Callback; end Do_Callback;
procedure For_Each_Simple
is new For_Each_Simple_Switch (Simple_Callback);
---------------------
-- Simple_Callback --
---------------------
procedure Simple_Callback procedure Simple_Callback
(Simple_Switch, Separator, Parameter : String; Index : Integer) (Simple_Switch : String;
Separator : String;
Parameter : String;
Index : Integer)
is is
pragma Unreferenced (Separator); pragma Unreferenced (Separator);
begin begin
...@@ -3174,8 +3243,7 @@ package body GNAT.Command_Line is ...@@ -3174,8 +3243,7 @@ package body GNAT.Command_Line is
Index => Index); Index => Index);
end Simple_Callback; end Simple_Callback;
procedure For_Each_Simple -- Start of processing for Getopt
is new For_Each_Simple_Switch (Simple_Callback);
begin begin
-- Initialize sections -- Initialize sections
...@@ -3191,7 +3259,7 @@ package body GNAT.Command_Line is ...@@ -3191,7 +3259,7 @@ package body GNAT.Command_Line is
Section_Delimiters => Section_Delimiters (Config)); Section_Delimiters => Section_Delimiters (Config));
Getopt_Switches := new String' Getopt_Switches := new String'
(Get_Switches (Config, Section_Name.all, Parser.Switch_Character) (Get_Switches (Config, Parser.Switch_Character, Section_Name.all)
& " h -help"); & " h -help");
-- Initialize output values for automatically handled switches -- Initialize output values for automatically handled switches
...@@ -3258,7 +3326,7 @@ package body GNAT.Command_Line is ...@@ -3258,7 +3326,7 @@ package body GNAT.Command_Line is
Free (Getopt_Switches); Free (Getopt_Switches);
Getopt_Switches := new String' Getopt_Switches := new String'
(Get_Switches (Get_Switches
(Config, Section_Name.all, Parser.Switch_Character)); (Config, Parser.Switch_Character, Section_Name.all));
end if; end if;
end loop; end loop;
...@@ -3269,6 +3337,7 @@ package body GNAT.Command_Line is ...@@ -3269,6 +3337,7 @@ package body GNAT.Command_Line is
Free (Getopt_Switches); Free (Getopt_Switches);
-- Message inspired by "ls" on Unix -- Message inspired by "ls" on Unix
Put_Line (Standard_Error, Put_Line (Standard_Error,
Base_Name (Ada.Command_Line.Command_Name) Base_Name (Ada.Command_Line.Command_Name)
& ": unrecognized option '" & ": unrecognized option '"
...@@ -3298,6 +3367,7 @@ package body GNAT.Command_Line is ...@@ -3298,6 +3367,7 @@ package body GNAT.Command_Line is
is is
Iter : Command_Line_Iterator; Iter : Command_Line_Iterator;
Count : Natural := 0; Count : Natural := 0;
begin begin
Start (Line, Iter, Expanded => Expanded); Start (Line, Iter, Expanded => Expanded);
while Has_More (Iter) loop while Has_More (Iter) loop
......
gcc/ada/g-comlin.ads
...@@ -33,9 +33,9 @@ ...@@ -33,9 +33,9 @@
-- High level package for command line parsing and manipulation -- High level package for command line parsing and manipulation
-------------------------------------- ----------------------------------------
-- Simple parsing of the command line -- Simple Parsing of the Command Line --
-------------------------------------- ----------------------------------------
-- This package provides an interface for parsing command line arguments, -- This package provides an interface for parsing command line arguments,
-- when they are either read from Ada.Command_Line or read from a string list. -- when they are either read from Ada.Command_Line or read from a string list.
...@@ -84,9 +84,9 @@ ...@@ -84,9 +84,9 @@
-- when Invalid_Parameter => Put_Line ("No parameter for " & Full_Switch); -- when Invalid_Parameter => Put_Line ("No parameter for " & Full_Switch);
-- end; -- end;
------------- --------------
-- Sections -- Sections --
------------- --------------
-- A more complicated example would involve the use of sections for the -- A more complicated example would involve the use of sections for the
-- switches, as for instance in gnatmake. The same command line is used to -- switches, as for instance in gnatmake. The same command line is used to
...@@ -113,9 +113,9 @@ ...@@ -113,9 +113,9 @@
-- end loop; -- end loop;
-- end; -- end;
------------------------------ -------------------------------
-- Parsing a list of strings -- Parsing a List of Strings --
------------------------------ -------------------------------
-- The examples above show how to parse the command line when the arguments -- The examples above show how to parse the command line when the arguments
-- are read directly from Ada.Command_Line. However, these arguments can also -- are read directly from Ada.Command_Line. However, these arguments can also
...@@ -144,9 +144,9 @@ ...@@ -144,9 +144,9 @@
-- Free (Parser); -- Free (Parser);
-- end; -- end;
---------------------------------------------- -------------------------------------------
-- High level command line configuration -- High-Level Command Line Configuration --
---------------------------------------------- -------------------------------------------
-- As shown above, the code is still relatively low-level. For instance, there -- As shown above, the code is still relatively low-level. For instance, there
-- is no way to indicate which switches are related (thus if "-l" and "--long" -- is no way to indicate which switches are related (thus if "-l" and "--long"
...@@ -219,9 +219,9 @@ ...@@ -219,9 +219,9 @@
-- Optimization and Verbose have been properly initialized, either to the -- Optimization and Verbose have been properly initialized, either to the
-- default value or to the value found on the command line. -- default value or to the value found on the command line.
---------------------------------------------- ------------------------------------------------
-- Creating and manipulating the command line -- Creating and Manipulating the Command Line --
---------------------------------------------- ------------------------------------------------
-- This package provides mechanisms to create and modify command lines by -- This package provides mechanisms to create and modify command lines by
-- adding or removing arguments from them. The resulting command line is kept -- adding or removing arguments from them. The resulting command line is kept
...@@ -276,6 +276,7 @@ ...@@ -276,6 +276,7 @@
-- and will not be grouped with other parts of the command line. -- and will not be grouped with other parts of the command line.
with Ada.Command_Line; with Ada.Command_Line;
with GNAT.Directory_Operations; with GNAT.Directory_Operations;
with GNAT.OS_Lib; with GNAT.OS_Lib;
with GNAT.Regexp; with GNAT.Regexp;
...@@ -537,12 +538,14 @@ package GNAT.Command_Line is ...@@ -537,12 +538,14 @@ package GNAT.Command_Line is
----------------- -----------------
-- Configuring -- -- Configuring --
----------------- -----------------
-- The following subprograms are used to manipulate a command line -- The following subprograms are used to manipulate a command line
-- represented as a string (for instance "-g -O2"), as well as parsing -- represented as a string (for instance "-g -O2"), as well as parsing
-- the switches from such a string. They provide high-level configurations -- the switches from such a string. They provide high-level configurations
-- to define aliases (a switch is equivalent to one or more other switches) -- to define aliases (a switch is equivalent to one or more other switches)
-- or grouping of switches ("-gnatyac" is equivalent to "-gnatya" and -- or grouping of switches ("-gnatyac" is equivalent to "-gnatya" and
-- "-gnatyc"). -- "-gnatyc").
-- See the top of this file for examples on how to use these subprograms -- See the top of this file for examples on how to use these subprograms
type Command_Line_Configuration is private; type Command_Line_Configuration is private;
...@@ -553,8 +556,10 @@ package GNAT.Command_Line is ...@@ -553,8 +556,10 @@ package GNAT.Command_Line is
-- Indicates a new switch section. All switches belonging to the same -- Indicates a new switch section. All switches belonging to the same
-- section are ordered together, preceded by the section. They are placed -- section are ordered together, preceded by the section. They are placed
-- at the end of the command line (as in "gnatmake somefile.adb -cargs -g") -- at the end of the command line (as in "gnatmake somefile.adb -cargs -g")
-- The section name should not include the leading '-'. --
-- So for instance in the case of gnatmake we would use: -- The section name should not include the leading '-'. So for instance in
-- the case of gnatmake we would use:
--
-- Define_Section (Config, "cargs"); -- Define_Section (Config, "cargs");
-- Define_Section (Config, "bargs"); -- Define_Section (Config, "bargs");
...@@ -567,12 +572,13 @@ package GNAT.Command_Line is ...@@ -567,12 +572,13 @@ package GNAT.Command_Line is
-- be expanded as Expanded. For instance, for the GNAT compiler switches, -- be expanded as Expanded. For instance, for the GNAT compiler switches,
-- we would define "-gnatwa" as an alias for "-gnatwcfijkmopruvz", ie some -- we would define "-gnatwa" as an alias for "-gnatwcfijkmopruvz", ie some
-- default warnings to be activated. -- default warnings to be activated.
--
-- This expansion is only done within the specified section, which must -- This expansion is only done within the specified section, which must
-- have been defined first through a call to [Define_Section]. -- have been defined first through a call to [Define_Section].
procedure Define_Prefix procedure Define_Prefix
(Config : in out Command_Line_Configuration; (Config : in out Command_Line_Configuration;
Prefix : String); Prefix : String);
-- Indicates that all switches starting with the given prefix should be -- Indicates that all switches starting with the given prefix should be
-- grouped. For instance, for the GNAT compiler we would define "-gnatw" as -- grouped. For instance, for the GNAT compiler we would define "-gnatw" as
-- a prefix, so that "-gnatwu -gnatwv" can be grouped into "-gnatwuv" It is -- a prefix, so that "-gnatwu -gnatwv" can be grouped into "-gnatwuv" It is
...@@ -666,14 +672,14 @@ package GNAT.Command_Line is ...@@ -666,14 +672,14 @@ package GNAT.Command_Line is
function Get_Switches function Get_Switches
(Config : Command_Line_Configuration; (Config : Command_Line_Configuration;
Section : String := ""; Switch_Char : Character := '-';
Switch_Char : Character := '-') return String; Section : String := "") return String;
-- Get the switches list as expected by Getopt, for a specific section of -- Get the switches list as expected by Getopt, for a specific section of
-- the command line. This list is built using all switches defined -- the command line. This list is built using all switches defined
-- previously via Define_Switch above. -- previously via Define_Switch above.
function Section_Delimiters function Section_Delimiters
(Config : Command_Line_Configuration) return String; (Config : Command_Line_Configuration) return String;
-- Return a string suitable for use in Initialize_Option_Scan -- Return a string suitable for use in Initialize_Option_Scan
procedure Free (Config : in out Command_Line_Configuration); procedure Free (Config : in out Command_Line_Configuration);
...@@ -728,13 +734,16 @@ package GNAT.Command_Line is ...@@ -728,13 +734,16 @@ package GNAT.Command_Line is
------------------------------ ------------------------------
-- Generating command lines -- -- Generating command lines --
------------------------------ ------------------------------
-- Once the command line configuration has been created, you can build your -- Once the command line configuration has been created, you can build your
-- own command line. This will be done in general because you need to spawn -- own command line. This will be done in general because you need to spawn
-- external tools from your application. -- external tools from your application.
-- Although it could be done by concatenating strings, the following -- Although it could be done by concatenating strings, the following
-- subprograms will properly take care of grouping switches when possible, -- subprograms will properly take care of grouping switches when possible,
-- so as to keep the command line as short as possible. They also provide a -- so as to keep the command line as short as possible. They also provide a
-- way to remove a switch from an existing command line. -- way to remove a switch from an existing command line.
-- For instance: -- For instance:
-- declare -- declare
-- Config : Command_Line_Configuration; -- Config : Command_Line_Configuration;
...@@ -920,11 +929,12 @@ package GNAT.Command_Line is ...@@ -920,11 +929,12 @@ package GNAT.Command_Line is
Args : out GNAT.OS_Lib.Argument_List_Access; Args : out GNAT.OS_Lib.Argument_List_Access;
Expanded : Boolean := False; Expanded : Boolean := False;
Switch_Char : Character := '-'); Switch_Char : Character := '-');
-- This is a wrapper using the Command_Line_Iterator. -- This is a wrapper using the Command_Line_Iterator. It provides a simple
-- It provides a simple way to get all switches (grouped as much as -- way to get all switches (grouped as much as possible), and possibly
-- possible), and possibly create an Opt_Parser. -- create an Opt_Parser.
-- [Args] must be freed by the caller. --
-- [Expanded] has the same meaning as in [Start]. -- Args must be freed by the caller.
-- Expanded has the same meaning as in Start.
private private
...@@ -1020,7 +1030,7 @@ private ...@@ -1020,7 +1030,7 @@ private
end record; end record;
Command_Line_Parser_Data : aliased Opt_Parser_Data Command_Line_Parser_Data : aliased Opt_Parser_Data
(Ada.Command_Line.Argument_Count); (Ada.Command_Line.Argument_Count);
-- The internal data used when parsing the command line -- The internal data used when parsing the command line
type Opt_Parser is access all Opt_Parser_Data; type Opt_Parser is access all Opt_Parser_Data;
...@@ -1057,24 +1067,24 @@ private ...@@ -1057,24 +1067,24 @@ private
-- [Switch] includes the leading '-' -- [Switch] includes the leading '-'
type Alias_Definition is record type Alias_Definition is record
Alias : GNAT.OS_Lib.String_Access; Alias : GNAT.OS_Lib.String_Access;
Expansion : GNAT.OS_Lib.String_Access; Expansion : GNAT.OS_Lib.String_Access;
Section : GNAT.OS_Lib.String_Access; Section : GNAT.OS_Lib.String_Access;
end record; end record;
type Alias_Definitions is array (Natural range <>) of Alias_Definition; type Alias_Definitions is array (Natural range <>) of Alias_Definition;
type Alias_Definitions_List is access all Alias_Definitions; type Alias_Definitions_List is access all Alias_Definitions;
type Command_Line_Configuration_Record is record type Command_Line_Configuration_Record is record
Prefixes : GNAT.OS_Lib.Argument_List_Access; Prefixes : GNAT.OS_Lib.Argument_List_Access;
-- The list of prefixes -- The list of prefixes
Sections : GNAT.OS_Lib.Argument_List_Access; Sections : GNAT.OS_Lib.Argument_List_Access;
-- The list of sections -- The list of sections
Aliases : Alias_Definitions_List; Aliases : Alias_Definitions_List;
Usage : GNAT.OS_Lib.String_Access; Usage : GNAT.OS_Lib.String_Access;
Help : GNAT.OS_Lib.String_Access; Help : GNAT.OS_Lib.String_Access;
Switches : Switch_Definitions_List; Switches : Switch_Definitions_List;
-- List of expected switches (Used when expanding switch groups) -- List of expected switches (Used when expanding switch groups)
end record; end record;
type Command_Line_Configuration is access Command_Line_Configuration_Record; type Command_Line_Configuration is access Command_Line_Configuration_Record;
......
gcc/ada/xref_lib.adb
...@@ -555,6 +555,7 @@ package body Xref_Lib is ...@@ -555,6 +555,7 @@ package body Xref_Lib is
when 'Y' => return "entry"; when 'Y' => return "entry";
when '+' => return "private type"; when '+' => return "private type";
when '*' => return "private variable";
-- The above should be the only possibilities, but for this kind -- The above should be the only possibilities, but for this kind
-- of informational output, we don't want to bomb if we find -- of informational output, we don't want to bomb if we find
......
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