OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[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
This commit is contained in:
Arnaud Charlet 2014-05-21 15:19:28 +02:00
parent d3289ba2b4
commit 65529f7481
6 changed files with 173 additions and 112 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
gcc/ada/ChangeLog
View File

@ -1,3 +1,27 @@
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.

196
gcc/ada/gnatcmd.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -45,6 +45,7 @@ with Sdefault;
with Sinput.P;
with Snames; use Snames;
with Stringt;
with Switch; use Switch;
with Table;
with Targparm;
with Tempdir;
@ -1382,6 +1383,9 @@ procedure GNATCmd is
end if;
end Set_Library_For;
procedure Check_Version_And_Help is
new Check_Version_And_Help_G (Non_VMS_Usage);
-- Start of processing for GNATCmd
begin
@ -1488,122 +1492,128 @@ begin
-- If not on VMS, scan the command line directly
else
if Argument_Count = 0 then
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;
-- First, scan to detect --version and/or --help
elsif Argument_Count > Command_Arg
and then Argument (Command_Arg) = "-dn"
then
Keep_Temporary_Files := True;
Command_Arg := Command_Arg + 1;
Check_Version_And_Help ("GNAT", "1996");
else
exit;
end if;
end loop;
begin
loop
if Command_Arg <= Argument_Count
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
Non_VMS_Usage;
Fail
("Command """
& Command_List (The_Command).Cname.all
& """ can only be used on VMS");
else
exit;
end if;
end loop;
exception
when Constraint_Error =>
-- If there is no command, just output the usage
-- Check if it is an alternate command
if Command_Arg > Argument_Count then
Non_VMS_Usage;
return;
end if;
declare
Alternate : Alternate_Command;
The_Command := Real_Command_Type'Value (Argument (Command_Arg));
begin
Alternate := Alternate_Command'Value
(Argument (Command_Arg));
The_Command := Corresponding_To (Alternate);
if Command_List (The_Command).VMS_Only then
Non_VMS_Usage;
Fail
("Command """
& Command_List (The_Command).Cname.all
& """ can only be used on VMS");
end if;
exception
when Constraint_Error =>
Non_VMS_Usage;
Fail ("Unknown command: " & Argument (Command_Arg));
end;
end;
exception
when Constraint_Error =>
-- Get the arguments from the command line and from the eventual
-- argument file(s) specified on the command line.
-- Check if it is an alternate command
for Arg in Command_Arg + 1 .. Argument_Count loop
declare
The_Arg : constant String := Argument (Arg);
Alternate : Alternate_Command;
begin
-- Check if an argument file is specified
Alternate := Alternate_Command'Value
(Argument (Command_Arg));
The_Command := Corresponding_To (Alternate);
if The_Arg (The_Arg'First) = '@' then
declare
Arg_File : Ada.Text_IO.File_Type;
Line : String (1 .. 256);
Last : Natural;
exception
when Constraint_Error =>
Non_VMS_Usage;
Fail ("Unknown command: " & Argument (Command_Arg));
end;
end;
-- Get the arguments from the command line and from the eventual
-- argument file(s) specified on the command line.
for Arg in Command_Arg + 1 .. Argument_Count loop
declare
The_Arg : constant String := Argument (Arg);
begin
-- Check if an argument file is specified
if The_Arg (The_Arg'First) = '@' then
declare
Arg_File : Ada.Text_IO.File_Type;
Line : String (1 .. 256);
Last : Natural;
begin
-- Open the file and fail if the file cannot be found
begin
-- Open the file and fail if the file cannot be found
Open
(Arg_File, In_File,
The_Arg (The_Arg'First + 1 .. The_Arg'Last));
begin
Open
(Arg_File, In_File,
exception
when others =>
Put
(Standard_Error, "Cannot open argument file """);
Put
(Standard_Error,
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));
Put_Line (Standard_Error, """");
raise Error_Exit;
end;
-- Read line by line and put the content of each non-
-- empty line in the Last_Switches table.
while not End_Of_File (Arg_File) loop
Get_Line (Arg_File, Line, Last);
if Last /= 0 then
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
new String'(Line (1 .. Last));
end if;
end loop;
Close (Arg_File);
Put_Line (Standard_Error, """");
raise Error_Exit;
end;
else
-- It is not an argument file; just put the argument in
-- the Last_Switches table.
-- Read line by line and put the content of each non-
-- empty line in the Last_Switches table.
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
new String'(The_Arg);
end if;
end;
end loop;
end if;
while not End_Of_File (Arg_File) loop
Get_Line (Arg_File, Line, Last);
if Last /= 0 then
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
new String'(Line (1 .. Last));
end if;
end loop;
Close (Arg_File);
end;
else
-- It is not an argument file; just put the argument in
-- the Last_Switches table.
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
new String'(The_Arg);
end if;
end;
end loop;
end if;
declare

1
gcc/ada/sem_ch12.adb
View File

@ -10070,6 +10070,7 @@ package body Sem_Ch12 is
Set_Corresponding_Spec (Act_Body, Act_Decl_Id);
Check_Generic_Actuals (Act_Decl_Id, False);
Check_Initialized_Types;
-- Install primitives hidden at the point of the instantiation but

15
gcc/ada/sem_ch5.adb
View File

@ -1868,9 +1868,18 @@ package body Sem_Ch5 is
if Of_Present (N) then
if Has_Aspect (Typ, Aspect_Iterable) then
if No (Get_Iterable_Type_Primitive (Typ, Name_Element)) then
Error_Msg_N ("missing Element primitive for iteration", N);
end if;
declare
Elt : constant Entity_Id :=
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
-- the Iterator_Element aspect of the container type.

45
gcc/ada/sem_elab.adb
View File

@ -541,6 +541,27 @@ package body Sem_Elab is
-- warnings on the scope are also suppressed. For the internal case,
-- 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
-- If the call is known to be within a local Suppress Elaboration
-- pragma, nothing to check. This can happen in task bodies.
@ -752,8 +773,9 @@ package body Sem_Elab is
-- However, if we are doing dynamic elaboration, we need to chase the
-- call in the usual manner.
-- We do not handle the case of calling a generic formal correctly in
-- the static case.???
-- We also need to chase the call in the usual manner if it is a call
-- 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_Callee := Instantiation (Get_Source_File_Index (Sloc (Ent)));
@ -773,14 +795,8 @@ package body Sem_Elab is
if Unit_Caller /= No_Unit
and then Unit_Callee /= Unit_Caller
and then not Dynamic_Elaboration_Checks
-- 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)
and then not Is_Call_Of_Generic_Formal
then
-- It is here that things go wrong for calling a generic formal???
E_Scope := Spec_Entity (Cunit_Entity (Unit_Caller));
-- If we don't get a spec entity, just ignore call. Not quite
@ -796,11 +812,12 @@ package body Sem_Elab is
E_Scope := Scope (E_Scope);
end loop;
-- For the case N is not an instance, or a call within instance, we
-- recompute E_Scope for the error message, since we do NOT want to
-- go to the unit which has the ultimate declaration in the case of
-- renaming and derivation and we also want to go to the generic unit
-- in the case of an instance, and no further.
-- For the case where N is not an instance, and is not a call within
-- instance to other than a generic formal, we recompute E_Scope
-- for the error message, since we do NOT want to go to the unit
-- which has the ultimate declaration in the case of renaming and
-- derivation and we also want to go to the generic unit in the
-- case of an instance, and no further.
else
-- Loop to carefully follow renamings and derivations one step

4
gcc/ada/sem_warn.adb
View File

@ -852,9 +852,9 @@ package body Sem_Warn is
end if;
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);
Error_Msg_NE ("\?instantiations must provide fully initialized "
Error_Msg_NE ("\??instantiations must provide fully initialized "
& "type for&", Ent, T);
end if;