[multiple changes]

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

	* errout.adb, erroutc.adb, erroutc.ads: Allow warning tag in pragma
	Warnings (Off, string).

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

	* osint.adb: Fix three error messages to say invalid instead
	of erroneous.
	* par-ch4.adb, exp_aggr.adb, sem_attr.adb, sem_aux.adb, sem_ch3.adb,
	sem_ch5.adb, sem_ch6.adb, sem_ch7.adb, sem_dim.adb, sem_res.adb,
	sem_util.adb, sem_util.ads: Fix incorrect use of erroneous in comments.

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

	* freeze.adb, sem_ch13.adb, sem_ch13.ads, sem_ch9.adb,
	sem_ch9.ads: Move discriminant manipulation routines for analysis of
	aspect specifications from sem_ch9 to sem_ch13, where they belong.

From-SVN: r210695
This commit is contained in:
Arnaud Charlet 2014-05-21 14:35:51 +02:00
parent dbed5a9bff
commit 77a40ec16a
22 changed files with 192 additions and 159 deletions

View File

@ -1,3 +1,22 @@
2014-05-21 Robert Dewar <dewar@adacore.com>
* errout.adb, erroutc.adb, erroutc.ads: Allow warning tag in pragma
Warnings (Off, string).
2014-05-21 Robert Dewar <dewar@adacore.com>
* osint.adb: Fix three error messages to say invalid instead
of erroneous.
* par-ch4.adb, exp_aggr.adb, sem_attr.adb, sem_aux.adb, sem_ch3.adb,
sem_ch5.adb, sem_ch6.adb, sem_ch7.adb, sem_dim.adb, sem_res.adb,
sem_util.adb, sem_util.ads: Fix incorrect use of erroneous in comments.
2014-05-21 Ed Schonberg <schonberg@adacore.com>
* freeze.adb, sem_ch13.adb, sem_ch13.ads, sem_ch9.adb,
sem_ch9.ads: Move discriminant manipulation routines for analysis of
aspect specifications from sem_ch9 to sem_ch13, where they belong.
2014-05-21 Robert Dewar <dewar@adacore.com>
* gnat_ugn.texi: Clearly document -gnatw.g (GNAT warnings).

View File

@ -1339,14 +1339,16 @@ package body Errout is
Cur := First_Error_Msg;
while Cur /= No_Error_Msg loop
declare
CE : Error_Msg_Object renames Errors.Table (Cur);
CE : Error_Msg_Object renames Errors.Table (Cur);
Tag : constant String := Get_Warning_Tag (Cur);
begin
if (CE.Warn and not CE.Deleted)
and then (Warning_Specifically_Suppressed (CE.Sptr, CE.Text) /=
and then
(Warning_Specifically_Suppressed (CE.Sptr, CE.Text, Tag) /=
No_String
or else
Warning_Specifically_Suppressed (CE.Optr, CE.Text) /=
or else
Warning_Specifically_Suppressed (CE.Optr, CE.Text, Tag) /=
No_String)
then
Delete_Warning (Cur);

View File

@ -1457,7 +1457,8 @@ package body Erroutc is
function Warning_Specifically_Suppressed
(Loc : Source_Ptr;
Msg : String_Ptr) return String_Id
Msg : String_Ptr;
Tag : String) return String_Id
is
begin
-- Loop through specific warning suppression entries
@ -1473,7 +1474,9 @@ package body Erroutc is
if SWE.Config
or else (SWE.Start <= Loc and then Loc <= SWE.Stop)
then
if Matches (Msg.all, SWE.Msg.all) then
if Matches (Msg.all, SWE.Msg.all)
or else Matches (Tag, SWE.Msg.all)
then
SWE.Used := True;
return SWE.Reason;
end if;

View File

@ -556,12 +556,14 @@ package Erroutc is
function Warning_Specifically_Suppressed
(Loc : Source_Ptr;
Msg : String_Ptr) return String_Id;
Msg : String_Ptr;
Tag : String) return String_Id;
-- Determines if given message to be posted at given location is suppressed
-- by specific ON/OFF Warnings pragmas specifying this particular message.
-- If the warning is not suppressed then No_String is returned, otherwise
-- the corresponding warning string is returned (or the null string if no
-- Warning argument was present in the pragma).
-- Warning argument was present in the pragma). Tag is the error message
-- tag for the message in question.
function Warning_Treated_As_Error (Msg : String) return Boolean;
-- Returns True if the warning message Msg matches any of the strings

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
@ -5300,7 +5300,7 @@ package body Exp_Aggr is
-- interactions with bootstrapping. That limit is removed by
-- use of the No_Implicit_Loops restriction.
-- b) It erroneously ends up with the resulting expressions being
-- b) It incorrectly ends up with the resulting expressions being
-- considered static when they are not. For example, the
-- following test should fail:

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
@ -50,7 +50,6 @@ with Sem_Cat; use Sem_Cat;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch7; use Sem_Ch7;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch9; use Sem_Ch9;
with Sem_Ch13; use Sem_Ch13;
with Sem_Eval; use Sem_Eval;
with Sem_Mech; use Sem_Mech;

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
@ -2988,7 +2988,7 @@ package body Osint is
exception
when others =>
Fail ("erroneous directory spec: " & Host_Dir);
Fail ("invalid directory spec: " & Host_Dir);
return null;
end To_Canonical_Dir_Spec;
@ -3081,7 +3081,7 @@ package body Osint is
exception
when others =>
Fail ("erroneous file spec: " & Host_File);
Fail ("invalid file spec: " & Host_File);
return null;
end To_Canonical_File_Spec;
@ -3114,7 +3114,7 @@ package body Osint is
exception
when others =>
Fail ("erroneous path spec: " & Host_Path);
Fail ("invalid path spec: " & Host_Path);
return null;
end To_Canonical_Path_Spec;

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
@ -376,7 +376,7 @@ package body Ch4 is
-- If dot is at end of line and followed by nothing legal,
-- then assume end of name and quit (dot will be taken as
-- an erroneous form of some other punctuation by our caller).
-- an incorrect form of some other punctuation by our caller).
elsif Token_Is_At_Start_Of_Line then
Restore_Scan_State (Scan_State);
@ -770,11 +770,11 @@ package body Ch4 is
Expr_Node := P_Expression_If_OK;
goto LP_State_Expr;
-- LP_State_Call corresponds to the situation in which at least
-- one instance of Id => Expression has been encountered, so we
-- know that we do not have a name, but rather a call. We enter
-- it with the scan pointer pointing to the next argument to scan,
-- and Arg_List containing the list of arguments scanned so far.
-- LP_State_Call corresponds to the situation in which at least one
-- instance of Id => Expression has been encountered, so we know that
-- we do not have a name, but rather a call. We enter it with the
-- scan pointer pointing to the next argument to scan, and Arg_List
-- containing the list of arguments scanned so far.
<<LP_State_Call>>
@ -785,7 +785,7 @@ package body Ch4 is
Ident_Node := Token_Node;
Scan; -- past Id
-- Deal with => (allow := as erroneous substitute)
-- Deal with => (allow := as incorrect substitute)
if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
Arg_Node := New_Node (N_Parameter_Association, Prev_Token_Ptr);

View File

@ -6172,7 +6172,7 @@ package body Sem_Attr is
Comp_Or_Discr := Next_Entity (Comp_Or_Discr);
end loop;
-- Diagnose possible erroneous references
-- Diagnose possible illegal references
if Present (Comp_Or_Discr) then
if Ekind (Comp_Or_Discr) = E_Discriminant then

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
@ -1008,7 +1008,7 @@ package body Sem_Aux is
-- Otherwise we will look around to see if there is some other reason
-- for it to be limited, except that if an error was posted on the
-- entity, then just assume it is non-limited, because it can cause
-- trouble to recurse into a murky erroneous entity.
-- trouble to recurse into a murky entity resulting from other errors.
elsif Error_Posted (Ent) then
return False;

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
@ -48,7 +48,6 @@ with Sem_Case; use Sem_Case;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch9; use Sem_Ch9;
with Sem_Dim; use Sem_Dim;
with Sem_Disp; use Sem_Disp;
with Sem_Eval; use Sem_Eval;
@ -10059,6 +10058,24 @@ package body Sem_Ch13 is
Unchecked_Conversions.Init;
end Initialize;
---------------------------
-- Install_Discriminants --
---------------------------
procedure Install_Discriminants (E : Entity_Id) is
Disc : Entity_Id;
Prev : Entity_Id;
begin
Disc := First_Discriminant (E);
while Present (Disc) loop
Prev := Current_Entity (Disc);
Set_Current_Entity (Disc);
Set_Is_Immediately_Visible (Disc);
Set_Homonym (Disc, Prev);
Next_Discriminant (Disc);
end loop;
end Install_Discriminants;
-------------------------
-- Is_Operational_Item --
-------------------------
@ -10433,6 +10450,24 @@ package body Sem_Ch13 is
end if;
end New_Stream_Subprogram;
------------------------------------------
-- Push_Scope_And_Install_Discriminants --
------------------------------------------
procedure Push_Scope_And_Install_Discriminants (E : Entity_Id) is
begin
if Has_Discriminants (E) then
Push_Scope (E);
-- Make discriminants visible for type declarations and protected
-- type declarations, not for subtype declarations (RM 13.1.1 (12/3))
if Nkind (Parent (E)) /= N_Subtype_Declaration then
Install_Discriminants (E);
end if;
end if;
end Push_Scope_And_Install_Discriminants;
------------------------
-- Rep_Item_Too_Early --
------------------------
@ -11138,6 +11173,69 @@ package body Sem_Ch13 is
end if;
end Set_Enum_Esize;
-----------------------------
-- Uninstall_Discriminants --
-----------------------------
procedure Uninstall_Discriminants (E : Entity_Id) is
Disc : Entity_Id;
Prev : Entity_Id;
Outer : Entity_Id;
begin
-- Discriminants have been made visible for type declarations and
-- protected type declarations, not for subtype declarations.
if Nkind (Parent (E)) /= N_Subtype_Declaration then
Disc := First_Discriminant (E);
while Present (Disc) loop
if Disc /= Current_Entity (Disc) then
Prev := Current_Entity (Disc);
while Present (Prev)
and then Present (Homonym (Prev))
and then Homonym (Prev) /= Disc
loop
Prev := Homonym (Prev);
end loop;
else
Prev := Empty;
end if;
Set_Is_Immediately_Visible (Disc, False);
Outer := Homonym (Disc);
while Present (Outer) and then Scope (Outer) = E loop
Outer := Homonym (Outer);
end loop;
-- Reset homonym link of other entities, but do not modify link
-- between entities in current scope, so that the back-end can
-- have a proper count of local overloadings.
if No (Prev) then
Set_Name_Entity_Id (Chars (Disc), Outer);
elsif Scope (Prev) /= Scope (Disc) then
Set_Homonym (Prev, Outer);
end if;
Next_Discriminant (Disc);
end loop;
end if;
end Uninstall_Discriminants;
-------------------------------------------
-- Uninstall_Discriminants_And_Pop_Scope --
-------------------------------------------
procedure Uninstall_Discriminants_And_Pop_Scope (E : Entity_Id) is
begin
if Has_Discriminants (E) then
Uninstall_Discriminants (E);
Pop_Scope;
end if;
end Uninstall_Discriminants_And_Pop_Scope;
------------------------------
-- Validate_Address_Clauses --
------------------------------

View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
@ -331,4 +331,27 @@ package Sem_Ch13 is
-- for First, Next, and Has_Element. Optionally an Element primitive may
-- also be defined.
-----------------------------------------------------------
-- Visibility of Discriminants in Aspect Specifications --
-----------------------------------------------------------
-- The discriminants of a type are visible when analyzing the aspect
-- specifications of a type declaration or protected type declaration,
-- but not when analyzing those of a subtype declaration. The following
-- routines enforce this distinction.
procedure Install_Discriminants (E : Entity_Id);
-- Make visible the discriminants of type entity E
procedure Push_Scope_And_Install_Discriminants (E : Entity_Id);
-- Push scope E and makes visible the discriminants of type entity E if E
-- has discriminants and is not a subtype.
procedure Uninstall_Discriminants (E : Entity_Id);
-- Remove visibility to the discriminants of type entity E
procedure Uninstall_Discriminants_And_Pop_Scope (E : Entity_Id);
-- Remove visibility to the discriminants of type entity E and pop the
-- scope stack if E has discriminants and is not a subtype.
end Sem_Ch13;

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
@ -18184,7 +18184,7 @@ package body Sem_Ch3 is
if Ekind (Typ) = E_Record_Type_With_Private then
-- Handle the following erroneous case:
-- Handle the following illegal usage:
-- type Private_Type is tagged private;
-- private
-- type Private_Type is new Type_Implementing_Iface;

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
@ -2352,7 +2352,7 @@ package body Sem_Ch5 is
-- Analyze the subtype definition and create temporaries for the bounds.
-- Do not evaluate the range when preanalyzing a quantified expression
-- because bounds expressed as function calls with side effects will be
-- erroneously replicated.
-- incorrectly replicated.
if Nkind (DS) = N_Range
and then Expander_Active

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
@ -2038,9 +2038,9 @@ package body Sem_Ch6 is
Ref_Global : Node_Id := Empty;
begin
-- When a subprogram body declaration is erroneous, its defining entity
-- is left unanalyzed. There is nothing left to do in this case because
-- the body lacks a contract.
-- When a subprogram body declaration is illegal, its defining entity is
-- left unanalyzed. There is nothing left to do in this case because the
-- body lacks a contract.
if not Analyzed (Body_Id) then
return;

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
@ -917,7 +917,7 @@ package body Sem_Ch7 is
Analyze_Aspect_Specifications (N, Id);
end if;
-- Ada 2005 (AI-217): Check if the package has been erroneously named
-- Ada 2005 (AI-217): Check if the package has been illegally named
-- in a limited-with clause of its own context. In this case the error
-- has been previously notified by Analyze_Context.

View File

@ -3420,103 +3420,4 @@ package body Sem_Ch9 is
Next_Entity (E);
end loop;
end Install_Declarations;
---------------------------
-- Install_Discriminants --
---------------------------
procedure Install_Discriminants (E : Entity_Id) is
Disc : Entity_Id;
Prev : Entity_Id;
begin
Disc := First_Discriminant (E);
while Present (Disc) loop
Prev := Current_Entity (Disc);
Set_Current_Entity (Disc);
Set_Is_Immediately_Visible (Disc);
Set_Homonym (Disc, Prev);
Next_Discriminant (Disc);
end loop;
end Install_Discriminants;
------------------------------------------
-- Push_Scope_And_Install_Discriminants --
------------------------------------------
procedure Push_Scope_And_Install_Discriminants (E : Entity_Id) is
begin
if Has_Discriminants (E) then
Push_Scope (E);
-- Make discriminants visible for type declarations and protected
-- type declarations, not for subtype declarations (RM 13.1.1 (12/3))
if Nkind (Parent (E)) /= N_Subtype_Declaration then
Install_Discriminants (E);
end if;
end if;
end Push_Scope_And_Install_Discriminants;
-----------------------------
-- Uninstall_Discriminants --
-----------------------------
procedure Uninstall_Discriminants (E : Entity_Id) is
Disc : Entity_Id;
Prev : Entity_Id;
Outer : Entity_Id;
begin
-- Discriminants have been made visible for type declarations and
-- protected type declarations, not for subtype declarations.
if Nkind (Parent (E)) /= N_Subtype_Declaration then
Disc := First_Discriminant (E);
while Present (Disc) loop
if Disc /= Current_Entity (Disc) then
Prev := Current_Entity (Disc);
while Present (Prev)
and then Present (Homonym (Prev))
and then Homonym (Prev) /= Disc
loop
Prev := Homonym (Prev);
end loop;
else
Prev := Empty;
end if;
Set_Is_Immediately_Visible (Disc, False);
Outer := Homonym (Disc);
while Present (Outer) and then Scope (Outer) = E loop
Outer := Homonym (Outer);
end loop;
-- Reset homonym link of other entities, but do not modify link
-- between entities in current scope, so that the back-end can
-- have a proper count of local overloadings.
if No (Prev) then
Set_Name_Entity_Id (Chars (Disc), Outer);
elsif Scope (Prev) /= Scope (Disc) then
Set_Homonym (Prev, Outer);
end if;
Next_Discriminant (Disc);
end loop;
end if;
end Uninstall_Discriminants;
-------------------------------------------
-- Uninstall_Discriminants_And_Pop_Scope --
-------------------------------------------
procedure Uninstall_Discriminants_And_Pop_Scope (E : Entity_Id) is
begin
if Has_Discriminants (E) then
Uninstall_Discriminants (E);
Pop_Scope;
end if;
end Uninstall_Discriminants_And_Pop_Scope;
end Sem_Ch9;

View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
@ -58,20 +58,6 @@ package Sem_Ch9 is
-- Make visible in corresponding body the entities defined in a task,
-- protected type declaration, or entry declaration.
procedure Install_Discriminants (E : Entity_Id);
-- Make visible the discriminants of type entity E
procedure Push_Scope_And_Install_Discriminants (E : Entity_Id);
-- Push scope E and makes visible the discriminants of type entity E if E
-- has discriminants.
procedure Uninstall_Discriminants (E : Entity_Id);
-- Remove visibility to the discriminants of type entity E
procedure Uninstall_Discriminants_And_Pop_Scope (E : Entity_Id);
-- Remove visibility to the discriminants of type entity E and pop the
-- scope stack if E has discriminants.
------------------------------
-- Lock Free Data Structure --
------------------------------

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2011-2013, Free Software Foundation, Inc. --
-- Copyright (C) 2011-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- --
@ -772,7 +772,7 @@ package body Sem_Dim is
Others_Seen := True;
-- All other cases are erroneous declarations of dimension names
-- All other cases are illegal declarations of dimension names
else
Error_Msg_NE ("wrong syntax for aspect&", Choice, Id);

View File

@ -4684,7 +4684,7 @@ package body Sem_Res is
Check_Restriction (No_Task_Hierarchy, N);
end if;
-- An erroneous allocator may be rewritten as a raise Program_Error
-- An illegal allocator may be rewritten as a raise Program_Error
-- statement.
if Nkind (N) = N_Allocator then

View File

@ -8241,7 +8241,7 @@ package body Sem_Util is
Index := First_Index (Typ);
for Indx in 1 .. Ndims loop
-- In case of an erroneous index which is not a discrete type, return
-- In case of an illegal index which is not a discrete type, return
-- that the type is not static.
if not Is_Discrete_Type (Etype (Index))

View File

@ -1451,7 +1451,7 @@ package Sem_Util is
procedure Mark_Coextensions (Context_Nod : Node_Id; Root_Nod : Node_Id);
-- Given a node which designates the context of analysis and an origin in
-- the tree, traverse from Root_Nod and mark all allocators as either
-- dynamic or static depending on Context_Nod. Any erroneous marking is
-- dynamic or static depending on Context_Nod. Any incorrect marking is
-- cleaned up during resolution.
function May_Be_Lvalue (N : Node_Id) return Boolean;