errout.ads, errout.adb (Fix Error_Msg_F): Fix implementation to meet spec.
2005-09-01 Robert Dewar <dewar@adacore.com> * errout.ads, errout.adb (Fix Error_Msg_F): Fix implementation to meet spec. Implement new insertion char < (conditional warning) * errutil.adb, erroutc.adb: Implement new insertion char < (conditional warning). * sem_elab.adb, prj-dect.adb, erroutc.ads, err_vars.ads (Error_Msg_Warn): New variable for < insertion char. * prj-nmsc.adb: Implement new errout insertion char < (conditional warning). (Check_For_Source): Change value of Source_Id only after the current source has been dealt with. From-SVN: r103859
This commit is contained in:
Robert Dewar
Arnaud Charlet
parent
405e57adc0
commit
3711d64615
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005 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- --
|
||||
|
|
@ -103,6 +103,10 @@ package Err_Vars is
|
|||
-- note get reset by any Error_Msg call, so the caller is responsible
|
||||
-- for resetting it.
|
||||
|
||||
Error_Msg_Warn : Boolean;
|
||||
-- Used if current message contains a < insertion character to indicate
|
||||
-- if the current message is a warning message.
|
||||
|
||||
Warn_On_Instance : Boolean := False;
|
||||
-- Normally if a warning is generated in a generic template from the
|
||||
-- analysis of the template, then the warning really belongs in the
|
||||
|
|
|
|||
|
|
@ -49,7 +49,6 @@ with Sinfo; use Sinfo;
|
|||
with Snames; use Snames;
|
||||
with Stand; use Stand;
|
||||
with Style;
|
||||
with Uintp; use Uintp;
|
||||
with Uname; use Uname;
|
||||
|
||||
with Unchecked_Conversion;
|
||||
|
|
@ -322,14 +321,13 @@ package body Errout is
|
|||
return;
|
||||
end if;
|
||||
|
||||
-- The idea at this stage is that we have two kinds of messages.
|
||||
-- The idea at this stage is that we have two kinds of messages
|
||||
|
||||
-- First, we have those that are to be placed as requested at
|
||||
-- Flag_Location. This includes messages that have nothing to
|
||||
-- do with generics, and also messages placed on generic templates
|
||||
-- that reflect an error in the template itself. For such messages
|
||||
-- we simply call Error_Msg_Internal to place the message in the
|
||||
-- requested location.
|
||||
-- First, we have those messages that are to be placed as requested at
|
||||
-- Flag_Location. This includes messages that have nothing to do with
|
||||
-- generics, and also messages placed on generic templates that reflect
|
||||
-- an error in the template itself. For such messages we simply call
|
||||
-- Error_Msg_Internal to place the message in the requested location.
|
||||
|
||||
if Instantiation (Sindex) = No_Location then
|
||||
Error_Msg_Internal (Msg, Flag_Location, Flag_Location, False);
|
||||
|
|
@ -606,7 +604,7 @@ package body Errout is
|
|||
|
||||
procedure Error_Msg_F (Msg : String; N : Node_Id) is
|
||||
begin
|
||||
Error_Msg_NEL (Msg, N, N, First_Sloc (N));
|
||||
Error_Msg_NEL (Msg, N, N, Sloc (First_Node (N)));
|
||||
end Error_Msg_F;
|
||||
|
||||
------------------
|
||||
|
|
@ -1613,7 +1611,7 @@ package body Errout is
|
|||
procedure Remove_Warning_Messages (N : Node_Id) is
|
||||
|
||||
function Check_For_Warning (N : Node_Id) return Traverse_Result;
|
||||
-- This function checks one node for a possible warning message.
|
||||
-- This function checks one node for a possible warning message
|
||||
|
||||
function Check_All_Warnings is new
|
||||
Traverse_Func (Check_For_Warning);
|
||||
|
|
@ -2253,6 +2251,9 @@ package body Errout is
|
|||
when '?' =>
|
||||
null; -- already dealt with
|
||||
|
||||
when '<' =>
|
||||
null; -- already dealt with
|
||||
|
||||
when '|' =>
|
||||
null; -- already dealt with
|
||||
|
||||
|
|
|
|||
|
|
@ -243,6 +243,12 @@ package Errout is
|
|||
-- phase anyway. Messages starting with (style) are also treated as
|
||||
-- warning messages.
|
||||
|
||||
-- Insertion character < (Less Than: conditional warning message)
|
||||
-- The character < appearing anywhere in a message is used for a
|
||||
-- conditional error message. If Error_Msg_Warn is True, then the
|
||||
-- effect is the same as ? described above. If Error_Msg_Warn is
|
||||
-- False, then there is no effect.
|
||||
|
||||
-- Insertion character A-Z (Upper case letter: Ada reserved word)
|
||||
-- If two or more upper case letters appear in the message, they are
|
||||
-- taken as an Ada reserved word, and are converted to the default
|
||||
|
|
@ -358,6 +364,10 @@ package Errout is
|
|||
-- note get reset by any Error_Msg call, so the caller is responsible
|
||||
-- for resetting it.
|
||||
|
||||
Error_Msg_Warn : Boolean renames Err_Vars.Error_Msg_Warn;
|
||||
-- Used if current message contains a < insertion character to indicate
|
||||
-- if the current message is a warning message.
|
||||
|
||||
-----------------------------------------------------
|
||||
-- Format of Messages and Manual Quotation Control --
|
||||
-----------------------------------------------------
|
||||
|
|
@ -440,7 +450,7 @@ package Errout is
|
|||
|
||||
function Get_Location (E : Error_Msg_Id) return Source_Ptr
|
||||
renames Erroutc.Get_Location;
|
||||
-- Returns the flag location of the error message with the given id E.
|
||||
-- Returns the flag location of the error message with the given id E
|
||||
|
||||
------------------------
|
||||
-- List Pragmas Table --
|
||||
|
|
@ -601,7 +611,7 @@ package Errout is
|
|||
-- of its descendent nodes. No effect if no such warnings.
|
||||
|
||||
procedure Remove_Warning_Messages (L : List_Id);
|
||||
-- Remove warnings on all elements of a list.
|
||||
-- Remove warnings on all elements of a list
|
||||
|
||||
procedure Set_Ignore_Errors (To : Boolean);
|
||||
-- Following a call to this procedure with To=True, all error calls are
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005 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- --
|
||||
|
|
@ -40,7 +40,6 @@ with Sinput; use Sinput;
|
|||
with Snames; use Snames;
|
||||
with Targparm; use Targparm;
|
||||
with Table;
|
||||
with Types; use Types;
|
||||
with Uintp; use Uintp;
|
||||
|
||||
package body Erroutc is
|
||||
|
|
@ -983,6 +982,11 @@ package body Erroutc is
|
|||
then
|
||||
Is_Warning_Msg := True;
|
||||
|
||||
elsif Msg (J) = '<'
|
||||
and then (J = Msg'First or else Msg (J - 1) /= ''')
|
||||
then
|
||||
Is_Warning_Msg := Error_Msg_Warn;
|
||||
|
||||
elsif Msg (J) = '|'
|
||||
and then (J = Msg'First or else Msg (J - 1) /= ''')
|
||||
then
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005 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- --
|
||||
|
|
@ -28,7 +28,7 @@
|
|||
-- reporting packages, including Errout and Prj.Err.
|
||||
|
||||
with Table;
|
||||
with Types; use Types;
|
||||
with Types; use Types;
|
||||
|
||||
package Erroutc is
|
||||
|
||||
|
|
@ -122,7 +122,7 @@ package Erroutc is
|
|||
-- Error_Msg routines.
|
||||
|
||||
function Get_Location (E : Error_Msg_Id) return Source_Ptr;
|
||||
-- Returns the flag location of the error message with the given id E.
|
||||
-- Returns the flag location of the error message with the given id E
|
||||
|
||||
-----------------------------------
|
||||
-- Error Message Data Structures --
|
||||
|
|
@ -332,7 +332,7 @@ package Erroutc is
|
|||
-- Handle name insertion (% insertion character)
|
||||
|
||||
procedure Set_Msg_Insertion_Reserved_Name;
|
||||
-- Handle insertion of reserved word name (* insertion character).
|
||||
-- Handle insertion of reserved word name (* insertion character)
|
||||
|
||||
procedure Set_Msg_Insertion_Reserved_Word
|
||||
(Text : String;
|
||||
|
|
|
|||
|
|
@ -44,7 +44,7 @@ package body Errutil is
|
|||
-----------------------
|
||||
|
||||
procedure Error_Msg_AP (Msg : String);
|
||||
-- Output a message just after the previous token.
|
||||
-- Output a message just after the previous token
|
||||
|
||||
procedure Output_Source_Line
|
||||
(L : Physical_Line_Number;
|
||||
|
|
@ -184,12 +184,12 @@ package body Errutil is
|
|||
return;
|
||||
end if;
|
||||
|
||||
-- Return without doing anything if message is killed and this
|
||||
-- is not the first error message. The philosophy is that if we
|
||||
-- get a weird error message and we already have had a message,
|
||||
-- then we hope the weird message is a junk cascaded message
|
||||
-- Return without doing anything if message is killed and this is not
|
||||
-- the first error message. The philosophy is that if we get a weird
|
||||
-- error message and we already have had a message, then we hope the
|
||||
-- weird message is a junk cascaded message
|
||||
|
||||
-- Immediate return if warning message and warnings are suppressed
|
||||
-- Immediate return if warning message and warnings are suppressed.
|
||||
-- Note that style messages are not warnings for this purpose.
|
||||
|
||||
if Is_Warning_Msg and then Warnings_Suppressed (Sptr) then
|
||||
|
|
@ -246,20 +246,19 @@ package body Errutil is
|
|||
and then Errors.Table (Prev_Msg).Sfile =
|
||||
Errors.Table (Cur_Msg).Sfile
|
||||
then
|
||||
-- Don't delete unconditional messages and at this stage,
|
||||
-- don't delete continuation lines (we attempted to delete
|
||||
-- those earlier if the parent message was deleted.
|
||||
-- Don't delete unconditional messages and at this stage, don't
|
||||
-- delete continuation lines (we attempted to delete those earlier
|
||||
-- if the parent message was deleted.
|
||||
|
||||
if not Errors.Table (Cur_Msg).Uncond
|
||||
and then not Continuation
|
||||
then
|
||||
|
||||
-- Don't delete if prev msg is warning and new msg is
|
||||
-- an error. This is because we don't want a real error
|
||||
-- masked by a warning. In all other cases (that is parse
|
||||
-- errors for the same line that are not unconditional)
|
||||
-- we do delete the message. This helps to avoid
|
||||
-- junk extra messages from cascaded parsing errors
|
||||
-- Don't delete if prev msg is warning and new msg is an error.
|
||||
-- This is because we don't want a real error masked by a warning.
|
||||
-- In all other cases (that is parse errors for the same line that
|
||||
-- are not unconditional) we do delete the message. This helps to
|
||||
-- avoid junk extra messages from cascaded parsing errors
|
||||
|
||||
if not (Errors.Table (Prev_Msg).Warn
|
||||
or
|
||||
|
|
@ -269,8 +268,8 @@ package body Errutil is
|
|||
or
|
||||
Errors.Table (Cur_Msg).Style)
|
||||
then
|
||||
-- All tests passed, delete the message by simply
|
||||
-- returning without any further processing.
|
||||
-- All tests passed, delete the message by simply returning
|
||||
-- without any further processing.
|
||||
|
||||
if not Continuation then
|
||||
Last_Killed := True;
|
||||
|
|
@ -438,7 +437,6 @@ package body Errutil is
|
|||
|
||||
Write_Eol;
|
||||
end if;
|
||||
|
||||
end loop;
|
||||
|
||||
-- Then output errors, if any, for subsidiary units
|
||||
|
|
@ -564,7 +562,6 @@ package body Errutil is
|
|||
Total_Errors_Detected := Total_Errors_Detected + Warnings_Detected;
|
||||
Warnings_Detected := 0;
|
||||
end if;
|
||||
|
||||
end Finalize;
|
||||
|
||||
----------------
|
||||
|
|
@ -585,7 +582,6 @@ package body Errutil is
|
|||
-- an initial dummy entry covering all possible source locations.
|
||||
|
||||
Warnings.Init;
|
||||
|
||||
end Initialize;
|
||||
|
||||
------------------------
|
||||
|
|
@ -682,6 +678,7 @@ package body Errutil is
|
|||
Set_Msg_Insertion_Name;
|
||||
|
||||
elsif C = '$' then
|
||||
|
||||
-- '$' is ignored
|
||||
|
||||
null;
|
||||
|
|
@ -690,6 +687,7 @@ package body Errutil is
|
|||
Set_Msg_Insertion_File_Name;
|
||||
|
||||
elsif C = '}' then
|
||||
|
||||
-- '}' is ignored
|
||||
|
||||
null;
|
||||
|
|
@ -698,6 +696,7 @@ package body Errutil is
|
|||
Set_Msg_Insertion_Reserved_Name;
|
||||
|
||||
elsif C = '&' then
|
||||
|
||||
-- '&' is ignored
|
||||
|
||||
null;
|
||||
|
|
@ -724,6 +723,9 @@ package body Errutil is
|
|||
elsif C = '?' then
|
||||
null;
|
||||
|
||||
elsif C = '<' then
|
||||
null;
|
||||
|
||||
elsif C = '|' then
|
||||
null;
|
||||
|
||||
|
|
|
|||
|
|
@ -30,9 +30,7 @@ with Opt; use Opt;
|
|||
with Prj.Err; use Prj.Err;
|
||||
with Prj.Strt; use Prj.Strt;
|
||||
with Prj.Tree; use Prj.Tree;
|
||||
with Scans; use Scans;
|
||||
with Snames;
|
||||
with Types; use Types;
|
||||
with Prj.Attr; use Prj.Attr;
|
||||
with Prj.Attr.PM; use Prj.Attr.PM;
|
||||
with Uintp; use Uintp;
|
||||
|
|
@ -212,13 +210,8 @@ package body Prj.Dect is
|
|||
end if;
|
||||
|
||||
Error_Msg_Name_1 := Token_Name;
|
||||
|
||||
if Warning then
|
||||
Error_Msg ("?undefined attribute {", Token_Ptr);
|
||||
|
||||
else
|
||||
Error_Msg ("undefined attribute {", Token_Ptr);
|
||||
end if;
|
||||
Error_Msg_Warn := Warning;
|
||||
Error_Msg ("<undefined attribute {", Token_Ptr);
|
||||
end if;
|
||||
|
||||
-- Set, if appropriate the index case insensitivity flag
|
||||
|
|
|
|||
|
|
@ -38,7 +38,6 @@ with Prj.Util; use Prj.Util;
|
|||
with Sinput.P;
|
||||
with Snames; use Snames;
|
||||
with Table; use Table;
|
||||
with Types; use Types;
|
||||
|
||||
with Ada.Characters.Handling; use Ada.Characters.Handling;
|
||||
with Ada.Strings; use Ada.Strings;
|
||||
|
|
@ -47,7 +46,6 @@ with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
|
|||
|
||||
with GNAT.Case_Util; use GNAT.Case_Util;
|
||||
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
|
||||
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
||||
with GNAT.HTable;
|
||||
|
||||
package body Prj.Nmsc is
|
||||
|
|
@ -876,7 +874,6 @@ package body Prj.Nmsc is
|
|||
|
||||
while Source_Id /= No_Other_Source loop
|
||||
Source := In_Tree.Other_Sources.Table (Source_Id);
|
||||
Source_Id := Source.Next;
|
||||
|
||||
if Source.File_Name = File_Id then
|
||||
|
||||
|
|
@ -939,6 +936,8 @@ package body Prj.Nmsc is
|
|||
Real_Location);
|
||||
return;
|
||||
end if;
|
||||
|
||||
Source_Id := Source.Next;
|
||||
end loop;
|
||||
|
||||
if Current_Verbosity = High then
|
||||
|
|
@ -2368,7 +2367,7 @@ package body Prj.Nmsc is
|
|||
end if;
|
||||
|
||||
else
|
||||
-- Library_Symbol_File is defined. Check that the file exists.
|
||||
-- Library_Symbol_File is defined. Check that the file exists
|
||||
|
||||
Data.Symbol_Data.Symbol_File := Lib_Symbol_File.Value;
|
||||
|
||||
|
|
@ -2461,34 +2460,29 @@ package body Prj.Nmsc is
|
|||
then
|
||||
Error_Msg_Name_1 := Lib_Ref_Symbol_File.Value;
|
||||
|
||||
-- For controlled symbol policy, it is an error
|
||||
-- if the reference symbol file does not exist.
|
||||
-- For controlled symbol policy, it is an error if the
|
||||
-- reference symbol file does not exist. For other symbol
|
||||
-- policies, this is just a warning
|
||||
|
||||
if Data.Symbol_Data.Symbol_Policy = Controlled then
|
||||
Error_Msg
|
||||
(Project, In_Tree,
|
||||
"library reference symbol file { does not exist",
|
||||
Lib_Ref_Symbol_File.Location);
|
||||
Error_Msg_Warn :=
|
||||
Data.Symbol_Data.Symbol_Policy /= Controlled;
|
||||
|
||||
else
|
||||
-- For other symbol policies, this is just a warning
|
||||
Error_Msg
|
||||
(Project, In_Tree,
|
||||
"<library reference symbol file { does not exist",
|
||||
Lib_Ref_Symbol_File.Location);
|
||||
|
||||
Error_Msg
|
||||
(Project, In_Tree,
|
||||
"?library reference symbol file { does not exist",
|
||||
Lib_Ref_Symbol_File.Location);
|
||||
|
||||
-- In addition, if symbol policy is Compliant, it is
|
||||
-- changed to Autonomous, because there is no reference
|
||||
-- to check against, and we don't want to fail in this
|
||||
-- case.
|
||||
-- In addition in the non-controlled case, if symbol policy
|
||||
-- is Compliant, it is changed to Autonomous, because there
|
||||
-- is no reference to check against, and we don't want to
|
||||
-- fail in this case.
|
||||
|
||||
if Data.Symbol_Data.Symbol_Policy /= Controlled then
|
||||
if Data.Symbol_Data.Symbol_Policy = Compliant then
|
||||
Data.Symbol_Data.Symbol_Policy := Autonomous;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
|
@ -2588,11 +2582,19 @@ package body Prj.Nmsc is
|
|||
if Msg (First) = '\' then
|
||||
First := First + 1;
|
||||
|
||||
-- Warniung character is always the first one in this package
|
||||
-- Warniung character is always the first one in this package
|
||||
-- this is an undoocumented kludge!!!
|
||||
|
||||
elsif Msg (First) = '?' then
|
||||
First := First + 1;
|
||||
Add ("Warning: ");
|
||||
|
||||
elsif Msg (First) = '<' then
|
||||
First := First + 1;
|
||||
|
||||
if Err_Vars.Error_Msg_Warn then
|
||||
Add ("Warning: ");
|
||||
end if;
|
||||
end if;
|
||||
|
||||
for Index in First .. Msg'Last loop
|
||||
|
|
|
|||
|
|
@ -296,17 +296,17 @@ package body Sem_Elab is
|
|||
-- convention Stubbed.
|
||||
|
||||
procedure Supply_Bodies (L : List_Id);
|
||||
-- Calls Supply_Bodies for all elements of the given list L.
|
||||
-- Calls Supply_Bodies for all elements of the given list L
|
||||
|
||||
function Within (E1, E2 : Entity_Id) return Boolean;
|
||||
-- Given two scopes E1 and E2, returns True if E1 is equal to E2, or
|
||||
-- is one of its contained scopes, False otherwise.
|
||||
-- Given two scopes E1 and E2, returns True if E1 is equal to E2, or is one
|
||||
-- of its contained scopes, False otherwise.
|
||||
|
||||
function Within_Elaborate_All (E : Entity_Id) return Boolean;
|
||||
-- Before emitting a warning on a scope E for a missing elaborate_all,
|
||||
-- check whether E may be in the context of a directly visible unit
|
||||
-- U to which the pragma applies. This prevents spurious warnings when
|
||||
-- the called entity is renamed within U.
|
||||
-- check whether E may be in the context of a directly visible unit U to
|
||||
-- which the pragma applies. This prevents spurious warnings when the
|
||||
-- called entity is renamed within U.
|
||||
|
||||
------------------
|
||||
-- Check_A_Call --
|
||||
|
|
@ -963,7 +963,7 @@ package body Sem_Elab is
|
|||
then
|
||||
return;
|
||||
|
||||
-- Nothing to do if this is a call already rewritten for elab checking.
|
||||
-- Nothing to do if this is a call already rewritten for elab checking
|
||||
|
||||
elsif Nkind (Parent (N)) = N_Conditional_Expression then
|
||||
return;
|
||||
|
|
@ -1051,35 +1051,29 @@ package body Sem_Elab is
|
|||
and then In_Preelaborated_Unit
|
||||
and then not In_Inlined_Body
|
||||
then
|
||||
-- This is a warning in -gnatg mode allowing such calls to
|
||||
-- be used in the predefined library with appropriate care.
|
||||
|
||||
if GNAT_Mode then
|
||||
Error_Msg_N
|
||||
("?non-static call not allowed in preelaborated unit", N);
|
||||
else
|
||||
Error_Msg_N
|
||||
("non-static call not allowed in preelaborated unit", N);
|
||||
end if;
|
||||
-- This is a warning in GNAT mode allowing such calls to be
|
||||
-- used in the predefined library with appropriate care.
|
||||
|
||||
Error_Msg_Warn := GNAT_Mode;
|
||||
Error_Msg_N
|
||||
("<non-static call not allowed in preelaborated unit", N);
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Second case, we are inside a subprogram or concurrent unit
|
||||
-- i.e, we are not in elaboration code.
|
||||
-- Second case, we are inside a subprogram or concurrent unit, which
|
||||
-- means we are not in elaboration code.
|
||||
|
||||
else
|
||||
-- In this case, the issue is whether we are inside the
|
||||
-- declarative part of the unit in which we live, or inside
|
||||
-- its statements. In the latter case, there is no issue of
|
||||
-- ABE calls at this level (a call from outside to the unit
|
||||
-- in which we live might cause an ABE, but that will be
|
||||
-- detected when we analyze that outer level call, as it
|
||||
-- recurses into the called unit).
|
||||
-- declarative part of the unit in which we live, or inside its
|
||||
-- statements. In the latter case, there is no issue of ABE calls
|
||||
-- at this level (a call from outside to the unit in which we live
|
||||
-- might cause an ABE, but that will be detected when we analyze
|
||||
-- that outer level call, as it recurses into the called unit).
|
||||
|
||||
-- Climb up the tree, doing this test, and also testing
|
||||
-- for being inside a default expression, which, as
|
||||
-- discussed above, is not checked at this stage.
|
||||
-- Climb up the tree, doing this test, and also testing for being
|
||||
-- inside a default expression, which, as discussed above, is not
|
||||
-- checked at this stage.
|
||||
|
||||
declare
|
||||
P : Node_Id;
|
||||
|
|
@ -1088,9 +1082,9 @@ package body Sem_Elab is
|
|||
begin
|
||||
P := N;
|
||||
loop
|
||||
-- If we find a parentless subtree, it seems safe to
|
||||
-- assume that we are not in a declarative part and
|
||||
-- that no checking is required.
|
||||
-- If we find a parentless subtree, it seems safe to assume
|
||||
-- that we are not in a declarative part and that no
|
||||
-- checking is required.
|
||||
|
||||
if No (P) then
|
||||
return;
|
||||
|
|
@ -1106,8 +1100,8 @@ package body Sem_Elab is
|
|||
|
||||
exit when Nkind (P) = N_Subunit;
|
||||
|
||||
-- Filter out case of default expressions, where
|
||||
-- we do not do the check at this stage.
|
||||
-- Filter out case of default expressions, where we do not
|
||||
-- do the check at this stage.
|
||||
|
||||
if Nkind (P) = N_Parameter_Specification
|
||||
or else
|
||||
|
|
@ -1136,11 +1130,11 @@ package body Sem_Elab is
|
|||
elsif Dynamic_Elaboration_Checks then
|
||||
|
||||
-- This is a rather new check, going into version
|
||||
-- 3.14a1 for the first time (V1.80 of this unit),
|
||||
-- so we provide a debug flag to enable it. That
|
||||
-- way we have an easy work around for regressions
|
||||
-- that are caused by this new check. This debug
|
||||
-- flag can be removed later.
|
||||
-- 3.14a1 for the first time (V1.80 of this unit), so
|
||||
-- we provide a debug flag to enable it. That way we
|
||||
-- have an easy work around for regressions that are
|
||||
-- caused by this new check. This debug flag can be
|
||||
-- removed later.
|
||||
|
||||
if Debug_Flag_DD then
|
||||
return;
|
||||
|
|
@ -1381,7 +1375,7 @@ package body Sem_Elab is
|
|||
return;
|
||||
end if;
|
||||
|
||||
-- Nothing to do if the instantiation is not in the main unit.
|
||||
-- Nothing to do if the instantiation is not in the main unit
|
||||
|
||||
if not In_Extended_Main_Code_Unit (N) then
|
||||
return;
|
||||
|
|
@ -1882,7 +1876,7 @@ package body Sem_Elab is
|
|||
else
|
||||
Elmt := First_Elmt (Inter_Procs);
|
||||
|
||||
-- No need for multiple entries of the same type.
|
||||
-- No need for multiple entries of the same type
|
||||
|
||||
while Present (Elmt) loop
|
||||
if Node (Elmt) = Proc then
|
||||
|
|
@ -1946,7 +1940,7 @@ package body Sem_Elab is
|
|||
begin
|
||||
Enclosing := Outer_Unit (Current_Scope);
|
||||
|
||||
-- Find all tasks declared in the current unit.
|
||||
-- Find all tasks declared in the current unit
|
||||
|
||||
if Nkind (N) = N_Package_Body then
|
||||
P := Unit_Declaration_Node (Corresponding_Spec (N));
|
||||
|
|
|
|||
Loading…
Reference in New Issue