+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;
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
(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
"""__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;");
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;
+ 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
+ -- 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;");
+ 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;
- end if;
- Write_Statement_Buffer;
+ Write_Statement_Buffer;
+ end if;
end if;
-- Generate elaboration calls
----------------
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
-- 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)
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);
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
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;
-- 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
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
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;
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;
------------------
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;
------------------------------
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;
New_Reference_To (Standard_False, Loc));
Append_To (Stmts, Raised_Decl);
- Analyze (Raised_Decl);
Exc_Occ_Decl :=
Make_Object_Declaration (Loc,
Set_No_Initialization (Exc_Occ_Decl);
Append_To (Stmts, Exc_Occ_Decl);
- Analyze (Exc_Occ_Decl);
Final_Code := New_List (
Make_Block_Statement (Loc,
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;
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));
if Is_RTE (Pool, RE_SS_Pool) then
null;
- elsif Is_Class_Wide_Type (Etype (Pool)) then
+ -- Case of a class-wide pool type: make a dispatching call to
+ -- Deallocate through the class-wide Deallocate_Any.
- -- 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));
- 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;
--
-- 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;
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;
-- --
-- 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- --
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));
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
projects / gcc.git / commitdiff