Skip to content

R
riscv-gcc-1
Commit 65529f74 by Arnaud Charlet
Options

[multiple changes] 

2014-05-21  Robert Dewar  <dewar@adacore.com>

	* sem_warn.adb: Minor fix to warning messages (use ?? instead
	of ?).

2014-05-21  Vincent Celier  <celier@adacore.com>

	* gnatcmd.adb (GNATCmd): For platforms other than VMS, recognize
	switch --version and --help.

2014-05-21  Robert Dewar  <dewar@adacore.com>

	* sem_elab.adb (Is_Call_Of_Generic_Formal): New function.

2014-05-21  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch5.adb (Analyze_Iterator_Specification): Set type of
	iterator variable when the domain of iteration is a formal
	container and this is an element iterator.

2014-05-21  Bob Duff  <duff@adacore.com>

	* sem_ch12.adb: Minor reformatting.

From-SVN: r210707
parent d3289ba2
Showing with 172 additions and 111 deletions
gcc/ada/ChangeLog
2014-05-21 Robert Dewar <dewar@adacore.com> 2014-05-21 Robert Dewar <dewar@adacore.com>
* sem_warn.adb: Minor fix to warning messages (use ?? instead
of ?).
2014-05-21 Vincent Celier <celier@adacore.com>
* gnatcmd.adb (GNATCmd): For platforms other than VMS, recognize
switch --version and --help.
2014-05-21 Robert Dewar <dewar@adacore.com>
* sem_elab.adb (Is_Call_Of_Generic_Formal): New function.
2014-05-21 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb (Analyze_Iterator_Specification): Set type of
iterator variable when the domain of iteration is a formal
container and this is an element iterator.
2014-05-21 Bob Duff <duff@adacore.com>
* sem_ch12.adb: Minor reformatting.
2014-05-21 Robert Dewar <dewar@adacore.com>
* sinfo.ads, sem_ch12.adb, sem_warn.adb: Minor reformatting. * sinfo.ads, sem_ch12.adb, sem_warn.adb: Minor reformatting.
2014-05-21 Robert Dewar <dewar@adacore.com> 2014-05-21 Robert Dewar <dewar@adacore.com>
......
gcc/ada/gnatcmd.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1996-2013, Free Software Foundation, Inc. -- -- Copyright (C) 1996-2014, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -45,6 +45,7 @@ with Sdefault; ...@@ -45,6 +45,7 @@ with Sdefault;
with Sinput.P; with Sinput.P;
with Snames; use Snames; with Snames; use Snames;
with Stringt; with Stringt;
with Switch; use Switch;
with Table; with Table;
with Targparm; with Targparm;
with Tempdir; with Tempdir;
...@@ -1382,6 +1383,9 @@ procedure GNATCmd is ...@@ -1382,6 +1383,9 @@ procedure GNATCmd is
end if; end if;
end Set_Library_For; end Set_Library_For;
procedure Check_Version_And_Help is
new Check_Version_And_Help_G (Non_VMS_Usage);
-- Start of processing for GNATCmd -- Start of processing for GNATCmd
begin begin
...@@ -1488,122 +1492,128 @@ begin ...@@ -1488,122 +1492,128 @@ begin
-- If not on VMS, scan the command line directly -- If not on VMS, scan the command line directly
else else
if Argument_Count = 0 then -- First, scan to detect --version and/or --help
Non_VMS_Usage;
return;
else
begin
loop
if Argument_Count > Command_Arg
and then Argument (Command_Arg) = "-v"
then
Verbose_Mode := True;
Command_Arg := Command_Arg + 1;
elsif Argument_Count > Command_Arg Check_Version_And_Help ("GNAT", "1996");
and then Argument (Command_Arg) = "-dn"
then
Keep_Temporary_Files := True;
Command_Arg := Command_Arg + 1;
else begin
exit; loop
end if; if Command_Arg <= Argument_Count
end loop; and then Argument (Command_Arg) = "-v"
then
Verbose_Mode := True;
Command_Arg := Command_Arg + 1;
The_Command := Real_Command_Type'Value (Argument (Command_Arg)); elsif Command_Arg <= Argument_Count
and then Argument (Command_Arg) = "-dn"
then
Keep_Temporary_Files := True;
Command_Arg := Command_Arg + 1;
if Command_List (The_Command).VMS_Only then else
Non_VMS_Usage; exit;
Fail
("Command """
& Command_List (The_Command).Cname.all
& """ can only be used on VMS");
end if; end if;
end loop;
exception -- If there is no command, just output the usage
when Constraint_Error =>
-- Check if it is an alternate command if Command_Arg > Argument_Count then
Non_VMS_Usage;
return;
end if;
declare The_Command := Real_Command_Type'Value (Argument (Command_Arg));
Alternate : Alternate_Command;
begin if Command_List (The_Command).VMS_Only then
Alternate := Alternate_Command'Value Non_VMS_Usage;
(Argument (Command_Arg)); Fail
The_Command := Corresponding_To (Alternate); ("Command """
& Command_List (The_Command).Cname.all
exception & """ can only be used on VMS");
when Constraint_Error => end if;
Non_VMS_Usage;
Fail ("Unknown command: " & Argument (Command_Arg)); exception
end; when Constraint_Error =>
end;
-- Get the arguments from the command line and from the eventual -- Check if it is an alternate command
-- argument file(s) specified on the command line.
for Arg in Command_Arg + 1 .. Argument_Count loop
declare declare
The_Arg : constant String := Argument (Arg); Alternate : Alternate_Command;
begin begin
-- Check if an argument file is specified Alternate := Alternate_Command'Value
(Argument (Command_Arg));
The_Command := Corresponding_To (Alternate);
exception
when Constraint_Error =>
Non_VMS_Usage;
Fail ("Unknown command: " & Argument (Command_Arg));
end;
end;
if The_Arg (The_Arg'First) = '@' then -- Get the arguments from the command line and from the eventual
declare -- argument file(s) specified on the command line.
Arg_File : Ada.Text_IO.File_Type;
Line : String (1 .. 256);
Last : Natural;
begin for Arg in Command_Arg + 1 .. Argument_Count loop
-- Open the file and fail if the file cannot be found declare
The_Arg : constant String := Argument (Arg);
begin begin
Open -- Check if an argument file is specified
(Arg_File, In_File,
The_Arg (The_Arg'First + 1 .. The_Arg'Last));
exception if The_Arg (The_Arg'First) = '@' then
when others => declare
Put Arg_File : Ada.Text_IO.File_Type;
(Standard_Error, "Cannot open argument file """); Line : String (1 .. 256);
Put Last : Natural;
(Standard_Error,
The_Arg (The_Arg'First + 1 .. The_Arg'Last));
Put_Line (Standard_Error, """"); begin
raise Error_Exit; -- Open the file and fail if the file cannot be found
end;
-- Read line by line and put the content of each non- begin
-- empty line in the Last_Switches table. Open
(Arg_File, In_File,
The_Arg (The_Arg'First + 1 .. The_Arg'Last));
exception
when others =>
Put
(Standard_Error, "Cannot open argument file """);
Put
(Standard_Error,
The_Arg (The_Arg'First + 1 .. The_Arg'Last));
while not End_Of_File (Arg_File) loop Put_Line (Standard_Error, """");
Get_Line (Arg_File, Line, Last); raise Error_Exit;
end;
if Last /= 0 then -- Read line by line and put the content of each non-
Last_Switches.Increment_Last; -- empty line in the Last_Switches table.
Last_Switches.Table (Last_Switches.Last) :=
new String'(Line (1 .. Last));
end if;
end loop;
Close (Arg_File); while not End_Of_File (Arg_File) loop
end; Get_Line (Arg_File, Line, Last);
else if Last /= 0 then
-- It is not an argument file; just put the argument in Last_Switches.Increment_Last;
-- the Last_Switches table. Last_Switches.Table (Last_Switches.Last) :=
new String'(Line (1 .. Last));
end if;
end loop;
Last_Switches.Increment_Last; Close (Arg_File);
Last_Switches.Table (Last_Switches.Last) := end;
new String'(The_Arg);
end if; else
end; -- It is not an argument file; just put the argument in
end loop; -- the Last_Switches table.
end if;
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
new String'(The_Arg);
end if;
end;
end loop;
end if; end if;
declare declare
......
gcc/ada/sem_ch12.adb
...@@ -10070,6 +10070,7 @@ package body Sem_Ch12 is ...@@ -10070,6 +10070,7 @@ package body Sem_Ch12 is
Set_Corresponding_Spec (Act_Body, Act_Decl_Id); Set_Corresponding_Spec (Act_Body, Act_Decl_Id);
Check_Generic_Actuals (Act_Decl_Id, False); Check_Generic_Actuals (Act_Decl_Id, False);
Check_Initialized_Types; Check_Initialized_Types;
-- Install primitives hidden at the point of the instantiation but -- Install primitives hidden at the point of the instantiation but
......
gcc/ada/sem_ch5.adb
...@@ -1868,9 +1868,18 @@ package body Sem_Ch5 is ...@@ -1868,9 +1868,18 @@ package body Sem_Ch5 is
if Of_Present (N) then if Of_Present (N) then
if Has_Aspect (Typ, Aspect_Iterable) then if Has_Aspect (Typ, Aspect_Iterable) then
if No (Get_Iterable_Type_Primitive (Typ, Name_Element)) then declare
Error_Msg_N ("missing Element primitive for iteration", N); Elt : constant Entity_Id :=
end if; Get_Iterable_Type_Primitive (Typ, Name_Element);
begin
if No (Elt) then
Error_Msg_N
("missing Element primitive for iteration", N);
else
Set_Etype (Def_Id, Etype (Elt));
end if;
end;
-- For a predefined container, The type of the loop variable is -- For a predefined container, The type of the loop variable is
-- the Iterator_Element aspect of the container type. -- the Iterator_Element aspect of the container type.
......
gcc/ada/sem_elab.adb
...@@ -541,6 +541,27 @@ package body Sem_Elab is ...@@ -541,6 +541,27 @@ package body Sem_Elab is
-- warnings on the scope are also suppressed. For the internal case, -- warnings on the scope are also suppressed. For the internal case,
-- we ignore this flag. -- we ignore this flag.
function Is_Call_Of_Generic_Formal return Boolean;
-- Returns True if node N is a call to a generic formal subprogram
-------------------------------
-- Is_Call_Of_Generic_Formal --
-------------------------------
function Is_Call_Of_Generic_Formal return Boolean is
begin
return Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement)
-- For now, we detect this by looking for the strange identifier
-- node, whose Chars reflect the name of the generic formal, but
-- the Chars of the Entity references the generic actual.
and then Nkind (Name (N)) = N_Identifier
and then Chars (Name (N)) /= Chars (Entity (Name (N)));
end Is_Call_Of_Generic_Formal;
-- Start of processing for Check_A_Call
begin begin
-- If the call is known to be within a local Suppress Elaboration -- If the call is known to be within a local Suppress Elaboration
-- pragma, nothing to check. This can happen in task bodies. -- pragma, nothing to check. This can happen in task bodies.
...@@ -752,8 +773,9 @@ package body Sem_Elab is ...@@ -752,8 +773,9 @@ package body Sem_Elab is
-- However, if we are doing dynamic elaboration, we need to chase the -- However, if we are doing dynamic elaboration, we need to chase the
-- call in the usual manner. -- call in the usual manner.
-- We do not handle the case of calling a generic formal correctly in -- We also need to chase the call in the usual manner if it is a call
-- the static case.??? -- to a generic formal parameter, since that case was not handled as
-- part of the processing of the template.
Inst_Caller := Instantiation (Get_Source_File_Index (Sloc (N))); Inst_Caller := Instantiation (Get_Source_File_Index (Sloc (N)));
Inst_Callee := Instantiation (Get_Source_File_Index (Sloc (Ent))); Inst_Callee := Instantiation (Get_Source_File_Index (Sloc (Ent)));
...@@ -773,14 +795,8 @@ package body Sem_Elab is ...@@ -773,14 +795,8 @@ package body Sem_Elab is
if Unit_Caller /= No_Unit if Unit_Caller /= No_Unit
and then Unit_Callee /= Unit_Caller and then Unit_Callee /= Unit_Caller
and then not Dynamic_Elaboration_Checks and then not Dynamic_Elaboration_Checks
and then not Is_Call_Of_Generic_Formal
-- This is an attempt to solve the problem of mishandling of
-- generic formal parameters, but it does not work right yet ???
-- and then not Used_As_Generic_Actual (Ent)
then then
-- It is here that things go wrong for calling a generic formal???
E_Scope := Spec_Entity (Cunit_Entity (Unit_Caller)); E_Scope := Spec_Entity (Cunit_Entity (Unit_Caller));
-- If we don't get a spec entity, just ignore call. Not quite -- If we don't get a spec entity, just ignore call. Not quite
...@@ -796,11 +812,12 @@ package body Sem_Elab is ...@@ -796,11 +812,12 @@ package body Sem_Elab is
E_Scope := Scope (E_Scope); E_Scope := Scope (E_Scope);
end loop; end loop;
-- For the case N is not an instance, or a call within instance, we -- For the case where N is not an instance, and is not a call within
-- recompute E_Scope for the error message, since we do NOT want to -- instance to other than a generic formal, we recompute E_Scope
-- go to the unit which has the ultimate declaration in the case of -- for the error message, since we do NOT want to go to the unit
-- renaming and derivation and we also want to go to the generic unit -- which has the ultimate declaration in the case of renaming and
-- in the case of an instance, and no further. -- derivation and we also want to go to the generic unit in the
-- case of an instance, and no further.
else else
-- Loop to carefully follow renamings and derivations one step -- Loop to carefully follow renamings and derivations one step
......
gcc/ada/sem_warn.adb
...@@ -852,9 +852,9 @@ package body Sem_Warn is ...@@ -852,9 +852,9 @@ package body Sem_Warn is
end if; end if;
if Res then if Res then
Error_Msg_N ("?!variable& of a generic type is potentially " Error_Msg_N ("??!variable& of a generic type is potentially "
& "uninitialized", Ent); & "uninitialized", Ent);
Error_Msg_NE ("\?instantiations must provide fully initialized " Error_Msg_NE ("\??instantiations must provide fully initialized "
& "type for&", Ent, T); & "type for&", Ent, T);
end if; end if;
......
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