+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).
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);
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
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;
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
-- --
-- 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- --
-- 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:
-- --
-- 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- --
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;
-- --
-- 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- --
exception
when others =>
- Fail ("erroneous directory spec: " & Host_Dir);
+ Fail ("invalid directory spec: " & Host_Dir);
return null;
end To_Canonical_Dir_Spec;
exception
when others =>
- Fail ("erroneous file spec: " & Host_File);
+ Fail ("invalid file spec: " & Host_File);
return null;
end To_Canonical_File_Spec;
exception
when others =>
- Fail ("erroneous path spec: " & Host_Path);
+ Fail ("invalid path spec: " & Host_Path);
return null;
end To_Canonical_Path_Spec;
-- --
-- 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- --
-- 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);
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>>
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);
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
-- --
-- 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- --
-- 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;
-- --
-- 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- --
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;
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 --
-------------------------
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 --
------------------------
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 --
------------------------------
-- --
-- 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- --
-- 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;
-- --
-- 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- --
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;
-- --
-- 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- --
-- 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
-- --
-- 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- --
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;
-- --
-- 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- --
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.
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;
-- --
-- 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- --
-- 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 --
------------------------------
-- --
-- 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- --
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);
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
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))
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;
projects / gcc.git / commitdiff