Commit 51bf9bdf by Arnaud Charlet

[multiple changes]

2010-06-14  Robert Dewar  <dewar@adacore.com>

	* opt.ads (Check_Policy_List): Add some clarifying comments
	* sem_prag.adb (Analyze_Pragma, case Check): Set Pragma_Enabled flag
	on rewritten Assert pragma.

2010-06-14  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch6.adb (Check_Overriding_Indicator): Add a special check for
	controlled operations, so that they will be treated as overriding even
	if the overridden subprogram is marked Is_Hidden, as long as the
	overridden subprogram's parent subprogram is not hidden.

2010-06-14  Robert Dewar  <dewar@adacore.com>

	* debug.adb: Entry for gnatw.d no longer specific for while loops
	* einfo.adb (First_Exit_Statement): New attribute for E_Loop
	* einfo.ads (First_Exit_Statement): New attribute for E_Loop
	* sem_ch5.adb (Analyze_Loop_Statement): Check_Infinite_Loop_Warning has
	new calling sequence to include test for EXIT WHEN.
	(Analyze_Exit_Statement): Chain EXIT statement into exit statement chain
	* sem_warn.ads, sem_warn.adb (Check_Infinite_Loop_Warning): Now handles
	EXIT WHEN case.
	* sinfo.adb (Next_Exit_Statement): New attribute of N_Exit_Statement
	node.
	* sinfo.ads (N_Pragma): Correct comment on Sloc field (points to
	PRAGMA, not to pragma identifier).
	(Next_Exit_Statement): New attribute of N_Exit_Statement node

2010-06-14  Robert Dewar  <dewar@adacore.com>

	* sem_res.adb (Resolve_Short_Circuit): Fix sloc of "assertion/check
	would fail" msg.

2010-06-14  Robert Dewar  <dewar@adacore.com>

	* par-ch2.adb (Scan_Pragma_Argument_Association): Clarify message for
	missing pragma argument identifier.

2010-06-14  Robert Dewar  <dewar@adacore.com>

	* atree.ads, atree.adb (Ekind_In): New functions

2010-06-14  Robert Dewar  <dewar@adacore.com>

	* exp_ch4.adb (Expand_N_Op_Expon): Optimize 2**N in stand alone context

2010-06-14  Robert Dewar  <dewar@adacore.com>

	* usage.adb (Usage): Redo documentation of -gnatwa.

From-SVN: r160743
parent ae247488
2010-06-14 Robert Dewar <dewar@adacore.com>
* opt.ads (Check_Policy_List): Add some clarifying comments
* sem_prag.adb (Analyze_Pragma, case Check): Set Pragma_Enabled flag
on rewritten Assert pragma.
2010-06-14 Gary Dismukes <dismukes@adacore.com>
* sem_ch6.adb (Check_Overriding_Indicator): Add a special check for
controlled operations, so that they will be treated as overriding even
if the overridden subprogram is marked Is_Hidden, as long as the
overridden subprogram's parent subprogram is not hidden.
2010-06-14 Robert Dewar <dewar@adacore.com>
* debug.adb: Entry for gnatw.d no longer specific for while loops
* einfo.adb (First_Exit_Statement): New attribute for E_Loop
* einfo.ads (First_Exit_Statement): New attribute for E_Loop
* sem_ch5.adb (Analyze_Loop_Statement): Check_Infinite_Loop_Warning has
new calling sequence to include test for EXIT WHEN.
(Analyze_Exit_Statement): Chain EXIT statement into exit statement chain
* sem_warn.ads, sem_warn.adb (Check_Infinite_Loop_Warning): Now handles
EXIT WHEN case.
* sinfo.adb (Next_Exit_Statement): New attribute of N_Exit_Statement
node.
* sinfo.ads (N_Pragma): Correct comment on Sloc field (points to
PRAGMA, not to pragma identifier).
(Next_Exit_Statement): New attribute of N_Exit_Statement node
2010-06-14 Robert Dewar <dewar@adacore.com>
* sem_res.adb (Resolve_Short_Circuit): Fix sloc of "assertion/check
would fail" msg.
2010-06-14 Robert Dewar <dewar@adacore.com>
* par-ch2.adb (Scan_Pragma_Argument_Association): Clarify message for
missing pragma argument identifier.
2010-06-14 Robert Dewar <dewar@adacore.com>
* atree.ads, atree.adb (Ekind_In): New functions
2010-06-14 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb (Expand_N_Op_Expon): Optimize 2**N in stand alone context
2010-06-14 Robert Dewar <dewar@adacore.com>
* usage.adb (Usage): Redo documentation of -gnatwa.
2010-06-14 Ed Schonberg <schonberg@adacore.com> 2010-06-14 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Find_Type): The attribute 'class cannot be applied to * sem_ch8.adb (Find_Type): The attribute 'class cannot be applied to
......
...@@ -766,6 +766,104 @@ package body Atree is ...@@ -766,6 +766,104 @@ package body Atree is
return N_To_E (Nodes.Table (E + 1).Nkind); return N_To_E (Nodes.Table (E + 1).Nkind);
end Ekind; end Ekind;
--------------
-- Ekind_In --
--------------
function Ekind_In
(T : Entity_Kind;
V1 : Entity_Kind;
V2 : Entity_Kind) return Boolean
is
begin
return T = V1 or else
T = V2;
end Ekind_In;
function Ekind_In
(T : Entity_Kind;
V1 : Entity_Kind;
V2 : Entity_Kind;
V3 : Entity_Kind) return Boolean
is
begin
return T = V1 or else
T = V2 or else
T = V3;
end Ekind_In;
function Ekind_In
(T : Entity_Kind;
V1 : Entity_Kind;
V2 : Entity_Kind;
V3 : Entity_Kind;
V4 : Entity_Kind) return Boolean
is
begin
return T = V1 or else
T = V2 or else
T = V3 or else
T = V4;
end Ekind_In;
function Ekind_In
(T : Entity_Kind;
V1 : Entity_Kind;
V2 : Entity_Kind;
V3 : Entity_Kind;
V4 : Entity_Kind;
V5 : Entity_Kind) return Boolean
is
begin
return T = V1 or else
T = V2 or else
T = V3 or else
T = V4 or else
T = V5;
end Ekind_In;
function Ekind_In
(E : Entity_Id;
V1 : Entity_Kind;
V2 : Entity_Kind) return Boolean
is
begin
return Ekind_In (Ekind (E), V1, V2);
end Ekind_In;
function Ekind_In
(E : Entity_Id;
V1 : Entity_Kind;
V2 : Entity_Kind;
V3 : Entity_Kind) return Boolean
is
begin
return Ekind_In (Ekind (E), V1, V2, V3);
end Ekind_In;
function Ekind_In
(E : Entity_Id;
V1 : Entity_Kind;
V2 : Entity_Kind;
V3 : Entity_Kind;
V4 : Entity_Kind) return Boolean
is
begin
return Ekind_In (Ekind (E), V1, V2, V3, V4);
end Ekind_In;
function Ekind_In
(E : Entity_Id;
V1 : Entity_Kind;
V2 : Entity_Kind;
V3 : Entity_Kind;
V4 : Entity_Kind;
V5 : Entity_Kind) return Boolean
is
begin
return Ekind_In (Ekind (E), V1, V2, V3, V4, V5);
end Ekind_In;
------------------ ------------------
-- Error_Posted -- -- Error_Posted --
------------------ ------------------
......
...@@ -543,8 +543,12 @@ package Atree is ...@@ -543,8 +543,12 @@ package Atree is
-- Tests given Id for inequality with the Empty node. This allows notations -- Tests given Id for inequality with the Empty node. This allows notations
-- like "if Present (Statement)" as opposed to "if Statement /= Empty". -- like "if Present (Statement)" as opposed to "if Statement /= Empty".
-- Node_Kind tests, like the functions in Sinfo, but the first argument is ---------------------
-- a Node_Id, and the tested field is Nkind (N). -- Node_Kind Tests --
---------------------
-- These are like the functions in Sinfo, but the first argument is a
-- Node_Id, and the tested field is Nkind (N).
function Nkind_In function Nkind_In
(N : Node_Id; (N : Node_Id;
...@@ -617,6 +621,70 @@ package Atree is ...@@ -617,6 +621,70 @@ package Atree is
pragma Inline (Nkind_In); pragma Inline (Nkind_In);
-- Inline all above functions -- Inline all above functions
-----------------------
-- Entity_Kind_Tests --
-----------------------
-- Utility functions to test whether an Entity_Kind value, either given
-- directly as the first argument, or the Ekind field of an Entity give
-- as the first argument, matches any of the given list of Entity_Kind
-- values. Return True if any match, False if no match.
function Ekind_In
(E : Entity_Id;
V1 : Entity_Kind;
V2 : Entity_Kind) return Boolean;
function Ekind_In
(E : Entity_Id;
V1 : Entity_Kind;
V2 : Entity_Kind;
V3 : Entity_Kind) return Boolean;
function Ekind_In
(E : Entity_Id;
V1 : Entity_Kind;
V2 : Entity_Kind;
V3 : Entity_Kind;
V4 : Entity_Kind) return Boolean;
function Ekind_In
(E : Entity_Id;
V1 : Entity_Kind;
V2 : Entity_Kind;
V3 : Entity_Kind;
V4 : Entity_Kind;
V5 : Entity_Kind) return Boolean;
function Ekind_In
(T : Entity_Kind;
V1 : Entity_Kind;
V2 : Entity_Kind) return Boolean;
function Ekind_In
(T : Entity_Kind;
V1 : Entity_Kind;
V2 : Entity_Kind;
V3 : Entity_Kind) return Boolean;
function Ekind_In
(T : Entity_Kind;
V1 : Entity_Kind;
V2 : Entity_Kind;
V3 : Entity_Kind;
V4 : Entity_Kind) return Boolean;
function Ekind_In
(T : Entity_Kind;
V1 : Entity_Kind;
V2 : Entity_Kind;
V3 : Entity_Kind;
V4 : Entity_Kind;
V5 : Entity_Kind) return Boolean;
pragma Inline (Ekind_In);
-- Inline all above functions
----------------------------- -----------------------------
-- Entity Access Functions -- -- Entity Access Functions --
----------------------------- -----------------------------
......
...@@ -113,7 +113,7 @@ package body Debug is ...@@ -113,7 +113,7 @@ package body Debug is
-- d.t Disable static allocation of library level dispatch tables -- d.t Disable static allocation of library level dispatch tables
-- d.u -- d.u
-- d.v Enable OK_To_Reorder_Components in variant records -- d.v Enable OK_To_Reorder_Components in variant records
-- d.w Do not check for infinite while loops -- d.w Do not check for infinite loops
-- d.x No exception handlers -- d.x No exception handlers
-- d.y -- d.y
-- d.z -- d.z
...@@ -548,7 +548,7 @@ package body Debug is ...@@ -548,7 +548,7 @@ package body Debug is
-- d.v Forces the flag OK_To_Reorder_Components to be set in all record -- d.v Forces the flag OK_To_Reorder_Components to be set in all record
-- base types that have at least one discriminant (v = variant). -- base types that have at least one discriminant (v = variant).
-- d.w This flag turns off the scanning of while loops to detect possible -- d.w This flag turns off the scanning of loops to detect possible
-- infinite loops. -- infinite loops.
-- d.x No exception handlers in generated code. This causes exception -- d.x No exception handlers in generated code. This causes exception
......
...@@ -79,6 +79,7 @@ package body Einfo is ...@@ -79,6 +79,7 @@ package body Einfo is
-- Normalized_First_Bit Uint8 -- Normalized_First_Bit Uint8
-- Postcondition_Proc Node8 -- Postcondition_Proc Node8
-- Return_Applies_To Node8 -- Return_Applies_To Node8
-- First_Exit_Statement Node8
-- Class_Wide_Type Node9 -- Class_Wide_Type Node9
-- Current_Value Node9 -- Current_Value Node9
...@@ -1053,6 +1054,12 @@ package body Einfo is ...@@ -1053,6 +1054,12 @@ package body Einfo is
return Node17 (Id); return Node17 (Id);
end First_Entity; end First_Entity;
function First_Exit_Statement (Id : E) return N is
begin
pragma Assert (Ekind (Id) = E_Loop);
return Node8 (Id);
end First_Exit_Statement;
function First_Index (Id : E) return N is function First_Index (Id : E) return N is
begin begin
pragma Assert (Is_Array_Type (Id) or else Is_String_Type (Id)); pragma Assert (Is_Array_Type (Id) or else Is_String_Type (Id));
...@@ -3492,6 +3499,12 @@ package body Einfo is ...@@ -3492,6 +3499,12 @@ package body Einfo is
Set_Node17 (Id, V); Set_Node17 (Id, V);
end Set_First_Entity; end Set_First_Entity;
procedure Set_First_Exit_Statement (Id : E; V : N) is
begin
pragma Assert (Ekind (Id) = E_Loop);
Set_Node8 (Id, V);
end Set_First_Exit_Statement;
procedure Set_First_Index (Id : E; V : N) is procedure Set_First_Index (Id : E; V : N) is
begin begin
pragma Assert (Is_Array_Type (Id) or else Is_String_Type (Id)); pragma Assert (Is_Array_Type (Id) or else Is_String_Type (Id));
...@@ -7236,6 +7249,9 @@ package body Einfo is ...@@ -7236,6 +7249,9 @@ package body Einfo is
when Type_Kind => when Type_Kind =>
Write_Str ("Associated_Node_For_Itype"); Write_Str ("Associated_Node_For_Itype");
when E_Loop =>
Write_Str ("First_Exit_Statement");
when E_Package => when E_Package =>
Write_Str ("Dependent_Instances"); Write_Str ("Dependent_Instances");
......
...@@ -1116,6 +1116,13 @@ package Einfo is ...@@ -1116,6 +1116,13 @@ package Einfo is
-- Points to a list of associated entities using the Next_Entity field -- Points to a list of associated entities using the Next_Entity field
-- as a chain pointer with Empty marking the end of the list. -- as a chain pointer with Empty marking the end of the list.
-- First_Exit_Statement (Node8)
-- Present in E_Loop entity. The exit statements for a loop are chained
-- (in reverse order of appearence) using this field to point to the
-- first entry in the chain (last exit statement in the loop). The
-- entries are chained through the Next_Exit_Statement field of the
-- N_Exit_Statement node with Empty marking the end of the list.
-- First_Formal (synthesized) -- First_Formal (synthesized)
-- Applies to subprograms and subprogram types, and also in entries -- Applies to subprograms and subprogram types, and also in entries
-- and entry families. Returns first formal of the subprogram or entry. -- and entry families. Returns first formal of the subprogram or entry.
...@@ -5063,6 +5070,7 @@ package Einfo is ...@@ -5063,6 +5070,7 @@ package Einfo is
-- (plus type attributes) -- (plus type attributes)
-- E_Loop -- E_Loop
-- First_Exit_Statement (Node8)
-- Has_Exit (Flag47) -- Has_Exit (Flag47)
-- Has_Master_Entity (Flag21) -- Has_Master_Entity (Flag21)
-- Has_Nested_Block_With_Handler (Flag101) -- Has_Nested_Block_With_Handler (Flag101)
...@@ -5743,6 +5751,7 @@ package Einfo is ...@@ -5743,6 +5751,7 @@ package Einfo is
function Finalization_Chain_Entity (Id : E) return E; function Finalization_Chain_Entity (Id : E) return E;
function Finalize_Storage_Only (Id : E) return B; function Finalize_Storage_Only (Id : E) return B;
function First_Entity (Id : E) return E; function First_Entity (Id : E) return E;
function First_Exit_Statement (Id : E) return N;
function First_Index (Id : E) return N; function First_Index (Id : E) return N;
function First_Literal (Id : E) return E; function First_Literal (Id : E) return E;
function First_Optional_Parameter (Id : E) return E; function First_Optional_Parameter (Id : E) return E;
...@@ -6291,6 +6300,7 @@ package Einfo is ...@@ -6291,6 +6300,7 @@ package Einfo is
procedure Set_Finalization_Chain_Entity (Id : E; V : E); procedure Set_Finalization_Chain_Entity (Id : E; V : E);
procedure Set_Finalize_Storage_Only (Id : E; V : B := True); procedure Set_Finalize_Storage_Only (Id : E; V : B := True);
procedure Set_First_Entity (Id : E; V : E); procedure Set_First_Entity (Id : E; V : E);
procedure Set_First_Exit_Statement (Id : E; V : N);
procedure Set_First_Index (Id : E; V : N); procedure Set_First_Index (Id : E; V : N);
procedure Set_First_Literal (Id : E; V : E); procedure Set_First_Literal (Id : E; V : E);
procedure Set_First_Optional_Parameter (Id : E; V : E); procedure Set_First_Optional_Parameter (Id : E; V : E);
...@@ -6945,6 +6955,7 @@ package Einfo is ...@@ -6945,6 +6955,7 @@ package Einfo is
pragma Inline (Can_Use_Internal_Rep); pragma Inline (Can_Use_Internal_Rep);
pragma Inline (Finalization_Chain_Entity); pragma Inline (Finalization_Chain_Entity);
pragma Inline (First_Entity); pragma Inline (First_Entity);
pragma Inline (First_Exit_Statement);
pragma Inline (First_Index); pragma Inline (First_Index);
pragma Inline (First_Literal); pragma Inline (First_Literal);
pragma Inline (First_Optional_Parameter); pragma Inline (First_Optional_Parameter);
...@@ -7376,6 +7387,7 @@ package Einfo is ...@@ -7376,6 +7387,7 @@ package Einfo is
pragma Inline (Set_Can_Use_Internal_Rep); pragma Inline (Set_Can_Use_Internal_Rep);
pragma Inline (Set_Finalization_Chain_Entity); pragma Inline (Set_Finalization_Chain_Entity);
pragma Inline (Set_First_Entity); pragma Inline (Set_First_Entity);
pragma Inline (Set_First_Exit_Statement);
pragma Inline (Set_First_Index); pragma Inline (Set_First_Index);
pragma Inline (Set_First_Literal); pragma Inline (Set_First_Literal);
pragma Inline (Set_First_Optional_Parameter); pragma Inline (Set_First_Optional_Parameter);
......
...@@ -47,6 +47,7 @@ with Namet; use Namet; ...@@ -47,6 +47,7 @@ with Namet; use Namet;
with Nlists; use Nlists; with Nlists; use Nlists;
with Nmake; use Nmake; with Nmake; use Nmake;
with Opt; use Opt; with Opt; use Opt;
with Par_SCO; use Par_SCO;
with Restrict; use Restrict; with Restrict; use Restrict;
with Rident; use Rident; with Rident; use Rident;
with Rtsfind; use Rtsfind; with Rtsfind; use Rtsfind;
...@@ -5066,7 +5067,7 @@ package body Exp_Ch4 is ...@@ -5066,7 +5067,7 @@ package body Exp_Ch4 is
and then Is_Power_Of_2_For_Shift (Ropnd) and then Is_Power_Of_2_For_Shift (Ropnd)
-- We cannot do this transformation in configurable run time mode if we -- We cannot do this transformation in configurable run time mode if we
-- have 64-bit -- integers and long shifts are not available. -- have 64-bit integers and long shifts are not available.
and then and then
(Esize (Ltyp) <= 32 (Esize (Ltyp) <= 32
...@@ -5912,6 +5913,9 @@ package body Exp_Ch4 is ...@@ -5912,6 +5913,9 @@ package body Exp_Ch4 is
-- the flag Is_Natural_Power_Of_2_for_Shift set, then the expansion -- the flag Is_Natural_Power_Of_2_for_Shift set, then the expansion
-- of the higher level node converts it into a shift. -- of the higher level node converts it into a shift.
-- Another case is 2 ** N in any other context. We simply convert
-- this to 1 * 2 ** N, and then the above transformation applies.
-- Note: this transformation is not applicable for a modular type with -- Note: this transformation is not applicable for a modular type with
-- a non-binary modulus in the multiplication case, since we get a wrong -- a non-binary modulus in the multiplication case, since we get a wrong
-- result if the shift causes an overflow before the modular reduction. -- result if the shift causes an overflow before the modular reduction.
...@@ -5922,33 +5926,45 @@ package body Exp_Ch4 is ...@@ -5922,33 +5926,45 @@ package body Exp_Ch4 is
and then Esize (Root_Type (Exptyp)) <= Esize (Standard_Integer) and then Esize (Root_Type (Exptyp)) <= Esize (Standard_Integer)
and then Is_Unsigned_Type (Exptyp) and then Is_Unsigned_Type (Exptyp)
and then not Ovflo and then not Ovflo
and then Nkind (Parent (N)) in N_Binary_Op
then then
declare -- First the multiply and divide cases
P : constant Node_Id := Parent (N);
L : constant Node_Id := Left_Opnd (P);
R : constant Node_Id := Right_Opnd (P);
begin if Nkind_In (Parent (N), N_Op_Divide, N_Op_Multiply) then
if (Nkind (P) = N_Op_Multiply declare
and then not Non_Binary_Modulus (Typ) P : constant Node_Id := Parent (N);
and then L : constant Node_Id := Left_Opnd (P);
((Is_Integer_Type (Etype (L)) and then R = N) R : constant Node_Id := Right_Opnd (P);
or else
(Is_Integer_Type (Etype (R)) and then L = N)) begin
and then not Do_Overflow_Check (P)) if (Nkind (P) = N_Op_Multiply
and then not Non_Binary_Modulus (Typ)
or else and then
(Nkind (P) = N_Op_Divide ((Is_Integer_Type (Etype (L)) and then R = N)
and then Is_Integer_Type (Etype (L)) or else
and then Is_Unsigned_Type (Etype (L)) (Is_Integer_Type (Etype (R)) and then L = N))
and then R = N and then not Do_Overflow_Check (P))
and then not Do_Overflow_Check (P)) or else
then (Nkind (P) = N_Op_Divide
Set_Is_Power_Of_2_For_Shift (N); and then Is_Integer_Type (Etype (L))
return; and then Is_Unsigned_Type (Etype (L))
end if; and then R = N
end; and then not Do_Overflow_Check (P))
then
Set_Is_Power_Of_2_For_Shift (N);
return;
end if;
end;
-- Now the other cases
elsif not Non_Binary_Modulus (Typ) then
Rewrite (N,
Make_Op_Multiply (Loc,
Left_Opnd => Make_Integer_Literal (Loc, 1),
Right_Opnd => Relocate_Node (N)));
Analyze_And_Resolve (N, Typ);
return;
end if;
end if; end if;
-- Fall through if exponentiation must be done using a runtime routine -- Fall through if exponentiation must be done using a runtime routine
...@@ -8745,6 +8761,12 @@ package body Exp_Ch4 is ...@@ -8745,6 +8761,12 @@ package body Exp_Ch4 is
if Compile_Time_Known_Value (Left) then if Compile_Time_Known_Value (Left) then
-- Mark SCO for left condition as compile time known
if Generate_SCO and then Comes_From_Source (Left) then
Set_SCO_Condition (Left, Expr_Value_E (Left) = Standard_True);
end if;
-- Rewrite True AND THEN Right / False OR ELSE Right to Right. -- Rewrite True AND THEN Right / False OR ELSE Right to Right.
-- Any actions associated with Right will be executed unconditionally -- Any actions associated with Right will be executed unconditionally
-- and can thus be inserted into the tree unconditionally. -- and can thus be inserted into the tree unconditionally.
...@@ -8830,6 +8852,12 @@ package body Exp_Ch4 is ...@@ -8830,6 +8852,12 @@ package body Exp_Ch4 is
if Compile_Time_Known_Value (Right) then if Compile_Time_Known_Value (Right) then
-- Mark SCO for left condition as compile time known
if Generate_SCO and then Comes_From_Source (Right) then
Set_SCO_Condition (Right, Expr_Value_E (Right) = Standard_True);
end if;
-- Change (Left and then True), (Left or else False) to Left. -- Change (Left and then True), (Left or else False) to Left.
-- Note that we know there are no actions associated with the right -- Note that we know there are no actions associated with the right
-- operand, since we just checked for this case above. -- operand, since we just checked for this case above.
......
...@@ -224,7 +224,10 @@ package Opt is ...@@ -224,7 +224,10 @@ package Opt is
-- GNAT -- GNAT
-- This points to the list of N_Pragma nodes for Check_Policy pragmas -- This points to the list of N_Pragma nodes for Check_Policy pragmas
-- that are linked through the Next_Pragma fields, with the list being -- that are linked through the Next_Pragma fields, with the list being
-- terminated by Empty. The order is most recently processed first. -- terminated by Empty. The order is most recently processed first. Note
-- that Push_Scope and Pop_Scope in Sem_Ch8 save and restore the value
-- of this variable, implementing the required scope control for pragmas
-- appearing a declarative part.
Check_Readonly_Files : Boolean := False; Check_Readonly_Files : Boolean := False;
-- GNATMAKE -- GNATMAKE
......
...@@ -503,7 +503,9 @@ package body Ch2 is ...@@ -503,7 +503,9 @@ package body Ch2 is
if Identifier_Seen and not Id_Present then if Identifier_Seen and not Id_Present then
Error_Msg_SC Error_Msg_SC
("|pragma argument identifier required here (RM 2.8(4))"); ("|pragma argument identifier required here");
Error_Msg_SC
("\since previous argument had identifier (RM 2.8(4))");
end if; end if;
if Id_Present then if Id_Present then
......
...@@ -1209,6 +1209,11 @@ package body Sem_Ch5 is ...@@ -1209,6 +1209,11 @@ package body Sem_Ch5 is
Check_Unset_Reference (Cond); Check_Unset_Reference (Cond);
end if; end if;
-- Chain exit statement to associated loop entity
Set_Next_Exit_Statement (N, First_Exit_Statement (Scope_Id));
Set_First_Exit_Statement (Scope_Id, N);
-- Since the exit may take us out of a loop, any previous assignment -- Since the exit may take us out of a loop, any previous assignment
-- statement is not useless, so clear last assignment indications. It -- statement is not useless, so clear last assignment indications. It
-- is OK to keep other current values, since if the exit statement -- is OK to keep other current values, since if the exit statement
...@@ -2060,8 +2065,12 @@ package body Sem_Ch5 is ...@@ -2060,8 +2065,12 @@ package body Sem_Ch5 is
End_Scope; End_Scope;
Kill_Current_Values; Kill_Current_Values;
-- Check for infinite loop. We skip this check for generated code, since -- Check for infinite loop. Skip check for generated code, since it
-- it justs waste time and makes debugging the routine called harder. -- justs waste time and makes debugging the routine called harder.
-- Note that we have to wait till the body of the loop is fully analyzed
-- before making this call, since Check_Infinite_Loop_Warning relies on
-- being able to use semantic visibility information to find references.
if Comes_From_Source (N) then if Comes_From_Source (N) then
Check_Infinite_Loop_Warning (N); Check_Infinite_Loop_Warning (N);
......
...@@ -4420,8 +4420,24 @@ package body Sem_Ch6 is ...@@ -4420,8 +4420,24 @@ package body Sem_Ch6 is
end; end;
end if; end if;
-- If there is an overridden subprogram, then check that there is not
-- a "not overriding" indicator, and mark the subprogram as overriding.
-- This is not done if the overridden subprogram is marked as hidden,
-- which can occur for the case of inherited controlled operations
-- (see Derive_Subprogram), unless the inherited subprogram's parent
-- subprogram is not itself hidden. (Note: This condition could probably
-- be simplified, leaving out the testing for the specific controlled
-- cases, but it seems safer and clearer this way, and echoes similar
-- special-case tests of this kind in other places.)
if Present (Overridden_Subp) if Present (Overridden_Subp)
and then not Is_Hidden (Overridden_Subp) and then (not Is_Hidden (Overridden_Subp)
or else
((Chars (Overridden_Subp) = Name_Initialize
or else Chars (Overridden_Subp) = Name_Adjust
or else Chars (Overridden_Subp) = Name_Finalize)
and then Present (Alias (Overridden_Subp))
and then not Is_Hidden (Alias (Overridden_Subp))))
then then
if Must_Not_Override (Spec) then if Must_Not_Override (Spec) then
Error_Msg_Sloc := Sloc (Overridden_Subp); Error_Msg_Sloc := Sloc (Overridden_Subp);
......
...@@ -5771,8 +5771,13 @@ package body Sem_Prag is ...@@ -5771,8 +5771,13 @@ package body Sem_Prag is
end if; end if;
Check_Arg_Is_Identifier (Arg1); Check_Arg_Is_Identifier (Arg1);
-- Indicate if pragma is enabled. The Original_Node reference here
-- is to deal with pragma Assert rewritten as a Check pragma.
Check_On := Check_Enabled (Chars (Get_Pragma_Arg (Arg1))); Check_On := Check_Enabled (Chars (Get_Pragma_Arg (Arg1)));
Set_Pragma_Enabled (N, Check_On); Set_Pragma_Enabled (N, Check_On);
Set_Pragma_Enabled (Original_Node (N), Check_On);
-- If expansion is active and the check is not enabled then we -- If expansion is active and the check is not enabled then we
-- rewrite the Check as: -- rewrite the Check as:
......
...@@ -7846,15 +7846,15 @@ package body Sem_Res is ...@@ -7846,15 +7846,15 @@ package body Sem_Res is
then then
null; null;
else else
-- Issue warning. Note that we don't want to make this -- Issue warning. We do not want the deletion of the
-- an unconditional warning, because if the assert is -- IF/AND-THEN to take this message with it. We achieve
-- within deleted code we do not want the warning. But -- this by making sure that the expanded code points to
-- we do not want the deletion of the IF/AND-THEN to -- the Sloc of the expression, not the original pragma.
-- take this message with it. We achieve this by making
-- sure that the expanded code points to the Sloc of Error_Msg_N
-- the expression, not the original pragma. ("?assertion would fail at run-time!",
Expression
Error_Msg_N ("?assertion would fail at run-time", Orig); (First (Pragma_Argument_Associations (Orig))));
end if; end if;
end; end;
...@@ -7877,7 +7877,10 @@ package body Sem_Res is ...@@ -7877,7 +7877,10 @@ package body Sem_Res is
then then
null; null;
else else
Error_Msg_N ("?check would fail at run-time", Orig); Error_Msg_N
("?check would fail at run-time!",
Expression
(Last (Pragma_Argument_Associations (Orig))));
end if; end if;
end; end;
end if; end if;
......
...@@ -234,10 +234,11 @@ package body Sem_Warn is ...@@ -234,10 +234,11 @@ package body Sem_Warn is
-- within the body of the loop. -- within the body of the loop.
procedure Check_Infinite_Loop_Warning (Loop_Statement : Node_Id) is procedure Check_Infinite_Loop_Warning (Loop_Statement : Node_Id) is
Iter : constant Node_Id := Iteration_Scheme (Loop_Statement); Expression : Node_Id := Empty;
-- Set to WHILE or EXIT WHEN condition to be tested
Ref : Node_Id := Empty; Ref : Node_Id := Empty;
-- Reference in iteration scheme to variable that might not be modified -- Reference in Expression to variable that might not be modified
-- in loop, indicating a possible infinite loop. -- in loop, indicating a possible infinite loop.
Var : Entity_Id := Empty; Var : Entity_Id := Empty;
...@@ -267,9 +268,9 @@ package body Sem_Warn is ...@@ -267,9 +268,9 @@ package body Sem_Warn is
function Test_Ref (N : Node_Id) return Traverse_Result; function Test_Ref (N : Node_Id) return Traverse_Result;
-- Test for reference to variable in question. Returns Abandon if -- Test for reference to variable in question. Returns Abandon if
-- matching reference found. -- matching reference found. Used in instantiation of No_Ref_Found.
function Find_Ref is new Traverse_Func (Test_Ref); function No_Ref_Found is new Traverse_Func (Test_Ref);
-- Function to traverse body of procedure. Returns Abandon if matching -- Function to traverse body of procedure. Returns Abandon if matching
-- reference found. -- reference found.
...@@ -465,9 +466,9 @@ package body Sem_Warn is ...@@ -465,9 +466,9 @@ package body Sem_Warn is
function Test_Ref (N : Node_Id) return Traverse_Result is function Test_Ref (N : Node_Id) return Traverse_Result is
begin begin
-- Waste of time to look at iteration scheme -- Waste of time to look at the expression we are testing
if N = Iter then if N = Expression then
return Skip; return Skip;
-- Direct reference to variable in question -- Direct reference to variable in question
...@@ -547,20 +548,86 @@ package body Sem_Warn is ...@@ -547,20 +548,86 @@ package body Sem_Warn is
-- Start of processing for Check_Infinite_Loop_Warning -- Start of processing for Check_Infinite_Loop_Warning
begin begin
-- We need a while iteration with no condition actions. Condition -- Skip processing if debug flag gnatd.w is set
-- actions just make things too complicated to get the warning right.
if No (Iter) if Debug_Flag_Dot_W then
or else No (Condition (Iter)) return;
or else Present (Condition_Actions (Iter)) end if;
or else Debug_Flag_Dot_W
then -- Case of WHILE loop
declare
Iter : constant Node_Id := Iteration_Scheme (Loop_Statement);
begin
if Present (Iter) and then Present (Condition (Iter)) then
-- Skip processing for while iteration with conditions actions,
-- since they make it too complicated to get the warning right.
if Present (Condition_Actions (Iter)) then
return;
end if;
-- Capture WHILE condition
Expression := Condition (Iter);
end if;
end;
-- Check chain of EXIT statements, we only process loops that have a
-- single exit condition (either a single EXIT WHEN statement, or a
-- WHILE loop not containing any EXIT WHEN statements).
declare
Ident : constant Node_Id := Identifier (Loop_Statement);
Exit_Stmt : Node_Id;
begin
-- If we don't have a proper chain set, ignore call entirely. This
-- happens because of previous errors.
if No (Entity (Ident))
or else Ekind (Entity (Ident)) /= E_Loop
then
return;
end if;
-- Otherwise prepare to scan list of EXIT statements
Exit_Stmt := First_Exit_Statement (Entity (Ident));
while Present (Exit_Stmt) loop
-- Check for EXIT WHEN
if Present (Condition (Exit_Stmt)) then
-- Quit processing if EXIT WHEN in WHILE loop, or more than
-- one EXIT WHEN statement present in the loop.
if Present (Expression) then
return;
-- Otherwise capture condition from EXIT WHEN statement
else
Expression := Condition (Exit_Stmt);
end if;
end if;
Exit_Stmt := Next_Exit_Statement (Exit_Stmt);
end loop;
end;
-- Return if no condition to test
if No (Expression) then
return; return;
end if; end if;
-- Initial conditions met, see if condition is of right form -- Initial conditions met, see if condition is of right form
Find_Var (Condition (Iter)); Find_Var (Expression);
-- Nothing to do if local variable from source not found. If it's a -- Nothing to do if local variable from source not found. If it's a
-- renaming, it is probably renaming something too complicated to deal -- renaming, it is probably renaming something too complicated to deal
...@@ -608,7 +675,7 @@ package body Sem_Warn is ...@@ -608,7 +675,7 @@ package body Sem_Warn is
-- We have a variable reference of the right form, now we scan the loop -- We have a variable reference of the right form, now we scan the loop
-- body to see if it looks like it might not be modified -- body to see if it looks like it might not be modified
if Find_Ref (Loop_Statement) = OK then if No_Ref_Found (Loop_Statement) = OK then
Error_Msg_NE Error_Msg_NE
("?variable& is not modified in loop body!", Ref, Var); ("?variable& is not modified in loop body!", Ref, Var);
Error_Msg_N Error_Msg_N
...@@ -3432,9 +3499,7 @@ package body Sem_Warn is ...@@ -3432,9 +3499,7 @@ package body Sem_Warn is
Sloc_Range (Orig, Start, Dummy); Sloc_Range (Orig, Start, Dummy);
Atrue := Test_Result; Atrue := Test_Result;
if Present (Parent (C)) if Present (Parent (C)) and then Nkind (Parent (C)) = N_Op_Not then
and then Nkind (Parent (C)) = N_Op_Not
then
Atrue := not Atrue; Atrue := not Atrue;
end if; end if;
......
...@@ -170,7 +170,8 @@ package Sem_Warn is ...@@ -170,7 +170,8 @@ package Sem_Warn is
procedure Check_Infinite_Loop_Warning (Loop_Statement : Node_Id); procedure Check_Infinite_Loop_Warning (Loop_Statement : Node_Id);
-- N is the node for a loop statement. This procedure checks if a warning -- N is the node for a loop statement. This procedure checks if a warning
-- should be given for a possible infinite loop, and if so issues it. -- for a possible infinite loop should be given for a suspicious WHILE or
-- EXIT WHEN condition.
procedure Check_Low_Bound_Tested (Expr : Node_Id); procedure Check_Low_Bound_Tested (Expr : Node_Id);
-- Expr is the node for a comparison operation. This procedure checks if -- Expr is the node for a comparison operation. This procedure checks if
......
...@@ -2021,6 +2021,14 @@ package body Sinfo is ...@@ -2021,6 +2021,14 @@ package body Sinfo is
return Node2 (N); return Node2 (N);
end Next_Entity; end Next_Entity;
function Next_Exit_Statement
(N : Node_Id) return Node_Id is
begin
pragma Assert (False
or else NT (N).Nkind = N_Exit_Statement);
return Node3 (N);
end Next_Exit_Statement;
function Next_Implicit_With function Next_Implicit_With
(N : Node_Id) return Node_Id is (N : Node_Id) return Node_Id is
begin begin
...@@ -4907,6 +4915,14 @@ package body Sinfo is ...@@ -4907,6 +4915,14 @@ package body Sinfo is
Set_Node2 (N, Val); -- semantic field, no parent set Set_Node2 (N, Val); -- semantic field, no parent set
end Set_Next_Entity; end Set_Next_Entity;
procedure Set_Next_Exit_Statement
(N : Node_Id; Val : Node_Id) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Exit_Statement);
Set_Node3 (N, Val); -- semantic field, no parent set
end Set_Next_Exit_Statement;
procedure Set_Next_Implicit_With procedure Set_Next_Implicit_With
(N : Node_Id; Val : Node_Id) is (N : Node_Id; Val : Node_Id) is
begin begin
......
...@@ -1395,6 +1395,12 @@ package Sinfo is ...@@ -1395,6 +1395,12 @@ package Sinfo is
-- scope are chained, and this field is used as the forward pointer for -- scope are chained, and this field is used as the forward pointer for
-- this list. See Einfo for further details. -- this list. See Einfo for further details.
-- Next_Exit_Statement (Node3-Sem)
-- Present in N_Exit_Statement nodes. The exit statements for a loop are
-- chained (in reverse order of appearence) from the First_Exit_Statement
-- field of the E_Loop entity for the loop. Next_Exit_Statement points to
-- the next entry on this chain (Empty = end of list).
-- Next_Implicit_With (Node3-Sem) -- Next_Implicit_With (Node3-Sem)
-- Present in N_With_Clause. Part of a chain of with_clauses generated -- Present in N_With_Clause. Part of a chain of with_clauses generated
-- in rtsfind to indicate implicit dependencies on predefined units. Used -- in rtsfind to indicate implicit dependencies on predefined units. Used
...@@ -1980,7 +1986,7 @@ package Sinfo is ...@@ -1980,7 +1986,7 @@ package Sinfo is
-- which are explicitly documented. -- which are explicitly documented.
-- N_Pragma -- N_Pragma
-- Sloc points to pragma identifier -- Sloc points to PRAGMA
-- Next_Pragma (Node1-Sem) -- Next_Pragma (Node1-Sem)
-- Pragma_Argument_Associations (List2) (set to No_List if none) -- Pragma_Argument_Associations (List2) (set to No_List if none)
-- Debug_Statement (Node3) (set to Empty if not Debug, Assert) -- Debug_Statement (Node3) (set to Empty if not Debug, Assert)
...@@ -4040,6 +4046,13 @@ package Sinfo is ...@@ -4040,6 +4046,13 @@ package Sinfo is
-- Is_Null_Loop (Flag16) -- Is_Null_Loop (Flag16)
-- Suppress_Loop_Warnings (Flag17) -- Suppress_Loop_Warnings (Flag17)
-- Note: the parser fills in the Identifier field if there is an
-- explicit loop identifier. Otherwise the parser leaves this field
-- set to Empty, and then the semantic processing for a loop statement
-- creates an identifier, setting the Has_Created_Identifier flag to
-- True. So after semantic anlaysis, the Identifier is always set,
-- referencing an identifier whose entity has an Ekind of E_Loop.
-------------------------- --------------------------
-- 5.5 Iteration Scheme -- -- 5.5 Iteration Scheme --
-------------------------- --------------------------
...@@ -4128,7 +4141,8 @@ package Sinfo is ...@@ -4128,7 +4141,8 @@ package Sinfo is
-- N_Exit_Statement -- N_Exit_Statement
-- Sloc points to EXIT -- Sloc points to EXIT
-- Name (Node2) (set to Empty if no loop name present) -- Name (Node2) (set to Empty if no loop name present)
-- Condition (Node1) (set to Empty if no when part present) -- Condition (Node1) (set to Empty if no WHEN part present)
-- Next_Exit_Statement (Node3-Sem): Next exit on chain
------------------------- -------------------------
-- 5.9 Goto Statement -- -- 5.9 Goto Statement --
...@@ -8247,6 +8261,9 @@ package Sinfo is ...@@ -8247,6 +8261,9 @@ package Sinfo is
function Next_Entity function Next_Entity
(N : Node_Id) return Node_Id; -- Node2 (N : Node_Id) return Node_Id; -- Node2
function Next_Exit_Statement
(N : Node_Id) return Node_Id; -- Node3
function Next_Implicit_With function Next_Implicit_With
(N : Node_Id) return Node_Id; -- Node3 (N : Node_Id) return Node_Id; -- Node3
...@@ -9168,6 +9185,9 @@ package Sinfo is ...@@ -9168,6 +9185,9 @@ package Sinfo is
procedure Set_Next_Entity procedure Set_Next_Entity
(N : Node_Id; Val : Node_Id); -- Node2 (N : Node_Id; Val : Node_Id); -- Node2
procedure Set_Next_Exit_Statement
(N : Node_Id; Val : Node_Id); -- Node3
procedure Set_Next_Implicit_With procedure Set_Next_Implicit_With
(N : Node_Id; Val : Node_Id); -- Node3 (N : Node_Id; Val : Node_Id); -- Node3
...@@ -11360,6 +11380,7 @@ package Sinfo is ...@@ -11360,6 +11380,7 @@ package Sinfo is
pragma Inline (Name); pragma Inline (Name);
pragma Inline (Names); pragma Inline (Names);
pragma Inline (Next_Entity); pragma Inline (Next_Entity);
pragma Inline (Next_Exit_Statement);
pragma Inline (Next_Implicit_With); pragma Inline (Next_Implicit_With);
pragma Inline (Next_Named_Actual); pragma Inline (Next_Named_Actual);
pragma Inline (Next_Pragma); pragma Inline (Next_Pragma);
...@@ -11664,6 +11685,7 @@ package Sinfo is ...@@ -11664,6 +11685,7 @@ package Sinfo is
pragma Inline (Set_Name); pragma Inline (Set_Name);
pragma Inline (Set_Names); pragma Inline (Set_Names);
pragma Inline (Set_Next_Entity); pragma Inline (Set_Next_Entity);
pragma Inline (Set_Next_Exit_Statement);
pragma Inline (Set_Next_Implicit_With); pragma Inline (Set_Next_Implicit_With);
pragma Inline (Set_Next_Named_Actual); pragma Inline (Set_Next_Named_Actual);
pragma Inline (Set_Next_Pragma); pragma Inline (Set_Next_Pragma);
......
...@@ -397,47 +397,46 @@ begin ...@@ -397,47 +397,46 @@ begin
Write_Switch_Char ("wxx"); Write_Switch_Char ("wxx");
Write_Line ("Enable selected warning modes, xx = list of parameters:"); Write_Line ("Enable selected warning modes, xx = list of parameters:");
Write_Line (" a turn on all optional info/warnings " & Write_Line (" a turn on all info/warnings marked below with +");
"(except dhl.ot.w)");
Write_Line (" A turn off all optional info/warnings"); Write_Line (" A turn off all optional info/warnings");
Write_Line (" .a* turn on warnings for failing assertion"); Write_Line (" .a*+ turn on warnings for failing assertion");
Write_Line (" .A turn off warnings for failing assertion"); Write_Line (" .A turn off warnings for failing assertion");
Write_Line (" b turn on warnings for bad fixed value " & Write_Line (" b+ turn on warnings for bad fixed value " &
"(not multiple of small)"); "(not multiple of small)");
Write_Line (" B* turn off warnings for bad fixed value " & Write_Line (" B* turn off warnings for bad fixed value " &
"(not multiple of small)"); "(not multiple of small)");
Write_Line (" .b* turn on warnings for biased representation"); Write_Line (" .b*+ turn on warnings for biased representation");
Write_Line (" .B turn off warnings for biased representation"); Write_Line (" .B turn off warnings for biased representation");
Write_Line (" c turn on warnings for constant conditional"); Write_Line (" c+ turn on warnings for constant conditional");
Write_Line (" C* turn off warnings for constant conditional"); Write_Line (" C* turn off warnings for constant conditional");
Write_Line (" .c turn on warnings for unrepped components"); Write_Line (" .c+ turn on warnings for unrepped components");
Write_Line (" .C* turn off warnings for unrepped components"); Write_Line (" .C* turn off warnings for unrepped components");
Write_Line (" d turn on warnings for implicit dereference"); Write_Line (" d turn on warnings for implicit dereference");
Write_Line (" D* turn off warnings for implicit dereference"); Write_Line (" D* turn off warnings for implicit dereference");
Write_Line (" e treat all warnings (but not info) as errors"); Write_Line (" e treat all warnings (but not info) as errors");
Write_Line (" .e turn on every optional info/warning " & Write_Line (" .e turn on every optional info/warning " &
"(no exceptions)"); "(no exceptions)");
Write_Line (" f turn on warnings for unreferenced formal"); Write_Line (" f+ turn on warnings for unreferenced formal");
Write_Line (" F* turn off warnings for unreferenced formal"); Write_Line (" F* turn off warnings for unreferenced formal");
Write_Line (" g* turn on warnings for unrecognized pragma"); Write_Line (" g*+ turn on warnings for unrecognized pragma");
Write_Line (" G turn off warnings for unrecognized pragma"); Write_Line (" G turn off warnings for unrecognized pragma");
Write_Line (" h turn on warnings for hiding variable"); Write_Line (" h turn on warnings for hiding variable");
Write_Line (" H* turn off warnings for hiding variable"); Write_Line (" H* turn off warnings for hiding variable");
Write_Line (" i* turn on warnings for implementation unit"); Write_Line (" i*+ turn on warnings for implementation unit");
Write_Line (" I turn off warnings for implementation unit"); Write_Line (" I turn off warnings for implementation unit");
Write_Line (" .i turn on warnings for overlapping actuals"); Write_Line (" .i turn on warnings for overlapping actuals");
Write_Line (" .I* turn off warnings for overlapping actuals"); Write_Line (" .I* turn off warnings for overlapping actuals");
Write_Line (" j turn on warnings for obsolescent " & Write_Line (" j+ turn on warnings for obsolescent " &
"(annex J) feature"); "(annex J) feature");
Write_Line (" J* turn off warnings for obsolescent " & Write_Line (" J* turn off warnings for obsolescent " &
"(annex J) feature"); "(annex J) feature");
Write_Line (" k turn on warnings on constant variable"); Write_Line (" k+ turn on warnings on constant variable");
Write_Line (" K* turn off warnings on constant variable"); Write_Line (" K* turn off warnings on constant variable");
Write_Line (" l turn on warnings for missing " & Write_Line (" l turn on warnings for missing " &
"elaboration pragma"); "elaboration pragma");
Write_Line (" L* turn off warnings for missing " & Write_Line (" L* turn off warnings for missing " &
"elaboration pragma"); "elaboration pragma");
Write_Line (" m turn on warnings for variable assigned " & Write_Line (" m+ turn on warnings for variable assigned " &
"but not read"); "but not read");
Write_Line (" M* turn off warnings for variable assigned " & Write_Line (" M* turn off warnings for variable assigned " &
"but not read"); "but not read");
...@@ -450,47 +449,48 @@ begin ...@@ -450,47 +449,48 @@ begin
"but not read"); "but not read");
Write_Line (" .O* turn off warnings for out parameters assigned " & Write_Line (" .O* turn off warnings for out parameters assigned " &
"but not read"); "but not read");
Write_Line (" p turn on warnings for ineffective pragma " & Write_Line (" p+ turn on warnings for ineffective pragma " &
"Inline in frontend"); "Inline in frontend");
Write_Line (" P* turn off warnings for ineffective pragma " & Write_Line (" P* turn off warnings for ineffective pragma " &
"Inline in frontend"); "Inline in frontend");
Write_Line (" .p turn on warnings for suspicious parameter " & Write_Line (" .p+ turn on warnings for suspicious parameter " &
"order"); "order");
Write_Line (" .P* turn off warnings for suspicious parameter " & Write_Line (" .P* turn off warnings for suspicious parameter " &
"order"); "order");
Write_Line (" q* turn on warnings for questionable " & Write_Line (" q*+ turn on warnings for questionable " &
"missing parenthesis"); "missing parenthesis");
Write_Line (" Q turn off warnings for questionable " & Write_Line (" Q turn off warnings for questionable " &
"missing parenthesis"); "missing parenthesis");
Write_Line (" r turn on warnings for redundant construct"); Write_Line (" r+ turn on warnings for redundant construct");
Write_Line (" R* turn off warnings for redundant construct"); Write_Line (" R* turn off warnings for redundant construct");
Write_Line (" .r turn on warnings for object renaming function"); Write_Line (" .r+ turn on warnings for object renaming function");
Write_Line (" .R* turn off warnings for object renaming function"); Write_Line (" .R* turn off warnings for object renaming function");
Write_Line (" s suppress all info/warnings"); Write_Line (" s suppress all info/warnings");
Write_Line (" t turn on warnings for tracking deleted code"); Write_Line (" t turn on warnings for tracking deleted code");
Write_Line (" T* turn off warnings for tracking deleted code"); Write_Line (" T* turn off warnings for tracking deleted code");
Write_Line (" u turn on warnings for unused entity"); Write_Line (" u+ turn on warnings for unused entity");
Write_Line (" U* turn off warnings for unused entity"); Write_Line (" U* turn off warnings for unused entity");
Write_Line (" v* turn on warnings for unassigned variable"); Write_Line (" v*+ turn on warnings for unassigned variable");
Write_Line (" V turn off warnings for unassigned variable"); Write_Line (" V turn off warnings for unassigned variable");
Write_Line (" .v* turn on info messages for reverse bit order"); Write_Line (" .v*+ turn on info messages for reverse bit order");
Write_Line (" .V turn off info messages for reverse bit order"); Write_Line (" .V turn off info messages for reverse bit order");
Write_Line (" w* turn on warnings for wrong low bound assumption"); Write_Line (" w*+ turn on warnings for wrong low bound assumption");
Write_Line (" W turn off warnings for wrong low bound " & Write_Line (" W turn off warnings for wrong low bound " &
"assumption"); "assumption");
Write_Line (" .w turn on warnings on pragma Warnings Off"); Write_Line (" .w turn on warnings on pragma Warnings Off");
Write_Line (" .W* turn off warnings on pragma Warnings Off"); Write_Line (" .W* turn off warnings on pragma Warnings Off");
Write_Line (" x* turn on warnings for export/import"); Write_Line (" x*+ turn on warnings for export/import");
Write_Line (" X turn off warnings for export/import"); Write_Line (" X turn off warnings for export/import");
Write_Line (" .x turn on warnings for non-local exception"); Write_Line (" .x+ turn on warnings for non-local exception");
Write_Line (" .X* turn off warnings for non-local exception"); Write_Line (" .X* turn off warnings for non-local exception");
Write_Line (" y* turn on warnings for Ada 2005 incompatibility"); Write_Line (" y*+ turn on warnings for Ada 2005 incompatibility");
Write_Line (" Y turn off warnings for Ada 2005 incompatibility"); Write_Line (" Y turn off warnings for Ada 2005 incompatibility");
Write_Line (" z* turn on warnings for suspicious " & Write_Line (" z*+ turn on warnings for suspicious " &
"unchecked conversion"); "unchecked conversion");
Write_Line (" Z turn off warnings for suspicious " & Write_Line (" Z turn off warnings for suspicious " &
"unchecked conversion"); "unchecked conversion");
Write_Line (" * indicates default in above list"); Write_Line (" * indicates default in above list");
Write_Line (" + indicates warning flag included in -gnatwa");
-- Line for -gnatW switch -- Line for -gnatW switch
......
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