Commit 65529f74 by Arnaud Charlet

[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
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.
2014-05-21 Robert Dewar <dewar@adacore.com>
......
......@@ -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,19 +1492,19 @@ begin
-- If not on VMS, scan the command line directly
else
if Argument_Count = 0 then
Non_VMS_Usage;
return;
else
-- First, scan to detect --version and/or --help
Check_Version_And_Help ("GNAT", "1996");
begin
loop
if Argument_Count > Command_Arg
if Command_Arg <= Argument_Count
and then Argument (Command_Arg) = "-v"
then
Verbose_Mode := True;
Command_Arg := Command_Arg + 1;
elsif Argument_Count > Command_Arg
elsif Command_Arg <= Argument_Count
and then Argument (Command_Arg) = "-dn"
then
Keep_Temporary_Files := True;
......@@ -1511,6 +1515,13 @@ begin
end if;
end loop;
-- If there is no command, just output the usage
if Command_Arg > Argument_Count then
Non_VMS_Usage;
return;
end if;
The_Command := Real_Command_Type'Value (Argument (Command_Arg));
if Command_List (The_Command).VMS_Only then
......@@ -1604,7 +1615,6 @@ begin
end;
end loop;
end if;
end if;
declare
Program : String_Access;
......
......@@ -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
......
......@@ -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);
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.
......
......@@ -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
......
......@@ -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;
......
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