OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[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:
Arnaud Charlet 2011-08-03 16:45:56 +02:00
parent ac88396b5e
commit e4982b6489
9 changed files with 165 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
gcc/ada/ChangeLog
View File

@ -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>
* exp_ch13.adb: Add with and use clause for Targparm;

4
gcc/ada/a-except-2005.adb
View File

@ -880,7 +880,7 @@ package body Ada.Exceptions is
procedure Raise_From_Controlled_Operation
(X : Ada.Exceptions.Exception_Occurrence)
is
Prev_Exc : constant EOA := Get_Current_Excep.all;
Prev_Exc : constant EOA := Get_Current_Excep.all;
begin
-- We're raising an exception during finalization. If the finalization
@ -906,7 +906,7 @@ package body Ada.Exceptions is
(Orig_Msg'First .. Orig_Msg'First + Orig_Prefix_Length - 1);
begin
-- Message already has the proper prefix, just re-reraise
-- Message already has the proper prefix, just re-raise
if Orig_Prefix = Prefix then
Raise_Exception_No_Defer

66
gcc/ada/bindgen.adb
View File

@ -665,10 +665,11 @@ package body Bindgen is
"""__gnat_handler_installed"");");
-- The import of the soft link which performs library-level object
-- finalization is not needed for VM targets. Regular Ada is used in
-- that case.
-- finalization is not needed for VM targets; regular Ada is used in
-- 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 (" type No_Param_Proc is access procedure;");
WBI (" Finalize_Library_Objects : No_Param_Proc;");
@ -926,32 +927,38 @@ package body Bindgen is
WBI (" Initialize_Stack_Limit;");
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 Suppress_Standard_Library_On_Target then
WBI ("");
if not Configurable_Run_Time_On_Target then
if not Suppress_Standard_Library_On_Target then
WBI ("");
if VM_Target = No_VM then
if Lib_Final_Built then
Set_String (" Finalize_Library_Objects := ");
Set_String ("Finalize_Library'access;");
else
Set_String (" Finalize_Library_Objects := null;");
end if;
-- On VM targets use regular Ada to set the soft link
if VM_Target = No_VM then
if Lib_Final_Built then
Set_String (" Finalize_Library_Objects := ");
Set_String ("Finalize_Library'access;");
else
Set_String (" Finalize_Library_Objects := null;");
if Lib_Final_Built then
Set_String
(" System.Soft_Links.Finalize_Library_Objects");
Set_String (" := Finalize_Library'access;");
else
Set_String
(" System.Soft_Links.Finalize_Library_Objects");
Set_String (" := null;");
end if;
end if;
-- On VM targets use regular Ada to set the soft link
else
if Lib_Final_Built then
Set_String (" System.Soft_Links.Finalize_Library_Objects");
Set_String (" := Finalize_Library'access;");
else
Set_String (" System.Soft_Links.Finalize_Library_Objects");
Set_String (" := null;");
end if;
Write_Statement_Buffer;
end if;
Write_Statement_Buffer;
end if;
-- Generate elaboration calls
@ -2117,7 +2124,10 @@ package body Bindgen 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
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
-- 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;
-- Name of generated bind file (spec)
@ -2990,7 +3003,8 @@ package body Bindgen 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;
pragma Warnings (Off, Bfile);

6
gcc/ada/exp_ch5.adb
View File

@ -3020,6 +3020,12 @@ package body Exp_Ch5 is
Selector_Name =>
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
-- returns a container, the finalization actions have been saved
-- in the Condition_Actions of the iterator. Insert them now at

5
gcc/ada/exp_ch6.adb
View File

@ -7787,7 +7787,10 @@ package body Exp_Ch6 is
Preserve_Comes_From_Source
(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);
end;
end if;

55
gcc/ada/exp_ch7.adb
View File

@ -316,7 +316,7 @@ package body Exp_Ch7 is
-- Save_Occurrence (E_Id, Get_Current_Excep.all.all);
-- end if;
--
-- If flag For_Library is set:
-- If flag For_Library is set (and not in restricted profile):
--
-- when others =>
-- if not Raised_Id then
@ -769,7 +769,7 @@ package body Exp_Ch7 is
Prefix =>
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);
else
@ -2922,8 +2922,15 @@ package body Exp_Ch7 is
Raise_Id : Entity_Id;
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);
-- Restricted runtime: exception messages are not supported and hence
-- Raise_From_Controlled_Operation is not supported.
else
Raise_Id := RTE (RE_Reraise_Occurrence);
end if;
@ -3166,12 +3173,21 @@ package body Exp_Ch7 is
Loc : constant Source_Ptr := Sloc (N);
begin
return
Make_Procedure_Call_Statement (Loc,
Name =>
New_Reference_To (RTE (RE_Finalize_Protection), Loc),
Parameter_Associations =>
New_List (Concurrent_Ref (Ref)));
-- 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
Make_Procedure_Call_Statement (Loc,
Name =>
New_Reference_To (RTE (RE_Finalize_Protection), Loc),
Parameter_Associations =>
New_List (Concurrent_Ref (Ref)));
end if;
end Cleanup_Protected_Object;
------------------
@ -3184,12 +3200,21 @@ package body Exp_Ch7 is
is
Loc : constant Source_Ptr := Sloc (N);
begin
return
Make_Procedure_Call_Statement (Loc,
Name =>
New_Reference_To (RTE (RE_Free_Task), Loc),
Parameter_Associations =>
New_List (Concurrent_Ref (Ref)));
-- 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
Make_Procedure_Call_Statement (Loc,
Name =>
New_Reference_To (RTE (RE_Free_Task), Loc),
Parameter_Associations =>
New_List (Concurrent_Ref (Ref)));
end if;
end Cleanup_Task;
------------------------------

34
gcc/ada/exp_intr.adb
View File

@ -31,7 +31,6 @@ with Errout; use Errout;
with Exp_Atag; use Exp_Atag;
with Exp_Ch4; use Exp_Ch4;
with Exp_Ch7; use Exp_Ch7;
with Exp_Ch11; use Exp_Ch11;
with Exp_Code; use Exp_Code;
with Exp_Fixd; use Exp_Fixd;
with Exp_Util; use Exp_Util;
@ -965,7 +964,6 @@ package body Exp_Intr is
New_Reference_To (Standard_False, Loc));
Append_To (Stmts, Raised_Decl);
Analyze (Raised_Decl);
Exc_Occ_Decl :=
Make_Object_Declaration (Loc,
@ -975,7 +973,6 @@ package body Exp_Intr is
Set_No_Initialization (Exc_Occ_Decl);
Append_To (Stmts, Exc_Occ_Decl);
Analyze (Exc_Occ_Decl);
Final_Code := New_List (
Make_Block_Statement (Loc,
@ -1034,21 +1031,7 @@ package body Exp_Intr is
At_End_Proc =>
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);
-- We kill saved current values, since analyzing statements not
-- properly attached to the tree can set wrong current values.
Kill_Current_Values;
else
Append_List_To (Stmts, Final_Code);
end if;
@ -1129,7 +1112,7 @@ package body Exp_Intr is
Append_To (Stmts, Free_Node);
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));
@ -1142,17 +1125,15 @@ package body Exp_Intr is
if Is_RTE (Pool, RE_SS_Pool) then
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
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));
-- Case of a specific pool type: make a statically bound call
else
-- Case of a specific pool type: make a statically bound call
Set_Procedure_To_Call (Free_Node,
Find_Prim_Op (Etype (Pool), Name_Deallocate));
end if;
@ -1261,7 +1242,8 @@ package body Exp_Intr is
--
-- Generate:
-- if Raised then
-- Reraise_Occurrence (Exc_Occ); -- for .NET
-- Reraise_Occurrence (Exc_Occ); -- for .NET and
-- -- restricted RTS
-- <or>
-- Raise_From_Controlled_Operation (Exc_Occ); -- all other cases
-- end if;

11
gcc/ada/sem_ch3.adb
View File

@ -8354,14 +8354,11 @@ package body Sem_Ch3 is
Error_Msg_N ("& does not match any discriminant", Id);
return New_Elmt_List;
-- The following is only useful for the benefit of generic
-- instances but it does not interfere with other
-- processing for the non-generic case so we do it in all
-- cases (for generics this statement is executed when
-- processing the generic definition, see comment at the
-- beginning of this if statement).
-- If the parent type is a generic formal, preserve the
-- name of the discriminant for subsequent instances.
-- see comment at the beginning of this if statement.
else
elsif Is_Generic_Type (Root_Type (T)) then
Set_Original_Discriminant (Id, Discr);
end if;
end if;

23
gcc/ada/sem_warn.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -2425,9 +2425,19 @@ package body Sem_Warn is
Pack :=
Find_Package_Renaming
(Spec_Entity (Munite), Lunit);
else
Pack := Empty;
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
("?unit& is not referenced in spec!",
Name (Item));
@ -3367,10 +3377,15 @@ package body Sem_Warn is
Error_Msg_FE
("`IN OUT` prefix overlaps with actual for&?",
Act1, Form);
else
-- For greater clarity, give name of formal.
Error_Msg_Node_2 := Form;
Error_Msg_FE
("writable actual overlaps with actual for&?",
Act1, Form);
("writable actual for & overlaps with"
& " actual for&?", Act1, Form);
end if;
else