[multiple changes]
2011-08-03 Javier Miranda <miranda@adacore.com> * sem_prag.adb (Process_Interface_Name): Allow duplicated export names in Java since they are always enclosed in a namespace that differentiates them, and overloaded entities are supported by the VM. 2011-08-03 Ed Schonberg <schonberg@adacore.com> * checks.adb (Determine_Range): If a computed bound of an operation is outside the range of the base type of the expression, and overflow checks are enabled, the result is unknown and cannot be used for any subsequent constant folding. * sem_eval.adb (Compile_Time_Compare): if the bounds of one operand are unknown, so is the result of the comparison. 2011-08-03 Hristian Kirtchev <kirtchev@adacore.com> * a-except-2005.adb (Raise_From_Controlled_Operation): Add new formal From_Abort. When finalization was triggered by an abort, propagate Standard'Abort_Signal rather than Program_Error. * a-except-2005.ads (Raise_From_Controlled_Operation): Add new formal From_Abort. * a-except.adb (Raise_From_Controlled_Operation): Add new formal From_Abort. When finalization was triggered by an abort, propagate Standard'Abort_Signal rather than Program_Error. * a-except.ads:(Raise_From_Controlled_Operation): Add new formal From_Abort. * exp_ch7.adb:(Build_Adjust_Or_Finalize_Statements): New local variable Abort_Id. Update the calls to Build_Object_Declarations and Build_Raise_Statement to include Abort_Id. (Build_Adjust_Statements): New local variable Abort_Id. Update the calls to Build_Object_Declarations and Build_Raise_Statement to include Abort_Id. (Build_Finalize_Statements): New local variable Abort_Id. Update the calls to Build_Object_Declarations and Build_Raise_Statement to include Abort_Id. (Build_Components): Create an entity for Abort_Id when exceptions are allowed on the target. (Build_Finalizer): New local variable Abort_Id. (Build_Initialize_Statements): New local variable Abort_Id. Update the calls to Build_Object_Declarations and Build_Raise_Statement to include Abort_Id. (Build_Object_Declarations): Add new formal Abort_Id. Create the declaration of flag Abort_Id to preserve the original abort status before finalization code is executed. (Build_Raise_Statement): Add new formal Abort_Id. Pass Abort_Id to runtime routine Raise_From_Controlled_Operation. (Create_Finalizer): Update the call to Build_Raise_Statement to include Abort_Id. Update the call to Build_Object_Declarations to include Abort_Id. Update the layout of the finalizer body. (Make_Handler_For_Ctrl_Operation): Add an actual for From_Abort. (Process_Transient_Objects): New local variable Abort_Id. Remove the clunky code to create all flags and objects related to exception propagation and replace it with a call to Build_Object_Declarations. Update the call to Build_Raise_Statement to include Abort_Id. * exp_ch7.ads (Build_Object_Declarations): Moved from body to spec. Add new formal Abort_Id and associated comment on its use. (Build_Raise_Statement): Add new formal Abort_Id and associated comment on its use. * exp_intr.adb (Expand_Unc_Deallocation): New local variable Abort_Id. Remove the clunky code to create all flags and objects related to exception propagation and replace it with a call to Build_Object_Declarations. Update the call to Build_Raise_Statement. 2011-08-03 Eric Botcazou <ebotcazou@adacore.com> * s-tassta.adb: Fix minor typos. 2011-08-03 Robert Dewar <dewar@adacore.com> * rtsfind.ads, makeutl.ads, prj.ads, prj.adb, make.adb, lib-writ.adb, makeutl.adb, s-soflin.ads, clean.adb: Minor reformatting. From-SVN: r177283
This commit is contained in:
parent
1cdfa9be54
commit
f9ad6b6231
|
@ -1,3 +1,77 @@
|
|||
2011-08-03 Javier Miranda <miranda@adacore.com>
|
||||
|
||||
* sem_prag.adb (Process_Interface_Name): Allow duplicated export names
|
||||
in Java since they are always enclosed in a namespace that
|
||||
differentiates them, and overloaded entities are supported by the VM.
|
||||
|
||||
2011-08-03 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* checks.adb (Determine_Range): If a computed bound of an operation is
|
||||
outside the range of the base type of the expression, and overflow
|
||||
checks are enabled, the result is unknown and cannot be used for any
|
||||
subsequent constant folding.
|
||||
* sem_eval.adb (Compile_Time_Compare): if the bounds of one operand are
|
||||
unknown, so is the result of the comparison.
|
||||
|
||||
2011-08-03 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* a-except-2005.adb (Raise_From_Controlled_Operation): Add new formal
|
||||
From_Abort. When finalization was triggered by an abort, propagate
|
||||
Standard'Abort_Signal rather than Program_Error.
|
||||
* a-except-2005.ads (Raise_From_Controlled_Operation): Add new formal
|
||||
From_Abort.
|
||||
* a-except.adb (Raise_From_Controlled_Operation): Add new formal
|
||||
From_Abort. When finalization was triggered by an abort, propagate
|
||||
Standard'Abort_Signal rather than Program_Error.
|
||||
* a-except.ads:(Raise_From_Controlled_Operation): Add new formal
|
||||
From_Abort.
|
||||
* exp_ch7.adb:(Build_Adjust_Or_Finalize_Statements): New local variable
|
||||
Abort_Id. Update the calls to Build_Object_Declarations and
|
||||
Build_Raise_Statement to include Abort_Id.
|
||||
(Build_Adjust_Statements): New local variable Abort_Id. Update the
|
||||
calls to Build_Object_Declarations and Build_Raise_Statement to include
|
||||
Abort_Id.
|
||||
(Build_Finalize_Statements): New local variable Abort_Id. Update the
|
||||
calls to Build_Object_Declarations and Build_Raise_Statement to include
|
||||
Abort_Id.
|
||||
(Build_Components): Create an entity for Abort_Id when exceptions are
|
||||
allowed on the target.
|
||||
(Build_Finalizer): New local variable Abort_Id.
|
||||
(Build_Initialize_Statements): New local variable Abort_Id. Update the
|
||||
calls to Build_Object_Declarations and Build_Raise_Statement to include
|
||||
Abort_Id.
|
||||
(Build_Object_Declarations): Add new formal Abort_Id. Create the
|
||||
declaration of flag Abort_Id to preserve the original abort status
|
||||
before finalization code is executed.
|
||||
(Build_Raise_Statement): Add new formal Abort_Id. Pass Abort_Id to
|
||||
runtime routine Raise_From_Controlled_Operation.
|
||||
(Create_Finalizer): Update the call to Build_Raise_Statement to include
|
||||
Abort_Id. Update the call to Build_Object_Declarations to include
|
||||
Abort_Id. Update the layout of the finalizer body.
|
||||
(Make_Handler_For_Ctrl_Operation): Add an actual for From_Abort.
|
||||
(Process_Transient_Objects): New local variable Abort_Id. Remove the
|
||||
clunky code to create all flags and objects related to
|
||||
exception propagation and replace it with a call to
|
||||
Build_Object_Declarations. Update the call to Build_Raise_Statement to
|
||||
include Abort_Id.
|
||||
* exp_ch7.ads (Build_Object_Declarations): Moved from body to spec.
|
||||
Add new formal Abort_Id and associated comment on its use.
|
||||
(Build_Raise_Statement): Add new formal Abort_Id and associated comment
|
||||
on its use.
|
||||
* exp_intr.adb (Expand_Unc_Deallocation): New local variable Abort_Id.
|
||||
Remove the clunky code to create all flags and objects related to
|
||||
exception propagation and replace it with a call to
|
||||
Build_Object_Declarations. Update the call to Build_Raise_Statement.
|
||||
|
||||
2011-08-03 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* s-tassta.adb: Fix minor typos.
|
||||
|
||||
2011-08-03 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* rtsfind.ads, makeutl.ads, prj.ads, prj.adb, make.adb,
|
||||
lib-writ.adb, makeutl.adb, s-soflin.ads, clean.adb: Minor reformatting.
|
||||
|
||||
2011-08-03 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* exp_ch7.adb (Create_Finalizer): Treat freeze nodes in similar fashion
|
||||
|
|
|
@ -878,21 +878,15 @@ package body Ada.Exceptions is
|
|||
-------------------------------------
|
||||
|
||||
procedure Raise_From_Controlled_Operation
|
||||
(X : Ada.Exceptions.Exception_Occurrence)
|
||||
(X : Ada.Exceptions.Exception_Occurrence;
|
||||
From_Abort : Boolean)
|
||||
is
|
||||
Prev_Exc : constant EOA := Get_Current_Excep.all;
|
||||
|
||||
begin
|
||||
-- We're raising an exception during finalization. If the finalization
|
||||
-- was triggered by an abort, as indicated by Not_Handled_By_Others,
|
||||
-- then we don't want to raise Program_Error; we want to continue with
|
||||
-- the Abort_Signal exception. Note that the original exception
|
||||
-- occurrence that triggered the finalization is saved before calling
|
||||
-- the Finalize procedures, and then restored afterward, so in the case
|
||||
-- of abort, the original Abort_Signal will be the current one.
|
||||
-- When finalization was triggered by an abort, keep propagating the
|
||||
-- abort signal rather than raising Program_Error.
|
||||
|
||||
if Prev_Exc.Id /= null and then Prev_Exc.Id.Not_Handled_By_Others then
|
||||
Raise_Current_Excep (Prev_Exc.Id);
|
||||
if From_Abort then
|
||||
raise Standard'Abort_Signal;
|
||||
|
||||
-- Otherwise, raise Program_Error
|
||||
|
||||
|
|
|
@ -230,7 +230,8 @@ private
|
|||
-- system to return here rather than to the original location.
|
||||
|
||||
procedure Raise_From_Controlled_Operation
|
||||
(X : Ada.Exceptions.Exception_Occurrence);
|
||||
(X : Ada.Exceptions.Exception_Occurrence;
|
||||
From_Abort : Boolean);
|
||||
pragma No_Return (Raise_From_Controlled_Operation);
|
||||
pragma Export
|
||||
(Ada, Raise_From_Controlled_Operation,
|
||||
|
|
|
@ -850,21 +850,15 @@ package body Ada.Exceptions is
|
|||
-------------------------------------
|
||||
|
||||
procedure Raise_From_Controlled_Operation
|
||||
(X : Ada.Exceptions.Exception_Occurrence)
|
||||
(X : Ada.Exceptions.Exception_Occurrence;
|
||||
From_Abort : Boolean)
|
||||
is
|
||||
Prev_Exc : constant EOA := Get_Current_Excep.all;
|
||||
|
||||
begin
|
||||
-- We're raising an exception during finalization. If the finalization
|
||||
-- was triggered by an abort, as indicated by Not_Handled_By_Others,
|
||||
-- then we don't want to raise Program_Error; we want to continue with
|
||||
-- the Abort_Signal exception. Note that the original exception
|
||||
-- occurrence that triggered the finalization is saved before calling
|
||||
-- the Finalize procedures, and then restored afterward, so in the case
|
||||
-- of abort, the original Abort_Signal will be the current one.
|
||||
-- When finalization was triggered by an abort, keep propagating the
|
||||
-- abort signal rather than raising Program_Error.
|
||||
|
||||
if Prev_Exc.Id /= null and then Prev_Exc.Id.Not_Handled_By_Others then
|
||||
Raise_Current_Excep (Prev_Exc.Id);
|
||||
if From_Abort then
|
||||
raise Standard'Abort_Signal;
|
||||
|
||||
-- Otherwise, raise Program_Error
|
||||
|
||||
|
@ -873,9 +867,11 @@ package body Ada.Exceptions is
|
|||
Prefix : constant String := "adjust/finalize raised ";
|
||||
Orig_Msg : constant String := Exception_Message (X);
|
||||
Orig_Prefix_Length : constant Natural :=
|
||||
Integer'Min (Prefix'Length, Orig_Msg'Length);
|
||||
Integer'Min
|
||||
(Prefix'Length, Orig_Msg'Length);
|
||||
Orig_Prefix : String renames Orig_Msg
|
||||
(Orig_Msg'First .. Orig_Msg'First + Orig_Prefix_Length - 1);
|
||||
(Orig_Msg'First ..
|
||||
Orig_Msg'First + Orig_Prefix_Length - 1);
|
||||
|
||||
begin
|
||||
-- Message already has proper prefix, just re-reraise
|
||||
|
|
|
@ -199,7 +199,8 @@ private
|
|||
-- system to return here rather than to the original location.
|
||||
|
||||
procedure Raise_From_Controlled_Operation
|
||||
(X : Ada.Exceptions.Exception_Occurrence);
|
||||
(X : Ada.Exceptions.Exception_Occurrence;
|
||||
From_Abort : Boolean);
|
||||
pragma No_Return (Raise_From_Controlled_Operation);
|
||||
pragma Export
|
||||
(Ada, Raise_From_Controlled_Operation,
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-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- --
|
||||
|
@ -3457,6 +3457,18 @@ package body Checks is
|
|||
-- the computed expression is in the range Lor .. Hir. We can use this
|
||||
-- to restrict the possible range of results.
|
||||
|
||||
-- If one of the computed bounds is outside the range of the base type,
|
||||
-- the expression may raise an exception and we better indicate that
|
||||
-- the evaluation has failed, at least if checks are enabled.
|
||||
|
||||
if Enable_Overflow_Checks
|
||||
and then not Is_Entity_Name (N)
|
||||
and then (Lor < Lo or else Hir > Hi)
|
||||
then
|
||||
OK := False;
|
||||
return;
|
||||
end if;
|
||||
|
||||
if OK1 then
|
||||
|
||||
-- If the refined value of the low bound is greater than the type
|
||||
|
|
|
@ -370,9 +370,8 @@ package body Clean is
|
|||
|
||||
Text : Text_Buffer_Ptr;
|
||||
The_ALI : ALI_Id;
|
||||
|
||||
Found : Boolean;
|
||||
Source : Queue.Source_Info;
|
||||
Found : Boolean;
|
||||
Source : Queue.Source_Info;
|
||||
|
||||
begin
|
||||
Queue.Initialize (Queue_Per_Obj_Dir => False);
|
||||
|
@ -388,8 +387,8 @@ package body Clean is
|
|||
|
||||
for N_File in 1 .. Osint.Number_Of_Files loop
|
||||
Main_Source_File := Next_Main_Source;
|
||||
Main_Lib_File := Osint.Lib_File_Name
|
||||
(Main_Source_File, Current_File_Index);
|
||||
Main_Lib_File :=
|
||||
Osint.Lib_File_Name (Main_Source_File, Current_File_Index);
|
||||
|
||||
if Main_Lib_File /= No_File then
|
||||
Queue.Insert
|
||||
|
|
|
@ -359,17 +359,6 @@ package body Exp_Ch7 is
|
|||
-- an exception handler, the statements will be wrapped in a block to avoid
|
||||
-- unwanted interaction with the new At_End handler.
|
||||
|
||||
function Build_Object_Declarations
|
||||
(Loc : Source_Ptr;
|
||||
E_Id : Entity_Id;
|
||||
Raised_Id : Entity_Id) return List_Id;
|
||||
-- Subsidiary to Make_Deep_Array_Body and Make_Deep_Record_Body. Return a
|
||||
-- list containing the object declarations of the exception occurrence E_Id
|
||||
-- and boolean flag Raised_Id.
|
||||
--
|
||||
-- E_Id : Exception_Occurrence;
|
||||
-- Raised_Id : Boolean := False;
|
||||
|
||||
procedure Build_Record_Deep_Procs (Typ : Entity_Id);
|
||||
-- Build the deep Initialize/Adjust/Finalize for a record Typ with
|
||||
-- Has_Component_Component set and store them using the TSS mechanism.
|
||||
|
@ -1088,10 +1077,15 @@ package body Exp_Ch7 is
|
|||
-- structures right from the start. Entities and lists are created once
|
||||
-- it has been established that N has at least one controlled object.
|
||||
|
||||
Abort_Id : Entity_Id := Empty;
|
||||
-- Entity of local flag. The flag is set when finalization is triggered
|
||||
-- by an abort.
|
||||
|
||||
Components_Built : Boolean := False;
|
||||
-- A flag used to avoid double initialization of entities and lists. If
|
||||
-- the flag is set then the following variables have been initialized:
|
||||
--
|
||||
-- Abort_Id
|
||||
-- Counter_Id
|
||||
-- E_Id
|
||||
-- Finalizer_Decls
|
||||
|
@ -1237,6 +1231,7 @@ package body Exp_Ch7 is
|
|||
Counter_Typ := Make_Temporary (Loc, 'T');
|
||||
|
||||
if Exceptions_OK then
|
||||
Abort_Id := Make_Temporary (Loc, 'A');
|
||||
E_Id := Make_Temporary (Loc, 'E');
|
||||
Raised_Id := Make_Temporary (Loc, 'R');
|
||||
end if;
|
||||
|
@ -1322,7 +1317,6 @@ package body Exp_Ch7 is
|
|||
|
||||
procedure Create_Finalizer is
|
||||
Conv_Name : Name_Id;
|
||||
E_Decl : Node_Id;
|
||||
Fin_Body : Node_Id;
|
||||
Fin_Spec : Node_Id;
|
||||
Jump_Block : Node_Id;
|
||||
|
@ -1514,14 +1508,14 @@ package body Exp_Ch7 is
|
|||
-- level finalizers. Generate:
|
||||
--
|
||||
-- if Raised then
|
||||
-- Raise_From_Controlled_Operation (E);
|
||||
-- Raise_From_Controlled_Operation (E, Abort);
|
||||
-- end if;
|
||||
|
||||
if not For_Package
|
||||
and then Exceptions_OK
|
||||
then
|
||||
Append_To (Finalizer_Stmts,
|
||||
Build_Raise_Statement (Loc, E_Id, Raised_Id));
|
||||
Build_Raise_Statement (Loc, Abort_Id, E_Id, Raised_Id));
|
||||
end if;
|
||||
|
||||
-- Create the jump block which controls the finalization flow
|
||||
|
@ -1587,11 +1581,18 @@ package body Exp_Ch7 is
|
|||
|
||||
-- Generate:
|
||||
-- procedure Fin_Id is
|
||||
-- Abort : constant Boolean :=
|
||||
-- Exception_Occurrence (Get_Current_Excep.all.all) =
|
||||
-- Standard'Abort_Signal'Identity;
|
||||
-- <or>
|
||||
-- Abort : constant Boolean := False; -- no abort
|
||||
|
||||
-- E : Exception_Occurrence; -- All added if flag
|
||||
-- Raised : Boolean := False; -- Has_Ctrl_Objs is set
|
||||
-- L0 : label;
|
||||
-- ...
|
||||
-- Lnn : label;
|
||||
|
||||
-- begin
|
||||
-- Abort_Defer; -- Added if abort is allowed
|
||||
-- <call to Prev_At_End> -- Added if exists
|
||||
|
@ -1605,28 +1606,8 @@ package body Exp_Ch7 is
|
|||
if Has_Ctrl_Objs
|
||||
and then Exceptions_OK
|
||||
then
|
||||
-- Generate:
|
||||
-- Raised : Boolean := False;
|
||||
|
||||
Prepend_To (Finalizer_Decls,
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Raised_Id,
|
||||
Object_Definition =>
|
||||
New_Reference_To (Standard_Boolean, Loc),
|
||||
Expression =>
|
||||
New_Reference_To (Standard_False, Loc)));
|
||||
|
||||
-- Generate:
|
||||
-- E : Exception_Occurrence;
|
||||
|
||||
E_Decl :=
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => E_Id,
|
||||
Object_Definition =>
|
||||
New_Reference_To (RTE (RE_Exception_Occurrence), Loc));
|
||||
Set_No_Initialization (E_Decl);
|
||||
|
||||
Prepend_To (Finalizer_Decls, E_Decl);
|
||||
Prepend_List_To (Finalizer_Decls,
|
||||
Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id));
|
||||
end if;
|
||||
|
||||
-- Create the body of the finalizer
|
||||
|
@ -2910,9 +2891,11 @@ package body Exp_Ch7 is
|
|||
|
||||
function Build_Object_Declarations
|
||||
(Loc : Source_Ptr;
|
||||
Abort_Id : Entity_Id;
|
||||
E_Id : Entity_Id;
|
||||
Raised_Id : Entity_Id) return List_Id
|
||||
is
|
||||
A_Expr : Node_Id;
|
||||
E_Decl : Node_Id;
|
||||
|
||||
begin
|
||||
|
@ -2920,9 +2903,43 @@ package body Exp_Ch7 is
|
|||
return Empty_List;
|
||||
end if;
|
||||
|
||||
pragma Assert (Present (Abort_Id));
|
||||
pragma Assert (Present (E_Id));
|
||||
pragma Assert (Present (Raised_Id));
|
||||
|
||||
-- Generate:
|
||||
-- Exception_Identity (Get_Current_Excep.all.all) =
|
||||
-- Standard'Abort_Signal'Identity;
|
||||
|
||||
if Abort_Allowed then
|
||||
A_Expr :=
|
||||
Make_Op_Eq (Loc,
|
||||
Left_Opnd =>
|
||||
Make_Function_Call (Loc,
|
||||
Name =>
|
||||
New_Reference_To (RTE (RE_Exception_Identity), Loc),
|
||||
Parameter_Associations => New_List (
|
||||
Make_Explicit_Dereference (Loc,
|
||||
Prefix =>
|
||||
Make_Function_Call (Loc,
|
||||
Name =>
|
||||
Make_Explicit_Dereference (Loc,
|
||||
Prefix =>
|
||||
New_Reference_To
|
||||
(RTE (RE_Get_Current_Excep), Loc)))))),
|
||||
|
||||
Right_Opnd =>
|
||||
Make_Attribute_Reference (Loc,
|
||||
Prefix =>
|
||||
New_Reference_To (Stand.Abort_Signal, Loc),
|
||||
Attribute_Name => Name_Identity));
|
||||
else
|
||||
A_Expr := New_Reference_To (Standard_False, Loc);
|
||||
end if;
|
||||
|
||||
-- Generate:
|
||||
-- E_Id : Exception_Occurrence;
|
||||
|
||||
E_Decl :=
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => E_Id,
|
||||
|
@ -2930,13 +2947,30 @@ package body Exp_Ch7 is
|
|||
New_Reference_To (RTE (RE_Exception_Occurrence), Loc));
|
||||
Set_No_Initialization (E_Decl);
|
||||
|
||||
return New_List (E_Decl,
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Raised_Id,
|
||||
Object_Definition =>
|
||||
New_Reference_To (Standard_Boolean, Loc),
|
||||
Expression =>
|
||||
New_Reference_To (Standard_False, Loc)));
|
||||
return
|
||||
New_List (
|
||||
|
||||
-- Abort_Id
|
||||
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Abort_Id,
|
||||
Constant_Present => True,
|
||||
Object_Definition =>
|
||||
New_Reference_To (Standard_Boolean, Loc),
|
||||
Expression => A_Expr),
|
||||
|
||||
-- E_Id
|
||||
|
||||
E_Decl,
|
||||
|
||||
-- Raised_Id
|
||||
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Raised_Id,
|
||||
Object_Definition =>
|
||||
New_Reference_To (Standard_Boolean, Loc),
|
||||
Expression =>
|
||||
New_Reference_To (Standard_False, Loc)));
|
||||
end Build_Object_Declarations;
|
||||
|
||||
---------------------------
|
||||
|
@ -2944,44 +2978,53 @@ package body Exp_Ch7 is
|
|||
---------------------------
|
||||
|
||||
function Build_Raise_Statement
|
||||
(Loc : Source_Ptr;
|
||||
E_Id : Entity_Id;
|
||||
R_Id : Entity_Id) return Node_Id
|
||||
(Loc : Source_Ptr;
|
||||
Abort_Id : Entity_Id;
|
||||
E_Id : Entity_Id;
|
||||
Raised_Id : Entity_Id) return Node_Id
|
||||
is
|
||||
Raise_Id : Entity_Id;
|
||||
Params : List_Id;
|
||||
Proc_Id : Entity_Id;
|
||||
|
||||
begin
|
||||
if VM_Target /= No_VM then
|
||||
Raise_Id := RTE (RE_Reraise_Occurrence);
|
||||
-- The default parameter is the local exception occurrence
|
||||
|
||||
-- Standard run-time library
|
||||
Params := New_List (New_Reference_To (E_Id, Loc));
|
||||
|
||||
-- .NET/JVM
|
||||
|
||||
if VM_Target /= No_VM then
|
||||
Proc_Id := RTE (RE_Reraise_Occurrence);
|
||||
|
||||
-- Standard run-time library, this case handles finalization exceptions
|
||||
-- raised during an abort.
|
||||
|
||||
elsif RTE_Available (RE_Raise_From_Controlled_Operation) then
|
||||
Raise_Id := RTE (RE_Raise_From_Controlled_Operation);
|
||||
Proc_Id := RTE (RE_Raise_From_Controlled_Operation);
|
||||
Append_To (Params, New_Reference_To (Abort_Id, Loc));
|
||||
|
||||
-- Restricted runtime: exception messages are not supported and hence
|
||||
-- Raise_From_Controlled_Operation is not supported.
|
||||
|
||||
else
|
||||
Raise_Id := RTE (RE_Reraise_Occurrence);
|
||||
Proc_Id := RTE (RE_Reraise_Occurrence);
|
||||
end if;
|
||||
|
||||
-- Generate:
|
||||
-- if R_Id then
|
||||
-- <Raise_Id> (E_Id);
|
||||
-- if Raised_Id then
|
||||
-- <Proc_Id> (<Params>);
|
||||
-- end if;
|
||||
|
||||
return
|
||||
Make_If_Statement (Loc,
|
||||
Condition =>
|
||||
New_Reference_To (R_Id, Loc),
|
||||
New_Reference_To (Raised_Id, Loc),
|
||||
|
||||
Then_Statements => New_List (
|
||||
Make_Procedure_Call_Statement (Loc,
|
||||
Name =>
|
||||
New_Reference_To (Raise_Id, Loc),
|
||||
Parameter_Associations => New_List (
|
||||
New_Reference_To (E_Id, Loc)))));
|
||||
New_Reference_To (Proc_Id, Loc),
|
||||
Parameter_Associations => Params)));
|
||||
end Build_Raise_Statement;
|
||||
|
||||
-----------------------------
|
||||
|
@ -4158,9 +4201,9 @@ package body Exp_Ch7 is
|
|||
Last_Object : Node_Id;
|
||||
Related_Node : Node_Id)
|
||||
is
|
||||
Abort_Id : Entity_Id;
|
||||
Built : Boolean := False;
|
||||
Desig : Entity_Id;
|
||||
E_Decl : Node_Id;
|
||||
E_Id : Entity_Id;
|
||||
Fin_Block : Node_Id;
|
||||
Last_Fin : Node_Id := Empty;
|
||||
|
@ -4202,32 +4245,13 @@ package body Exp_Ch7 is
|
|||
-- time around.
|
||||
|
||||
if not Built then
|
||||
|
||||
-- Generate:
|
||||
-- Enn : Exception_Occurrence;
|
||||
|
||||
E_Id := Make_Temporary (Loc, 'E');
|
||||
|
||||
E_Decl :=
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => E_Id,
|
||||
Object_Definition =>
|
||||
New_Reference_To (RTE (RE_Exception_Occurrence), Loc));
|
||||
Set_No_Initialization (E_Decl);
|
||||
Insert_Before_And_Analyze (First_Object, E_Decl);
|
||||
|
||||
-- Generate:
|
||||
-- Rnn : Boolean := False;
|
||||
|
||||
Abort_Id := Make_Temporary (Loc, 'A');
|
||||
E_Id := Make_Temporary (Loc, 'E');
|
||||
Raised_Id := Make_Temporary (Loc, 'R');
|
||||
|
||||
Insert_Before_And_Analyze (First_Object,
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Raised_Id,
|
||||
Object_Definition =>
|
||||
New_Reference_To (Standard_Boolean, Loc),
|
||||
Expression =>
|
||||
New_Reference_To (Standard_False, Loc)));
|
||||
Insert_List_Before_And_Analyze (First_Object,
|
||||
Build_Object_Declarations
|
||||
(Loc, Abort_Id, E_Id, Raised_Id));
|
||||
|
||||
Built := True;
|
||||
end if;
|
||||
|
@ -4292,14 +4316,14 @@ package body Exp_Ch7 is
|
|||
|
||||
-- Generate:
|
||||
-- if Rnn then
|
||||
-- Raise_From_Controlled_Operation (Enn);
|
||||
-- Raise_From_Controlled_Operation (E, Abort);
|
||||
-- end if;
|
||||
|
||||
if Built
|
||||
and then Present (Last_Fin)
|
||||
then
|
||||
Insert_After_And_Analyze (Last_Fin,
|
||||
Build_Raise_Statement (Loc, E_Id, Raised_Id));
|
||||
Build_Raise_Statement (Loc, Abort_Id, E_Id, Raised_Id));
|
||||
end if;
|
||||
end Process_Transient_Objects;
|
||||
|
||||
|
@ -4576,6 +4600,12 @@ package body Exp_Ch7 is
|
|||
-- controlled elements. Generate:
|
||||
|
||||
-- declare
|
||||
-- Abort : constant Boolean :=
|
||||
-- Exception_Identity (Get_Current_Excep.all) =
|
||||
-- Standard'Abort_Signal'Identity;
|
||||
-- <or>
|
||||
-- Abort : constant Boolean := False; -- no abort
|
||||
|
||||
-- E : Exception_Occurrence;
|
||||
-- Raised : Boolean := False;
|
||||
|
||||
|
@ -4599,7 +4629,7 @@ package body Exp_Ch7 is
|
|||
-- end loop;
|
||||
|
||||
-- if Raised then
|
||||
-- Raise_From_Controlled_Operation (E);
|
||||
-- Raise_From_Controlled_Operation (E, Abort);
|
||||
-- end if;
|
||||
-- end;
|
||||
|
||||
|
@ -4623,6 +4653,11 @@ package body Exp_Ch7 is
|
|||
-- exception
|
||||
-- when others =>
|
||||
-- declare
|
||||
-- Abort : constant Boolean :=
|
||||
-- Exception_Identity (Get_Current_Excep.all) =
|
||||
-- Standard'Abort_Signal'Identity;
|
||||
-- <or>
|
||||
-- Abort : constant Boolean := False; -- no abort
|
||||
-- E : Exception_Occurence;
|
||||
-- Raised : Boolean := False;
|
||||
|
||||
|
@ -4657,7 +4692,7 @@ package body Exp_Ch7 is
|
|||
-- end;
|
||||
|
||||
-- if Raised then
|
||||
-- Raise_From_Controlled_Operation (E);
|
||||
-- Raise_From_Controlled_Operation (E, Abort);
|
||||
-- end if;
|
||||
|
||||
-- raise;
|
||||
|
@ -4683,6 +4718,7 @@ package body Exp_Ch7 is
|
|||
Index_List : constant List_Id := New_List;
|
||||
Loc : constant Source_Ptr := Sloc (Typ);
|
||||
Num_Dims : constant Int := Number_Dimensions (Typ);
|
||||
Abort_Id : Entity_Id := Empty;
|
||||
Call : Node_Id;
|
||||
Comp_Ref : Node_Id;
|
||||
Core_Loop : Node_Id;
|
||||
|
@ -4720,6 +4756,7 @@ package body Exp_Ch7 is
|
|||
Build_Indices;
|
||||
|
||||
if Exceptions_OK then
|
||||
Abort_Id := Make_Temporary (Loc, 'A');
|
||||
E_Id := Make_Temporary (Loc, 'E');
|
||||
Raised_Id := Make_Temporary (Loc, 'R');
|
||||
end if;
|
||||
|
@ -4819,9 +4856,16 @@ package body Exp_Ch7 is
|
|||
end loop;
|
||||
|
||||
-- Generate the block which contains the core loop, the declarations
|
||||
-- of the flag and exception occurrence and the conditional raise:
|
||||
-- of the abort flag, the exception occurrence, the raised flag and
|
||||
-- the conditional raise:
|
||||
|
||||
-- declare
|
||||
-- Abort : constant Boolean :=
|
||||
-- Exception_Occurrence (Get_Current_Excep.all.all) =
|
||||
-- Standard'Abort_Signal'Identity;
|
||||
-- <or>
|
||||
-- Abort : constant Boolean := False; -- no abort
|
||||
|
||||
-- E : Exception_Occurrence;
|
||||
-- Raised : Boolean := False;
|
||||
|
||||
|
@ -4829,21 +4873,22 @@ package body Exp_Ch7 is
|
|||
-- <core loop>
|
||||
|
||||
-- if Raised then -- Expection handlers allowed
|
||||
-- Raise_From_Controlled_Operation (E);
|
||||
-- Raise_From_Controlled_Operation (E, Abort);
|
||||
-- end if;
|
||||
-- end;
|
||||
|
||||
Stmts := New_List (Core_Loop);
|
||||
|
||||
if Exceptions_OK then
|
||||
Append_To (Stmts, Build_Raise_Statement (Loc, E_Id, Raised_Id));
|
||||
Append_To (Stmts,
|
||||
Build_Raise_Statement (Loc, Abort_Id, E_Id, Raised_Id));
|
||||
end if;
|
||||
|
||||
return
|
||||
New_List (
|
||||
Make_Block_Statement (Loc,
|
||||
Declarations =>
|
||||
Build_Object_Declarations (Loc, E_Id, Raised_Id),
|
||||
Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id),
|
||||
Handled_Statement_Sequence =>
|
||||
Make_Handled_Sequence_Of_Statements (Loc,
|
||||
Statements => Stmts)));
|
||||
|
@ -4859,6 +4904,7 @@ package body Exp_Ch7 is
|
|||
Index_List : constant List_Id := New_List;
|
||||
Loc : constant Source_Ptr := Sloc (Typ);
|
||||
Num_Dims : constant Int := Number_Dimensions (Typ);
|
||||
Abort_Id : Entity_Id;
|
||||
Counter_Id : Entity_Id;
|
||||
Dim : Int;
|
||||
E_Id : Entity_Id := Empty;
|
||||
|
@ -5024,6 +5070,7 @@ package body Exp_Ch7 is
|
|||
Counter_Id := Make_Temporary (Loc, 'C');
|
||||
|
||||
if Exceptions_OK then
|
||||
Abort_Id := Make_Temporary (Loc, 'A');
|
||||
E_Id := Make_Temporary (Loc, 'E');
|
||||
Raised_Id := Make_Temporary (Loc, 'R');
|
||||
end if;
|
||||
|
@ -5125,10 +5172,17 @@ package body Exp_Ch7 is
|
|||
Dim := Dim - 1;
|
||||
end loop;
|
||||
|
||||
-- Generate the block which houses the finalization failure flag,
|
||||
-- all the finalization loops and the exception raise.
|
||||
-- Generate the block which contains the finalization loops, the
|
||||
-- declarations of the abort flag, the exception occurrence, the
|
||||
-- raised flag and the conditional raise.
|
||||
|
||||
-- declare
|
||||
-- Abort : constant Boolean :=
|
||||
-- Exception_Occurrence (Get_Current_Excep.all.all) =
|
||||
-- Standard'Abort_Signal'Identity;
|
||||
-- <or>
|
||||
-- Abort : constant Boolean := False; -- no abort
|
||||
|
||||
-- E : Exception_Occurrence;
|
||||
-- Raised : Boolean := False;
|
||||
|
||||
|
@ -5141,7 +5195,7 @@ package body Exp_Ch7 is
|
|||
-- <final loop>
|
||||
|
||||
-- if Raised then -- Exception handlers allowed
|
||||
-- Raise_From_Controlled_Operation (E);
|
||||
-- Raise_From_Controlled_Operation (E, Abort);
|
||||
-- end if;
|
||||
|
||||
-- raise; -- Exception handlers allowed
|
||||
|
@ -5150,14 +5204,15 @@ package body Exp_Ch7 is
|
|||
Stmts := New_List (Build_Counter_Assignment, Final_Loop);
|
||||
|
||||
if Exceptions_OK then
|
||||
Append_To (Stmts, Build_Raise_Statement (Loc, E_Id, Raised_Id));
|
||||
Append_To (Stmts,
|
||||
Build_Raise_Statement (Loc, Abort_Id, E_Id, Raised_Id));
|
||||
Append_To (Stmts, Make_Raise_Statement (Loc));
|
||||
end if;
|
||||
|
||||
Final_Block :=
|
||||
Make_Block_Statement (Loc,
|
||||
Declarations =>
|
||||
Build_Object_Declarations (Loc, E_Id, Raised_Id),
|
||||
Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id),
|
||||
|
||||
Handled_Statement_Sequence =>
|
||||
Make_Handled_Sequence_Of_Statements (Loc,
|
||||
|
@ -5449,7 +5504,7 @@ package body Exp_Ch7 is
|
|||
-- end if;
|
||||
|
||||
-- if Raised then
|
||||
-- Raise_From_Controlled_Object (E);
|
||||
-- Raise_From_Controlled_Object (E, Abort);
|
||||
-- end if;
|
||||
-- end;
|
||||
|
||||
|
@ -5458,6 +5513,11 @@ package body Exp_Ch7 is
|
|||
-- may have discriminants and contain variant parts. Generate:
|
||||
|
||||
-- declare
|
||||
-- Abort : constant Boolean :=
|
||||
-- Exception_Identity (Get_Current_Excep.all) =
|
||||
-- Standard'Abort_Signal'Identity;
|
||||
-- <or>
|
||||
-- Abort : constant Boolean := False; -- no abort
|
||||
-- E : Exception_Occurence;
|
||||
-- Raised : Boolean := False;
|
||||
|
||||
|
@ -5532,7 +5592,7 @@ package body Exp_Ch7 is
|
|||
-- Root_Controlled (V).Finalized := True;
|
||||
|
||||
-- if Raised then
|
||||
-- Raise_From_Controlled_Object (E);
|
||||
-- Raise_From_Controlled_Object (E, Abort);
|
||||
-- end if;
|
||||
-- end;
|
||||
|
||||
|
@ -5555,6 +5615,7 @@ package body Exp_Ch7 is
|
|||
function Build_Adjust_Statements (Typ : Entity_Id) return List_Id is
|
||||
Loc : constant Source_Ptr := Sloc (Typ);
|
||||
Typ_Def : constant Node_Id := Type_Definition (Parent (Typ));
|
||||
Abort_Id : Entity_Id := Empty;
|
||||
Bod_Stmts : List_Id;
|
||||
E_Id : Entity_Id := Empty;
|
||||
Raised_Id : Entity_Id := Empty;
|
||||
|
@ -5765,6 +5826,7 @@ package body Exp_Ch7 is
|
|||
|
||||
begin
|
||||
if Exceptions_OK then
|
||||
Abort_Id := Make_Temporary (Loc, 'A');
|
||||
E_Id := Make_Temporary (Loc, 'E');
|
||||
Raised_Id := Make_Temporary (Loc, 'R');
|
||||
end if;
|
||||
|
@ -5942,6 +6004,12 @@ package body Exp_Ch7 is
|
|||
|
||||
-- Generate:
|
||||
-- declare
|
||||
-- Abort : constant Boolean :=
|
||||
-- Exception_Occurrence (Get_Current_Excep.all.all) =
|
||||
-- Standard'Abort_Signal'Identity;
|
||||
-- <or>
|
||||
-- Abort : constant Boolean := False; -- no abort
|
||||
|
||||
-- E : Exception_Occurence;
|
||||
-- Raised : Boolean := False;
|
||||
|
||||
|
@ -5951,21 +6019,21 @@ package body Exp_Ch7 is
|
|||
-- <adjust statements>
|
||||
|
||||
-- if Raised then
|
||||
-- Raise_From_Controlled_Operation (E);
|
||||
-- Raise_From_Controlled_Operation (E, Abort);
|
||||
-- end if;
|
||||
-- end;
|
||||
|
||||
else
|
||||
if Exceptions_OK then
|
||||
Append_To (Bod_Stmts,
|
||||
Build_Raise_Statement (Loc, E_Id, Raised_Id));
|
||||
Build_Raise_Statement (Loc, Abort_Id, E_Id, Raised_Id));
|
||||
end if;
|
||||
|
||||
return
|
||||
New_List (
|
||||
Make_Block_Statement (Loc,
|
||||
Declarations =>
|
||||
Build_Object_Declarations (Loc, E_Id, Raised_Id),
|
||||
Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id),
|
||||
|
||||
Handled_Statement_Sequence =>
|
||||
Make_Handled_Sequence_Of_Statements (Loc,
|
||||
|
@ -5980,6 +6048,7 @@ package body Exp_Ch7 is
|
|||
function Build_Finalize_Statements (Typ : Entity_Id) return List_Id is
|
||||
Loc : constant Source_Ptr := Sloc (Typ);
|
||||
Typ_Def : constant Node_Id := Type_Definition (Parent (Typ));
|
||||
Abort_Id : Entity_Id := Empty;
|
||||
Bod_Stmts : List_Id;
|
||||
Counter : Int := 0;
|
||||
E_Id : Entity_Id := Empty;
|
||||
|
@ -6358,6 +6427,7 @@ package body Exp_Ch7 is
|
|||
|
||||
begin
|
||||
if Exceptions_OK then
|
||||
Abort_Id := Make_Temporary (Loc, 'A');
|
||||
E_Id := Make_Temporary (Loc, 'E');
|
||||
Raised_Id := Make_Temporary (Loc, 'R');
|
||||
end if;
|
||||
|
@ -6535,6 +6605,12 @@ package body Exp_Ch7 is
|
|||
|
||||
-- Generate:
|
||||
-- declare
|
||||
-- Abort : constant Boolean :=
|
||||
-- Exception_Occurrence (Get_Current_Excep.all.all) =
|
||||
-- Standard'Abort_Signal'Identity;
|
||||
-- <or>
|
||||
-- Abort : constant Boolean := False; -- no abort
|
||||
|
||||
-- E : Exception_Occurence;
|
||||
-- Raised : Boolean := False;
|
||||
|
||||
|
@ -6547,21 +6623,21 @@ package body Exp_Ch7 is
|
|||
-- V.Finalized := True;
|
||||
|
||||
-- if Raised then
|
||||
-- Raise_From_Controlled_Operation (E);
|
||||
-- Raise_From_Controlled_Operation (E, Abort);
|
||||
-- end if;
|
||||
-- end;
|
||||
|
||||
else
|
||||
if Exceptions_OK then
|
||||
Append_To (Bod_Stmts,
|
||||
Build_Raise_Statement (Loc, E_Id, Raised_Id));
|
||||
Build_Raise_Statement (Loc, Abort_Id, E_Id, Raised_Id));
|
||||
end if;
|
||||
|
||||
return
|
||||
New_List (
|
||||
Make_Block_Statement (Loc,
|
||||
Declarations =>
|
||||
Build_Object_Declarations (Loc, E_Id, Raised_Id),
|
||||
Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id),
|
||||
|
||||
Handled_Statement_Sequence =>
|
||||
Make_Handled_Sequence_Of_Statements (Loc,
|
||||
|
@ -7110,7 +7186,7 @@ package body Exp_Ch7 is
|
|||
-- Generate:
|
||||
|
||||
-- when E : others =>
|
||||
-- Raise_From_Controlled_Operation (X => E);
|
||||
-- Raise_From_Controlled_Operation (E, False);
|
||||
|
||||
-- or:
|
||||
|
||||
|
@ -7150,10 +7226,11 @@ package body Exp_Ch7 is
|
|||
Raise_Node :=
|
||||
Make_Procedure_Call_Statement (Loc,
|
||||
Name =>
|
||||
New_Reference_To (
|
||||
RTE (RE_Raise_From_Controlled_Operation), Loc),
|
||||
New_Reference_To
|
||||
(RTE (RE_Raise_From_Controlled_Operation), Loc),
|
||||
Parameter_Associations => New_List (
|
||||
New_Reference_To (E_Occ, Loc)));
|
||||
New_Reference_To (E_Occ, Loc),
|
||||
New_Reference_To (Standard_False, Loc)));
|
||||
|
||||
-- Restricted runtime: exception messages are not supported
|
||||
|
||||
|
|
|
@ -57,19 +57,39 @@ package Exp_Ch7 is
|
|||
-- Build one controlling procedure when a late body overrides one of
|
||||
-- the controlling operations.
|
||||
|
||||
function Build_Object_Declarations
|
||||
(Loc : Source_Ptr;
|
||||
Abort_Id : Entity_Id;
|
||||
E_Id : Entity_Id;
|
||||
Raised_Id : Entity_Id) return List_Id;
|
||||
-- Subsidiary to Make_Deep_Array_Body and Make_Deep_Record_Body. Return a
|
||||
-- list containing the object declarations of boolean flag Abort_Id, the
|
||||
-- exception occurrence E_Id and boolean flag Raised_Id.
|
||||
--
|
||||
-- Abort_Id : constant Boolean :=
|
||||
-- Exception_Identity (Get_Current_Excep.all) =
|
||||
-- Standard'Abort_Signal'Identity;
|
||||
-- <or>
|
||||
-- Abort_Id : constant Boolean := False; -- no abort
|
||||
--
|
||||
-- E_Id : Exception_Occurrence;
|
||||
-- Raised_Id : Boolean := False;
|
||||
|
||||
function Build_Raise_Statement
|
||||
(Loc : Source_Ptr;
|
||||
E_Id : Entity_Id;
|
||||
R_Id : Entity_Id) return Node_Id;
|
||||
(Loc : Source_Ptr;
|
||||
Abort_Id : Entity_Id;
|
||||
E_Id : Entity_Id;
|
||||
Raised_Id : Entity_Id) return Node_Id;
|
||||
-- Subsidiary to routines Build_Finalizer, Make_Deep_Array_Body and Make_
|
||||
-- Deep_Record_Body. Generate the following conditional raise statement:
|
||||
--
|
||||
-- if R_Id then
|
||||
-- Raise_From_Controlled_Operation (E_Id);
|
||||
-- if Raised_Id then
|
||||
-- Raise_From_Controlled_Operation (E_Id, Abort_Id);
|
||||
-- end if;
|
||||
--
|
||||
-- E_Id denotes the defining identifier of a local exception occurrence,
|
||||
-- R_Id is the entity of a local boolean flag.
|
||||
-- Abort_Id is a local boolean flag which is set when the finalization was
|
||||
-- triggered by an abort, E_Id denotes the defining identifier of a local
|
||||
-- exception occurrence, Raised_Id is the entity of a local boolean flag.
|
||||
|
||||
function CW_Or_Has_Controlled_Part (T : Entity_Id) return Boolean;
|
||||
-- True if T is a class-wide type, or if it has controlled parts ("part"
|
||||
|
|
|
@ -884,16 +884,15 @@ package body Exp_Intr is
|
|||
Pool : constant Entity_Id := Associated_Storage_Pool (Rtyp);
|
||||
Stmts : constant List_Id := New_List;
|
||||
|
||||
Blk : Node_Id := Empty;
|
||||
Deref : Node_Id;
|
||||
Exc_Occ_Decl : Node_Id;
|
||||
Exc_Occ_Id : Entity_Id := Empty;
|
||||
Final_Code : List_Id;
|
||||
Free_Arg : Node_Id;
|
||||
Free_Node : Node_Id;
|
||||
Gen_Code : Node_Id;
|
||||
Raised_Decl : Node_Id;
|
||||
Raised_Id : Entity_Id := Empty;
|
||||
Abort_Id : Entity_Id := Empty;
|
||||
Blk : Node_Id := Empty;
|
||||
Deref : Node_Id;
|
||||
E_Id : Entity_Id := Empty;
|
||||
Final_Code : List_Id;
|
||||
Free_Arg : Node_Id;
|
||||
Free_Node : Node_Id;
|
||||
Gen_Code : Node_Id;
|
||||
Raised_Id : Entity_Id := Empty;
|
||||
|
||||
Arg_Known_Non_Null : constant Boolean := Known_Non_Null (N);
|
||||
-- This captures whether we know the argument to be non-null so that
|
||||
|
@ -942,38 +941,29 @@ package body Exp_Intr is
|
|||
-- the later raise.
|
||||
--
|
||||
-- Generate:
|
||||
-- Raised : Boolean := False;
|
||||
-- Exc_Occ : Exception_Occurrence;
|
||||
-- Abort : constant Boolean :=
|
||||
-- Exception_Occurrence (Get_Current_Excep.all.all) =
|
||||
-- Standard'Abort_Signal'Identity;
|
||||
-- <or>
|
||||
-- Abort : constant Boolean := False; -- no abort
|
||||
|
||||
-- E : Exception_Occurrence;
|
||||
-- Raised : Boolean := False;
|
||||
--
|
||||
-- begin
|
||||
-- [Deep_]Finalize (Obj);
|
||||
-- exception
|
||||
-- when others =>
|
||||
-- Raised := True;
|
||||
-- Save_Occurrence (Exc_Occ, Get_Current_Excep.all.all);
|
||||
-- Save_Occurrence (E, Get_Current_Excep.all.all);
|
||||
-- end;
|
||||
|
||||
Exc_Occ_Id := Make_Temporary (Loc, 'E');
|
||||
Raised_Id := Make_Temporary (Loc, 'R');
|
||||
Abort_Id := Make_Temporary (Loc, 'A');
|
||||
E_Id := Make_Temporary (Loc, 'E');
|
||||
Raised_Id := Make_Temporary (Loc, 'R');
|
||||
|
||||
Raised_Decl :=
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Raised_Id,
|
||||
Object_Definition =>
|
||||
New_Reference_To (Standard_Boolean, Loc),
|
||||
Expression =>
|
||||
New_Reference_To (Standard_False, Loc));
|
||||
|
||||
Append_To (Stmts, Raised_Decl);
|
||||
|
||||
Exc_Occ_Decl :=
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Exc_Occ_Id,
|
||||
Object_Definition =>
|
||||
New_Reference_To (RTE (RE_Exception_Occurrence), Loc));
|
||||
Set_No_Initialization (Exc_Occ_Decl);
|
||||
|
||||
Append_To (Stmts, Exc_Occ_Decl);
|
||||
Append_List_To (Stmts,
|
||||
Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id));
|
||||
|
||||
Final_Code := New_List (
|
||||
Make_Block_Statement (Loc,
|
||||
|
@ -997,7 +987,7 @@ package body Exp_Intr is
|
|||
Name =>
|
||||
New_Reference_To (RTE (RE_Save_Occurrence), Loc),
|
||||
Parameter_Associations => New_List (
|
||||
New_Reference_To (Exc_Occ_Id, Loc),
|
||||
New_Reference_To (E_Id, Loc),
|
||||
Make_Explicit_Dereference (Loc,
|
||||
Prefix =>
|
||||
Make_Function_Call (Loc,
|
||||
|
@ -1243,14 +1233,15 @@ package body Exp_Intr is
|
|||
--
|
||||
-- Generate:
|
||||
-- if Raised then
|
||||
-- Reraise_Occurrence (Exc_Occ); -- for .NET and
|
||||
-- -- restricted RTS
|
||||
-- Reraise_Occurrence (E); -- for .NET and
|
||||
-- -- restricted RTS
|
||||
-- <or>
|
||||
-- Raise_From_Controlled_Operation (Exc_Occ); -- all other cases
|
||||
-- Raise_From_Controlled_Operation (E, Abort); -- all other cases
|
||||
-- end if;
|
||||
|
||||
if Present (Raised_Id) then
|
||||
Append_To (Stmts, Build_Raise_Statement (Loc, Exc_Occ_Id, Raised_Id));
|
||||
Append_To (Stmts,
|
||||
Build_Raise_Statement (Loc, Abort_Id, E_Id, Raised_Id));
|
||||
end if;
|
||||
|
||||
-- If we know the argument is non-null, then make a block statement
|
||||
|
|
|
@ -461,8 +461,7 @@ package body Lib.Writ is
|
|||
Write_Info_Str (" O");
|
||||
Write_Info_Char (OA_Setting (Unit_Num));
|
||||
|
||||
if (Ekind (Uent) = E_Package
|
||||
or else Ekind (Uent) = E_Package_Body)
|
||||
if Ekind_In (Uent, E_Package, E_Package_Body)
|
||||
and then Present (Finalizer (Uent))
|
||||
then
|
||||
Write_Info_Str (" PF");
|
||||
|
|
|
@ -2313,8 +2313,8 @@ package body Make is
|
|||
new String'(Name_Buffer (1 .. Name_Len));
|
||||
Test_If_Relative_Path
|
||||
(New_Args (Last_New),
|
||||
Do_Fail => Make_Failed'Access,
|
||||
Parent => Dir_Path,
|
||||
Do_Fail => Make_Failed'Access,
|
||||
Parent => Dir_Path,
|
||||
Including_Non_Switch => False);
|
||||
end if;
|
||||
|
||||
|
@ -2322,10 +2322,9 @@ package body Make is
|
|||
end loop;
|
||||
|
||||
Add_Arguments
|
||||
(Configuration_Pragmas_Switch
|
||||
(Arguments_Project) &
|
||||
New_Args (1 .. Last_New) &
|
||||
The_Saved_Gcc_Switches.all);
|
||||
(Configuration_Pragmas_Switch (Arguments_Project)
|
||||
& New_Args (1 .. Last_New)
|
||||
& The_Saved_Gcc_Switches.all);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
@ -2341,8 +2340,8 @@ package body Make is
|
|||
(Name_Buffer (1 .. Name_Len)));
|
||||
Dir_Path : constant String :=
|
||||
Get_Name_String
|
||||
(Arguments_Project.
|
||||
Directory.Display_Name);
|
||||
(Arguments_Project.
|
||||
Directory.Display_Name);
|
||||
|
||||
begin
|
||||
Test_If_Relative_Path
|
||||
|
@ -2687,11 +2686,11 @@ package body Make is
|
|||
|
||||
if Add_It then
|
||||
if not Queue.Insert
|
||||
((Format => Format_Gnatmake,
|
||||
File => Sfile,
|
||||
Unit => No_Unit_Name,
|
||||
Project => No_Project,
|
||||
Index => 0))
|
||||
((Format => Format_Gnatmake,
|
||||
File => Sfile,
|
||||
Unit => No_Unit_Name,
|
||||
Project => No_Project,
|
||||
Index => 0))
|
||||
then
|
||||
if Is_In_Obsoleted (Sfile) then
|
||||
Executable_Obsolete := True;
|
||||
|
@ -5901,10 +5900,10 @@ package body Make is
|
|||
-- except those of library projects.
|
||||
|
||||
Prj.Env.Set_Ada_Paths
|
||||
(Project => Main_Project,
|
||||
In_Tree => Project_Tree,
|
||||
(Project => Main_Project,
|
||||
In_Tree => Project_Tree,
|
||||
Including_Libraries => False,
|
||||
Include_Path => Use_Include_Path_File);
|
||||
Include_Path => Use_Include_Path_File);
|
||||
|
||||
-- If switch -C was specified, create a binder mapping file
|
||||
|
||||
|
@ -6051,9 +6050,9 @@ package body Make is
|
|||
Linker_Switches.Increment_Last;
|
||||
Linker_Switches.Table (Linker_Switches.Last) :=
|
||||
new String'("-l" &
|
||||
Get_Name_String
|
||||
(Library_Projs.Table (Index).
|
||||
Library_Name));
|
||||
Get_Name_String
|
||||
(Library_Projs.Table (Index).
|
||||
Library_Name));
|
||||
end if;
|
||||
end if;
|
||||
end loop;
|
||||
|
@ -6421,22 +6420,23 @@ package body Make is
|
|||
Test_If_Relative_Path
|
||||
(Binder_Switches.Table (J),
|
||||
Do_Fail => Make_Failed'Access,
|
||||
Parent => Dir_Path, Including_L_Switch => False);
|
||||
Parent => Dir_Path, Including_L_Switch => False);
|
||||
end loop;
|
||||
|
||||
for
|
||||
J in Last_Linker_Switch + 1 .. Linker_Switches.Last
|
||||
loop
|
||||
Test_If_Relative_Path
|
||||
(Linker_Switches.Table (J), Parent => Dir_Path,
|
||||
(Linker_Switches.Table (J),
|
||||
Parent => Dir_Path,
|
||||
Do_Fail => Make_Failed'Access);
|
||||
end loop;
|
||||
end;
|
||||
|
||||
-- We now put in the Binder_Switches and Linker_Switches
|
||||
-- tables, the binder and linker switches of the command
|
||||
-- line that have been put in the Saved_ tables.
|
||||
-- These switches will follow the project file switches.
|
||||
-- line that have been put in the Saved_ tables. These
|
||||
-- switches will follow the project file switches.
|
||||
|
||||
for J in 1 .. Saved_Binder_Switches.Last loop
|
||||
Add_Switch
|
||||
|
@ -6461,6 +6461,7 @@ package body Make is
|
|||
if Do_Codepeer_Globalize_Step then
|
||||
declare
|
||||
Success : Boolean := False;
|
||||
|
||||
begin
|
||||
Globalize (Success);
|
||||
|
||||
|
@ -6732,7 +6733,8 @@ package body Make is
|
|||
-- Test for trailing -D switch
|
||||
|
||||
elsif Object_Directory_Present
|
||||
and then not Object_Directory_Seen then
|
||||
and then not Object_Directory_Seen
|
||||
then
|
||||
Make_Failed ("object directory missing after -D");
|
||||
end if;
|
||||
|
||||
|
@ -7382,6 +7384,7 @@ package body Make is
|
|||
for Next_Arg in 1 .. Argument_Count loop
|
||||
declare
|
||||
Argv : constant String := Argument (Next_Arg);
|
||||
|
||||
begin
|
||||
if Argv'Length > 2
|
||||
and then Argv (1) = '-'
|
||||
|
@ -7678,8 +7681,8 @@ package body Make is
|
|||
|
||||
elsif Program_Args /= None then
|
||||
|
||||
-- Check to see if we are reading -I switches in order
|
||||
-- to take into account in the src & lib search directories.
|
||||
-- Check to see if we are reading -I switches in order to take into
|
||||
-- account in the src & lib search directories.
|
||||
|
||||
if Argv'Length > 2 and then Argv (1 .. 2) = "-I" then
|
||||
if Argv (3 .. Argv'Last) = "-" then
|
||||
|
|
|
@ -180,8 +180,8 @@ package body Makeutl is
|
|||
------------------------------
|
||||
|
||||
function Check_Source_Info_In_ALI
|
||||
(The_ALI : ALI_Id;
|
||||
Tree : Project_Tree_Ref) return Boolean
|
||||
(The_ALI : ALI_Id;
|
||||
Tree : Project_Tree_Ref) return Boolean
|
||||
is
|
||||
Unit_Name : Name_Id;
|
||||
|
||||
|
@ -943,8 +943,8 @@ package body Makeutl is
|
|||
-- paths must be converted to absolute paths.
|
||||
|
||||
Test_If_Relative_Path
|
||||
(Switch => Linker_Options_Buffer (Last_Linker_Option),
|
||||
Parent => Dir_Path,
|
||||
(Switch => Linker_Options_Buffer (Last_Linker_Option),
|
||||
Parent => Dir_Path,
|
||||
Do_Fail => Do_Fail,
|
||||
Including_L_Switch => True);
|
||||
end if;
|
||||
|
@ -1498,7 +1498,8 @@ package body Makeutl is
|
|||
|
||||
procedure Extract
|
||||
(Found : out Boolean;
|
||||
Source : out Source_Info) is
|
||||
Source : out Source_Info)
|
||||
is
|
||||
begin
|
||||
Found := False;
|
||||
|
||||
|
@ -1565,7 +1566,8 @@ package body Makeutl is
|
|||
|
||||
procedure Initialize
|
||||
(Queue_Per_Obj_Dir : Boolean;
|
||||
Force : Boolean := False) is
|
||||
Force : Boolean := False)
|
||||
is
|
||||
begin
|
||||
if Force or else not Q_Initialized then
|
||||
Q_Initialized := True;
|
||||
|
@ -1630,10 +1632,10 @@ package body Makeutl is
|
|||
------------
|
||||
|
||||
procedure Insert (Source : Source_Info) is
|
||||
Tmp : Boolean;
|
||||
pragma Unreferenced (Tmp);
|
||||
Discard : Boolean;
|
||||
pragma Unreferenced (Discard);
|
||||
begin
|
||||
Tmp := Insert (Source);
|
||||
Discard := Insert (Source);
|
||||
end Insert;
|
||||
|
||||
--------------
|
||||
|
|
|
@ -28,12 +28,13 @@
|
|||
-- queue management.
|
||||
|
||||
with ALI;
|
||||
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
||||
with Namet; use Namet;
|
||||
with Namet; use Namet;
|
||||
with Opt;
|
||||
with Prj; use Prj;
|
||||
with Prj; use Prj;
|
||||
with Prj.Tree;
|
||||
with Types; use Types;
|
||||
with Types; use Types;
|
||||
|
||||
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
||||
|
||||
package Makeutl is
|
||||
|
||||
|
@ -192,13 +193,12 @@ package Makeutl is
|
|||
Including_L_Switch : Boolean := True;
|
||||
Including_Non_Switch : Boolean := True;
|
||||
Including_RTS : Boolean := False);
|
||||
-- Test if Switch is a relative search path switch. If it is, fail if
|
||||
-- Parent is the empty string, otherwise prepend the path with Parent.
|
||||
-- This subprogram is only called when using project files. For gnatbind
|
||||
-- switches, Including_L_Switch is False, because the argument of the -L
|
||||
-- switch is not a path. If Including_RTS is True, process also switches
|
||||
-- --RTS=.
|
||||
-- Do_Fail is called in case of error. Using Osing.Fail might be
|
||||
-- Test if Switch is a relative search path switch. If so, fail if Parent
|
||||
-- is the empty string, otherwise prepend the path with Parent. This
|
||||
-- subprogram is only used when using project files. For gnatbind switches,
|
||||
-- Including_L_Switch is False, because the argument of the -L switch is
|
||||
-- not a path. If Including_RTS is True, process also switches --RTS=.
|
||||
-- Do_Fail is called in case of error. Using Osint.Fail might be
|
||||
-- appropriate.
|
||||
|
||||
function Path_Or_File_Name (Path : Path_Name_Type) return String;
|
||||
|
|
|
@ -911,15 +911,14 @@ package body Prj is
|
|||
begin
|
||||
if Tree /= null then
|
||||
if Tree.Is_Root_Tree then
|
||||
Name_List_Table.Free (Tree.Shared.Name_Lists);
|
||||
Number_List_Table.Free (Tree.Shared.Number_Lists);
|
||||
String_Element_Table.Free (Tree.Shared.String_Elements);
|
||||
Name_List_Table.Free (Tree.Shared.Name_Lists);
|
||||
Number_List_Table.Free (Tree.Shared.Number_Lists);
|
||||
String_Element_Table.Free (Tree.Shared.String_Elements);
|
||||
Variable_Element_Table.Free (Tree.Shared.Variable_Elements);
|
||||
Array_Element_Table.Free (Tree.Shared.Array_Elements);
|
||||
Array_Table.Free (Tree.Shared.Arrays);
|
||||
Package_Table.Free (Tree.Shared.Packages);
|
||||
|
||||
Temp_Files_Table.Free (Tree.Shared.Private_Part.Temp_Files);
|
||||
Array_Element_Table.Free (Tree.Shared.Array_Elements);
|
||||
Array_Table.Free (Tree.Shared.Arrays);
|
||||
Package_Table.Free (Tree.Shared.Packages);
|
||||
Temp_Files_Table.Free (Tree.Shared.Private_Part.Temp_Files);
|
||||
end if;
|
||||
|
||||
Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
|
||||
|
|
|
@ -1409,7 +1409,6 @@ package Prj is
|
|||
Array_Elements : Array_Element_Table.Instance;
|
||||
Arrays : Array_Table.Instance;
|
||||
Packages : Package_Table.Instance;
|
||||
|
||||
Private_Part : Private_Project_Tree_Data;
|
||||
end record;
|
||||
type Shared_Project_Tree_Data_Access is access all Shared_Project_Tree_Data;
|
||||
|
|
|
@ -112,7 +112,7 @@ package Rtsfind is
|
|||
-- package see declarations in the runtime entity table below.
|
||||
|
||||
RTU_Null,
|
||||
-- Used as a null entry. Will cause an error if referenced.
|
||||
-- Used as a null entry (will cause an error if referenced)
|
||||
|
||||
-- Children of Ada
|
||||
|
||||
|
|
|
@ -62,7 +62,7 @@ package System.Soft_Links is
|
|||
pragma Suppress_Initialization (No_Param_Proc);
|
||||
-- Some uninitialized objects of that type are initialized by the Binder
|
||||
-- so it is important that such objects are not reset to null during
|
||||
-- elaboration
|
||||
-- elaboration.
|
||||
|
||||
type Addr_Param_Proc is access procedure (Addr : Address);
|
||||
pragma Favor_Top_Level (Addr_Param_Proc);
|
||||
|
@ -226,7 +226,7 @@ package System.Soft_Links is
|
|||
Finalize_Library_Objects : No_Param_Proc;
|
||||
pragma Export (C, Finalize_Library_Objects,
|
||||
"__gnat_finalize_library_objects");
|
||||
-- will be initialized by the binder
|
||||
-- Will be initialized by the binder
|
||||
|
||||
Adafinal : No_Param_Proc := Adafinal_NT'Access;
|
||||
-- Performs the finalization of the Ada Runtime
|
||||
|
|
|
@ -2011,10 +2011,10 @@ package body System.Tasking.Stages is
|
|||
-- Package elaboration code
|
||||
|
||||
begin
|
||||
-- Establish the Adafinal oftlink
|
||||
-- Establish the Adafinal softlink
|
||||
|
||||
-- This is not done inside the central RTS initialization routine
|
||||
-- to avoid with-ing this package from System.Tasking.Initialization.
|
||||
-- to avoid with'ing this package from System.Tasking.Initialization.
|
||||
|
||||
SSL.Adafinal := Finalize_Global_Tasks'Access;
|
||||
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-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- --
|
||||
|
@ -964,6 +964,12 @@ package body Sem_Eval is
|
|||
return Unknown;
|
||||
end if;
|
||||
end if;
|
||||
else
|
||||
|
||||
-- If the range of either operand cannot be determined,
|
||||
-- nothing further can be inferred.
|
||||
|
||||
return Unknown;
|
||||
end if;
|
||||
end;
|
||||
|
||||
|
|
|
@ -4760,11 +4760,13 @@ package body Sem_Prag is
|
|||
(Get_Base_Subprogram (Subprogram_Def), Link_Nam);
|
||||
end if;
|
||||
|
||||
-- We allow duplicated export names in CIL, as they are always
|
||||
-- We allow duplicated export names in CIL/Java, as they are always
|
||||
-- enclosed in a namespace that differentiates them, and overloaded
|
||||
-- entities are supported by the VM.
|
||||
|
||||
if Convention (Subprogram_Def) /= Convention_CIL then
|
||||
if Convention (Subprogram_Def) /= Convention_CIL
|
||||
and then Convention (Subprogram_Def) /= Convention_Java
|
||||
then
|
||||
Check_Duplicated_Export_Name (Link_Nam);
|
||||
end if;
|
||||
end Process_Interface_Name;
|
||||
|
|
Loading…
Reference in New Issue