[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:
parent
dbed5a9bff
commit
77a40ec16a
@ -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).
|
||||
|
@ -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);
|
||||
|
@ -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;
|
||||
|
@ -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
|
||||
|
@ -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:
|
||||
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
||||
|
@ -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);
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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 --
|
||||
------------------------------
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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.
|
||||
|
||||
|
@ -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;
|
||||
|
@ -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 --
|
||||
------------------------------
|
||||
|
@ -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);
|
||||
|
@ -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
|
||||
|
@ -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))
|
||||
|
@ -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;
|
||||
|
Loading…
Reference in New Issue
Block a user