[multiple changes]
2011-08-03 Ed Schonberg <schonberg@adacore.com> * exp_ch5.adb (Expand_Iterator_Loop): indicate that the cursor is modified in the source, to prevent spurious warnings when compiling with -gnatg. 2011-08-03 Thomas Quinot <quinot@adacore.com> * a-except-2005.adb: Minor reformatting. 2011-08-03 Ed Schonberg <schonberg@adacore.com> * sem_warn.adb (Check_One_Unit): if the only mention of a withed unit is a renaming declaration in the private part of a package, do not emit a warning that the with_clause could be moved because the renaming may be used in the body or in a child unit. 2011-08-03 Hristian Kirtchev <kirtchev@adacore.com> * exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration): Propagate the Comes_From_Source attribute from the original return object to the renaming. 2011-08-03 Jose Ruiz <ruiz@adacore.com> * exp_ch7.adb (Build_Raise_Statement): Do not call Raise_From_Controlled_Operation when this routine is not present in the run-time library. (Cleanup_Protected_Object, Cleanup_Task): For restricted run-time libraries (Ravenscar), tasks are non-terminating, and protected objects and tasks can only appear at library level, so we do not want finalization of protected objects nor tasks. * exp_intr.adb: Minor clarification in comment. bindgen.adb (Gen_Adainit_Ada, Gen_Main_C, Gen_Output_File_Ada, Gen_Output_File_C): Remove references to finalization of library-level objects when using restricted run-time libraries. 2011-08-03 Ed Schonberg <schonberg@adacore.com> * sem_ch3.adb (Build_Discriminant_Constraints): Set Original_Discriminant only if the parent type is a generic formal. From-SVN: r177278
This commit is contained in:
parent
ac88396b5e
commit
e4982b6489
|
@ -1,3 +1,45 @@
|
||||||
|
2011-08-03 Ed Schonberg <schonberg@adacore.com>
|
||||||
|
|
||||||
|
* exp_ch5.adb (Expand_Iterator_Loop): indicate that the cursor is
|
||||||
|
modified in the source, to prevent spurious warnings when compiling
|
||||||
|
with -gnatg.
|
||||||
|
|
||||||
|
2011-08-03 Thomas Quinot <quinot@adacore.com>
|
||||||
|
|
||||||
|
* a-except-2005.adb: Minor reformatting.
|
||||||
|
|
||||||
|
2011-08-03 Ed Schonberg <schonberg@adacore.com>
|
||||||
|
|
||||||
|
* sem_warn.adb (Check_One_Unit): if the only mention of a withed unit
|
||||||
|
is a renaming declaration in the private part of a package, do not emit
|
||||||
|
a warning that the with_clause could be moved because the renaming may
|
||||||
|
be used in the body or in a child unit.
|
||||||
|
|
||||||
|
2011-08-03 Hristian Kirtchev <kirtchev@adacore.com>
|
||||||
|
|
||||||
|
* exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration):
|
||||||
|
Propagate the Comes_From_Source attribute from the original return
|
||||||
|
object to the renaming.
|
||||||
|
|
||||||
|
2011-08-03 Jose Ruiz <ruiz@adacore.com>
|
||||||
|
|
||||||
|
* exp_ch7.adb (Build_Raise_Statement): Do not call
|
||||||
|
Raise_From_Controlled_Operation when this routine is not present in
|
||||||
|
the run-time library.
|
||||||
|
(Cleanup_Protected_Object, Cleanup_Task): For restricted run-time
|
||||||
|
libraries (Ravenscar), tasks are non-terminating, and protected objects
|
||||||
|
and tasks can only appear at library level, so we do not want
|
||||||
|
finalization of protected objects nor tasks.
|
||||||
|
* exp_intr.adb: Minor clarification in comment.
|
||||||
|
bindgen.adb (Gen_Adainit_Ada, Gen_Main_C, Gen_Output_File_Ada,
|
||||||
|
Gen_Output_File_C): Remove references to finalization of library-level
|
||||||
|
objects when using restricted run-time libraries.
|
||||||
|
|
||||||
|
2011-08-03 Ed Schonberg <schonberg@adacore.com>
|
||||||
|
|
||||||
|
* sem_ch3.adb (Build_Discriminant_Constraints): Set
|
||||||
|
Original_Discriminant only if the parent type is a generic formal.
|
||||||
|
|
||||||
2011-08-03 Hristian Kirtchev <kirtchev@adacore.com>
|
2011-08-03 Hristian Kirtchev <kirtchev@adacore.com>
|
||||||
|
|
||||||
* exp_ch13.adb: Add with and use clause for Targparm;
|
* exp_ch13.adb: Add with and use clause for Targparm;
|
||||||
|
|
|
@ -906,7 +906,7 @@ package body Ada.Exceptions is
|
||||||
(Orig_Msg'First .. Orig_Msg'First + Orig_Prefix_Length - 1);
|
(Orig_Msg'First .. Orig_Msg'First + Orig_Prefix_Length - 1);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
-- Message already has the proper prefix, just re-reraise
|
-- Message already has the proper prefix, just re-raise
|
||||||
|
|
||||||
if Orig_Prefix = Prefix then
|
if Orig_Prefix = Prefix then
|
||||||
Raise_Exception_No_Defer
|
Raise_Exception_No_Defer
|
||||||
|
|
|
@ -665,10 +665,11 @@ package body Bindgen is
|
||||||
"""__gnat_handler_installed"");");
|
"""__gnat_handler_installed"");");
|
||||||
|
|
||||||
-- The import of the soft link which performs library-level object
|
-- The import of the soft link which performs library-level object
|
||||||
-- finalization is not needed for VM targets. Regular Ada is used in
|
-- finalization is not needed for VM targets; regular Ada is used in
|
||||||
-- that case.
|
-- that case. For restricted run-time libraries (ZFP and Ravenscar)
|
||||||
|
-- tasks are non-terminating, so we do not want finalization.
|
||||||
|
|
||||||
if VM_Target = No_VM then
|
if VM_Target = No_VM and then not Configurable_Run_Time_On_Target then
|
||||||
WBI ("");
|
WBI ("");
|
||||||
WBI (" type No_Param_Proc is access procedure;");
|
WBI (" type No_Param_Proc is access procedure;");
|
||||||
WBI (" Finalize_Library_Objects : No_Param_Proc;");
|
WBI (" Finalize_Library_Objects : No_Param_Proc;");
|
||||||
|
@ -926,8 +927,11 @@ package body Bindgen is
|
||||||
WBI (" Initialize_Stack_Limit;");
|
WBI (" Initialize_Stack_Limit;");
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Attach Finalize_Library to the right softlink
|
-- Attach Finalize_Library to the right soft link. Do it only when not
|
||||||
|
-- using a restricted run time, in which case tasks are
|
||||||
|
-- non-terminating, so we do not want library-level finalization.
|
||||||
|
|
||||||
|
if not Configurable_Run_Time_On_Target then
|
||||||
if not Suppress_Standard_Library_On_Target then
|
if not Suppress_Standard_Library_On_Target then
|
||||||
WBI ("");
|
WBI ("");
|
||||||
|
|
||||||
|
@ -943,16 +947,19 @@ package body Bindgen is
|
||||||
|
|
||||||
else
|
else
|
||||||
if Lib_Final_Built then
|
if Lib_Final_Built then
|
||||||
Set_String (" System.Soft_Links.Finalize_Library_Objects");
|
Set_String
|
||||||
|
(" System.Soft_Links.Finalize_Library_Objects");
|
||||||
Set_String (" := Finalize_Library'access;");
|
Set_String (" := Finalize_Library'access;");
|
||||||
else
|
else
|
||||||
Set_String (" System.Soft_Links.Finalize_Library_Objects");
|
Set_String
|
||||||
|
(" System.Soft_Links.Finalize_Library_Objects");
|
||||||
Set_String (" := null;");
|
Set_String (" := null;");
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Write_Statement_Buffer;
|
Write_Statement_Buffer;
|
||||||
end if;
|
end if;
|
||||||
|
end if;
|
||||||
|
|
||||||
-- Generate elaboration calls
|
-- Generate elaboration calls
|
||||||
|
|
||||||
|
@ -2117,7 +2124,10 @@ package body Bindgen is
|
||||||
----------------
|
----------------
|
||||||
|
|
||||||
procedure Gen_Main_C is
|
procedure Gen_Main_C is
|
||||||
Needs_Library_Finalization : constant Boolean := Has_Finalizer;
|
Needs_Library_Finalization : constant Boolean :=
|
||||||
|
not Configurable_Run_Time_On_Target and then Has_Finalizer;
|
||||||
|
-- For restricted run-time libraries (ZFP and Ravenscar) tasks are
|
||||||
|
-- non-terminating, so we do not want library-level finalization.
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Exit_Status_Supported_On_Target then
|
if Exit_Status_Supported_On_Target then
|
||||||
|
@ -2638,7 +2648,10 @@ package body Bindgen is
|
||||||
-- Name to be used for generated Ada main program. See the body of
|
-- Name to be used for generated Ada main program. See the body of
|
||||||
-- function Get_Ada_Main_Name for details on the form of the name.
|
-- function Get_Ada_Main_Name for details on the form of the name.
|
||||||
|
|
||||||
Needs_Library_Finalization : constant Boolean := Has_Finalizer;
|
Needs_Library_Finalization : constant Boolean :=
|
||||||
|
not Configurable_Run_Time_On_Target and then Has_Finalizer;
|
||||||
|
-- For restricted run-time libraries (ZFP and Ravenscar) tasks are
|
||||||
|
-- non-terminating, so we do not want finalization.
|
||||||
|
|
||||||
Bfiles : Name_Id;
|
Bfiles : Name_Id;
|
||||||
-- Name of generated bind file (spec)
|
-- Name of generated bind file (spec)
|
||||||
|
@ -2990,7 +3003,8 @@ package body Bindgen is
|
||||||
|
|
||||||
procedure Gen_Output_File_C (Filename : String) is
|
procedure Gen_Output_File_C (Filename : String) is
|
||||||
|
|
||||||
Needs_Library_Finalization : constant Boolean := Has_Finalizer;
|
Needs_Library_Finalization : constant Boolean :=
|
||||||
|
not Configurable_Run_Time_On_Target and then Has_Finalizer;
|
||||||
|
|
||||||
Bfile : Name_Id;
|
Bfile : Name_Id;
|
||||||
pragma Warnings (Off, Bfile);
|
pragma Warnings (Off, Bfile);
|
||||||
|
|
|
@ -3020,6 +3020,12 @@ package body Exp_Ch5 is
|
||||||
Selector_Name =>
|
Selector_Name =>
|
||||||
Make_Identifier (Loc, Name_Init))));
|
Make_Identifier (Loc, Name_Init))));
|
||||||
|
|
||||||
|
-- The cursor is not modified in the source, but of course will
|
||||||
|
-- be updated in the generated code. Indicate that it is actually
|
||||||
|
-- set to prevent spurious warnings.
|
||||||
|
|
||||||
|
Set_Never_Set_In_Source (Cursor, False);
|
||||||
|
|
||||||
-- If the range of iteration is given by a function call that
|
-- If the range of iteration is given by a function call that
|
||||||
-- returns a container, the finalization actions have been saved
|
-- returns a container, the finalization actions have been saved
|
||||||
-- in the Condition_Actions of the iterator. Insert them now at
|
-- in the Condition_Actions of the iterator. Insert them now at
|
||||||
|
|
|
@ -7787,7 +7787,10 @@ package body Exp_Ch6 is
|
||||||
|
|
||||||
Preserve_Comes_From_Source
|
Preserve_Comes_From_Source
|
||||||
(Object_Decl, Original_Node (Object_Decl));
|
(Object_Decl, Original_Node (Object_Decl));
|
||||||
Set_Comes_From_Source (Obj_Def_Id, True);
|
|
||||||
|
Preserve_Comes_From_Source
|
||||||
|
(Obj_Def_Id, Original_Node (Object_Decl));
|
||||||
|
|
||||||
Set_Comes_From_Source (Renaming_Def_Id, False);
|
Set_Comes_From_Source (Renaming_Def_Id, False);
|
||||||
end;
|
end;
|
||||||
end if;
|
end if;
|
||||||
|
|
|
@ -316,7 +316,7 @@ package body Exp_Ch7 is
|
||||||
-- Save_Occurrence (E_Id, Get_Current_Excep.all.all);
|
-- Save_Occurrence (E_Id, Get_Current_Excep.all.all);
|
||||||
-- end if;
|
-- end if;
|
||||||
--
|
--
|
||||||
-- If flag For_Library is set:
|
-- If flag For_Library is set (and not in restricted profile):
|
||||||
--
|
--
|
||||||
-- when others =>
|
-- when others =>
|
||||||
-- if not Raised_Id then
|
-- if not Raised_Id then
|
||||||
|
@ -769,7 +769,7 @@ package body Exp_Ch7 is
|
||||||
Prefix =>
|
Prefix =>
|
||||||
New_Reference_To (RTE (RE_Get_Current_Excep), Loc)))));
|
New_Reference_To (RTE (RE_Get_Current_Excep), Loc)))));
|
||||||
|
|
||||||
if For_Library then
|
if For_Library and then not Restricted_Profile then
|
||||||
Proc_To_Call := RTE (RE_Save_Library_Occurrence);
|
Proc_To_Call := RTE (RE_Save_Library_Occurrence);
|
||||||
|
|
||||||
else
|
else
|
||||||
|
@ -2922,8 +2922,15 @@ package body Exp_Ch7 is
|
||||||
Raise_Id : Entity_Id;
|
Raise_Id : Entity_Id;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if VM_Target = No_VM then
|
if VM_Target /= No_VM then
|
||||||
|
Raise_Id := RTE (RE_Reraise_Occurrence);
|
||||||
|
|
||||||
|
-- Standard run-time library
|
||||||
|
elsif RTE_Available (RE_Raise_From_Controlled_Operation) then
|
||||||
Raise_Id := RTE (RE_Raise_From_Controlled_Operation);
|
Raise_Id := RTE (RE_Raise_From_Controlled_Operation);
|
||||||
|
|
||||||
|
-- Restricted runtime: exception messages are not supported and hence
|
||||||
|
-- Raise_From_Controlled_Operation is not supported.
|
||||||
else
|
else
|
||||||
Raise_Id := RTE (RE_Reraise_Occurrence);
|
Raise_Id := RTE (RE_Reraise_Occurrence);
|
||||||
end if;
|
end if;
|
||||||
|
@ -3166,12 +3173,21 @@ package body Exp_Ch7 is
|
||||||
Loc : constant Source_Ptr := Sloc (N);
|
Loc : constant Source_Ptr := Sloc (N);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
-- For restricted run-time libraries (Ravenscar), tasks are
|
||||||
|
-- non-terminating, and protected objects can only appear at library
|
||||||
|
-- level, so we do not want finalization of protected objects.
|
||||||
|
|
||||||
|
if Restricted_Profile then
|
||||||
|
return Empty;
|
||||||
|
|
||||||
|
else
|
||||||
return
|
return
|
||||||
Make_Procedure_Call_Statement (Loc,
|
Make_Procedure_Call_Statement (Loc,
|
||||||
Name =>
|
Name =>
|
||||||
New_Reference_To (RTE (RE_Finalize_Protection), Loc),
|
New_Reference_To (RTE (RE_Finalize_Protection), Loc),
|
||||||
Parameter_Associations =>
|
Parameter_Associations =>
|
||||||
New_List (Concurrent_Ref (Ref)));
|
New_List (Concurrent_Ref (Ref)));
|
||||||
|
end if;
|
||||||
end Cleanup_Protected_Object;
|
end Cleanup_Protected_Object;
|
||||||
|
|
||||||
------------------
|
------------------
|
||||||
|
@ -3184,12 +3200,21 @@ package body Exp_Ch7 is
|
||||||
is
|
is
|
||||||
Loc : constant Source_Ptr := Sloc (N);
|
Loc : constant Source_Ptr := Sloc (N);
|
||||||
begin
|
begin
|
||||||
|
-- For restricted run-time libraries (Ravenscar), tasks are
|
||||||
|
-- non-terminating and they can only appear at library level, so we do
|
||||||
|
-- not want finalization of task objects.
|
||||||
|
|
||||||
|
if Restricted_Profile then
|
||||||
|
return Empty;
|
||||||
|
|
||||||
|
else
|
||||||
return
|
return
|
||||||
Make_Procedure_Call_Statement (Loc,
|
Make_Procedure_Call_Statement (Loc,
|
||||||
Name =>
|
Name =>
|
||||||
New_Reference_To (RTE (RE_Free_Task), Loc),
|
New_Reference_To (RTE (RE_Free_Task), Loc),
|
||||||
Parameter_Associations =>
|
Parameter_Associations =>
|
||||||
New_List (Concurrent_Ref (Ref)));
|
New_List (Concurrent_Ref (Ref)));
|
||||||
|
end if;
|
||||||
end Cleanup_Task;
|
end Cleanup_Task;
|
||||||
|
|
||||||
------------------------------
|
------------------------------
|
||||||
|
|
|
@ -31,7 +31,6 @@ with Errout; use Errout;
|
||||||
with Exp_Atag; use Exp_Atag;
|
with Exp_Atag; use Exp_Atag;
|
||||||
with Exp_Ch4; use Exp_Ch4;
|
with Exp_Ch4; use Exp_Ch4;
|
||||||
with Exp_Ch7; use Exp_Ch7;
|
with Exp_Ch7; use Exp_Ch7;
|
||||||
with Exp_Ch11; use Exp_Ch11;
|
|
||||||
with Exp_Code; use Exp_Code;
|
with Exp_Code; use Exp_Code;
|
||||||
with Exp_Fixd; use Exp_Fixd;
|
with Exp_Fixd; use Exp_Fixd;
|
||||||
with Exp_Util; use Exp_Util;
|
with Exp_Util; use Exp_Util;
|
||||||
|
@ -965,7 +964,6 @@ package body Exp_Intr is
|
||||||
New_Reference_To (Standard_False, Loc));
|
New_Reference_To (Standard_False, Loc));
|
||||||
|
|
||||||
Append_To (Stmts, Raised_Decl);
|
Append_To (Stmts, Raised_Decl);
|
||||||
Analyze (Raised_Decl);
|
|
||||||
|
|
||||||
Exc_Occ_Decl :=
|
Exc_Occ_Decl :=
|
||||||
Make_Object_Declaration (Loc,
|
Make_Object_Declaration (Loc,
|
||||||
|
@ -975,7 +973,6 @@ package body Exp_Intr is
|
||||||
Set_No_Initialization (Exc_Occ_Decl);
|
Set_No_Initialization (Exc_Occ_Decl);
|
||||||
|
|
||||||
Append_To (Stmts, Exc_Occ_Decl);
|
Append_To (Stmts, Exc_Occ_Decl);
|
||||||
Analyze (Exc_Occ_Decl);
|
|
||||||
|
|
||||||
Final_Code := New_List (
|
Final_Code := New_List (
|
||||||
Make_Block_Statement (Loc,
|
Make_Block_Statement (Loc,
|
||||||
|
@ -1034,21 +1031,7 @@ package body Exp_Intr is
|
||||||
At_End_Proc =>
|
At_End_Proc =>
|
||||||
New_Occurrence_Of (RTE (RE_Abort_Undefer_Direct), Loc)));
|
New_Occurrence_Of (RTE (RE_Abort_Undefer_Direct), Loc)));
|
||||||
|
|
||||||
-- We now expand the exception (at end) handler. We set a
|
|
||||||
-- temporary parent pointer since we have not attached Blk
|
|
||||||
-- to the tree yet.
|
|
||||||
|
|
||||||
Set_Parent (Blk, N);
|
|
||||||
Analyze (Blk);
|
|
||||||
Expand_At_End_Handler
|
|
||||||
(Handled_Statement_Sequence (Blk), Entity (Identifier (Blk)));
|
|
||||||
Append (Blk, Stmts);
|
Append (Blk, Stmts);
|
||||||
|
|
||||||
-- We kill saved current values, since analyzing statements not
|
|
||||||
-- properly attached to the tree can set wrong current values.
|
|
||||||
|
|
||||||
Kill_Current_Values;
|
|
||||||
|
|
||||||
else
|
else
|
||||||
Append_List_To (Stmts, Final_Code);
|
Append_List_To (Stmts, Final_Code);
|
||||||
end if;
|
end if;
|
||||||
|
@ -1129,7 +1112,7 @@ package body Exp_Intr is
|
||||||
Append_To (Stmts, Free_Node);
|
Append_To (Stmts, Free_Node);
|
||||||
Set_Storage_Pool (Free_Node, Pool);
|
Set_Storage_Pool (Free_Node, Pool);
|
||||||
|
|
||||||
-- Attach to tree before analysis of generated subtypes below.
|
-- Attach to tree before analysis of generated subtypes below
|
||||||
|
|
||||||
Set_Parent (Stmts, Parent (N));
|
Set_Parent (Stmts, Parent (N));
|
||||||
|
|
||||||
|
@ -1142,17 +1125,15 @@ package body Exp_Intr is
|
||||||
if Is_RTE (Pool, RE_SS_Pool) then
|
if Is_RTE (Pool, RE_SS_Pool) then
|
||||||
null;
|
null;
|
||||||
|
|
||||||
|
-- Case of a class-wide pool type: make a dispatching call to
|
||||||
|
-- Deallocate through the class-wide Deallocate_Any.
|
||||||
|
|
||||||
elsif Is_Class_Wide_Type (Etype (Pool)) then
|
elsif Is_Class_Wide_Type (Etype (Pool)) then
|
||||||
|
Set_Procedure_To_Call (Free_Node, RTE (RE_Deallocate_Any));
|
||||||
|
|
||||||
-- Case of a class-wide pool type: make a dispatching call
|
|
||||||
-- to Deallocate through the class-wide Deallocate_Any.
|
|
||||||
|
|
||||||
Set_Procedure_To_Call (Free_Node,
|
|
||||||
RTE (RE_Deallocate_Any));
|
|
||||||
|
|
||||||
else
|
|
||||||
-- Case of a specific pool type: make a statically bound call
|
-- Case of a specific pool type: make a statically bound call
|
||||||
|
|
||||||
|
else
|
||||||
Set_Procedure_To_Call (Free_Node,
|
Set_Procedure_To_Call (Free_Node,
|
||||||
Find_Prim_Op (Etype (Pool), Name_Deallocate));
|
Find_Prim_Op (Etype (Pool), Name_Deallocate));
|
||||||
end if;
|
end if;
|
||||||
|
@ -1261,7 +1242,8 @@ package body Exp_Intr is
|
||||||
--
|
--
|
||||||
-- Generate:
|
-- Generate:
|
||||||
-- if Raised then
|
-- if Raised then
|
||||||
-- Reraise_Occurrence (Exc_Occ); -- for .NET
|
-- Reraise_Occurrence (Exc_Occ); -- for .NET and
|
||||||
|
-- -- restricted RTS
|
||||||
-- <or>
|
-- <or>
|
||||||
-- Raise_From_Controlled_Operation (Exc_Occ); -- all other cases
|
-- Raise_From_Controlled_Operation (Exc_Occ); -- all other cases
|
||||||
-- end if;
|
-- end if;
|
||||||
|
|
|
@ -8354,14 +8354,11 @@ package body Sem_Ch3 is
|
||||||
Error_Msg_N ("& does not match any discriminant", Id);
|
Error_Msg_N ("& does not match any discriminant", Id);
|
||||||
return New_Elmt_List;
|
return New_Elmt_List;
|
||||||
|
|
||||||
-- The following is only useful for the benefit of generic
|
-- If the parent type is a generic formal, preserve the
|
||||||
-- instances but it does not interfere with other
|
-- name of the discriminant for subsequent instances.
|
||||||
-- processing for the non-generic case so we do it in all
|
-- see comment at the beginning of this if statement.
|
||||||
-- cases (for generics this statement is executed when
|
|
||||||
-- processing the generic definition, see comment at the
|
|
||||||
-- beginning of this if statement).
|
|
||||||
|
|
||||||
else
|
elsif Is_Generic_Type (Root_Type (T)) then
|
||||||
Set_Original_Discriminant (Id, Discr);
|
Set_Original_Discriminant (Id, Discr);
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- B o d y --
|
||||||
-- --
|
-- --
|
||||||
-- Copyright (C) 1999-2010, Free Software Foundation, Inc. --
|
-- Copyright (C) 1999-2011, Free Software Foundation, Inc. --
|
||||||
-- --
|
-- --
|
||||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -2425,9 +2425,19 @@ package body Sem_Warn is
|
||||||
Pack :=
|
Pack :=
|
||||||
Find_Package_Renaming
|
Find_Package_Renaming
|
||||||
(Spec_Entity (Munite), Lunit);
|
(Spec_Entity (Munite), Lunit);
|
||||||
|
else
|
||||||
|
Pack := Empty;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Unreferenced_In_Spec (Item) then
|
-- If a renaming is present in the spec do not warn
|
||||||
|
-- because the body or child unit may depend on it.
|
||||||
|
|
||||||
|
if Present (Pack)
|
||||||
|
and then Renamed_Entity (Pack) = Lunit
|
||||||
|
then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
elsif Unreferenced_In_Spec (Item) then
|
||||||
Error_Msg_N -- CODEFIX
|
Error_Msg_N -- CODEFIX
|
||||||
("?unit& is not referenced in spec!",
|
("?unit& is not referenced in spec!",
|
||||||
Name (Item));
|
Name (Item));
|
||||||
|
@ -3367,10 +3377,15 @@ package body Sem_Warn is
|
||||||
Error_Msg_FE
|
Error_Msg_FE
|
||||||
("`IN OUT` prefix overlaps with actual for&?",
|
("`IN OUT` prefix overlaps with actual for&?",
|
||||||
Act1, Form);
|
Act1, Form);
|
||||||
|
|
||||||
else
|
else
|
||||||
|
|
||||||
|
-- For greater clarity, give name of formal.
|
||||||
|
|
||||||
|
Error_Msg_Node_2 := Form;
|
||||||
Error_Msg_FE
|
Error_Msg_FE
|
||||||
("writable actual overlaps with actual for&?",
|
("writable actual for & overlaps with"
|
||||||
Act1, Form);
|
& " actual for&?", Act1, Form);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
else
|
else
|
||||||
|
|
Loading…
Reference in New Issue