[multiple changes]
2014-07-29 Doug Rupp <rupp@adacore.com> * init.c: Complete previous change. 2014-07-29 Robert Dewar <dewar@adacore.com> * exp_ch4.adb (Expand_N_If_Expression): Deal with unconstrained array case. 2014-07-29 Ed Schonberg <schonberg@adacore.com> * sem_attr.adb (Access_Attribute): If the prefix is a subprogram and the completion will appear in the same declarative part, create elaboration flag. * exp_util.adb (Set_Elaboration_Flag): If the subprogram body is a completion of a declaration in the same declarative part, and the subprogram has had its address taken, add elaboration check inside the subprogram body, to detect elaboration errors that may occur through indirect calls. From-SVN: r213189
This commit is contained in:
Arnaud Charlet
parent
1992616143
commit
113a9fb6c6
|
|
@ -1,3 +1,23 @@
|
|||
2014-07-29 Doug Rupp <rupp@adacore.com>
|
||||
|
||||
* init.c: Complete previous change.
|
||||
|
||||
2014-07-29 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* exp_ch4.adb (Expand_N_If_Expression): Deal with unconstrained
|
||||
array case.
|
||||
|
||||
2014-07-29 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_attr.adb (Access_Attribute): If the prefix is a subprogram
|
||||
and the completion will appear in the same declarative part,
|
||||
create elaboration flag.
|
||||
* exp_util.adb (Set_Elaboration_Flag): If the subprogram body
|
||||
is a completion of a declaration in the same declarative part,
|
||||
and the subprogram has had its address taken, add elaboration
|
||||
check inside the subprogram body, to detect elaboration errors
|
||||
that may occur through indirect calls.
|
||||
|
||||
2014-07-29 Doug Rupp <rupp@adacore.com>
|
||||
|
||||
* sigtramp-armvxw.c: Enhance to handle RTP trampolining.
|
||||
|
|
|
|||
|
|
@ -5278,11 +5278,9 @@ package body Exp_Ch4 is
|
|||
return;
|
||||
end if;
|
||||
|
||||
-- If the type is limited or unconstrained, we expand as follows to
|
||||
-- avoid any possibility of improper copies.
|
||||
|
||||
-- Note: it may be possible to avoid this special processing if the
|
||||
-- back end uses its own mechanisms for handling by-reference types ???
|
||||
-- If the type is limited, and the back end does not handle limited
|
||||
-- types, then we expand as follows to avoid the possibility of
|
||||
-- improper copying.
|
||||
|
||||
-- type Ptr is access all Typ;
|
||||
-- Cnn : Ptr;
|
||||
|
|
@ -5370,6 +5368,38 @@ package body Exp_Ch4 is
|
|||
Make_Explicit_Dereference (Loc,
|
||||
Prefix => New_Occurrence_Of (Cnn, Loc));
|
||||
|
||||
-- If the result is an unconstrained array and the if expression is in a
|
||||
-- context other than the initializing expression of the declaration of
|
||||
-- an object, then we pull out the if expression as follows:
|
||||
|
||||
-- Cnn : constant typ := if-expression
|
||||
|
||||
-- and then replace the if expression with an occurrence of Cnn. This
|
||||
-- avoids the need in the back end to create on-the-fly variable length
|
||||
-- temporaries (which it cannot do!)
|
||||
|
||||
-- Note that the test for being in an object declaration avoids doing an
|
||||
-- unnecessary expansion, and also avoids infinite recursion.
|
||||
|
||||
elsif Is_Array_Type (Typ) and then not Is_Constrained (Typ)
|
||||
and then (Nkind (Parent (N)) /= N_Object_Declaration
|
||||
or else Expression (Parent (N)) /= N)
|
||||
then
|
||||
declare
|
||||
Cnn : constant Node_Id := Make_Temporary (Loc, 'C', N);
|
||||
begin
|
||||
Insert_Action (N,
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Cnn,
|
||||
Constant_Present => True,
|
||||
Object_Definition => New_Occurrence_Of (Typ, Loc),
|
||||
Expression => Relocate_Node (N),
|
||||
Has_Init_Expression => True));
|
||||
|
||||
Rewrite (N, New_Occurrence_Of (Cnn, Loc));
|
||||
return;
|
||||
end;
|
||||
|
||||
-- For other types, we only need to expand if there are other actions
|
||||
-- associated with either branch.
|
||||
|
||||
|
|
|
|||
|
|
@ -7920,6 +7920,50 @@ package body Exp_Util is
|
|||
-- pick up bogus indications of the wrong constant value.
|
||||
|
||||
Set_Current_Value (Ent, Empty);
|
||||
|
||||
-- If the subprogram is in the current declarative part and
|
||||
-- 'access has been applied to it, generate an elaboration
|
||||
-- check at the beginning of the declarations of the body.
|
||||
|
||||
if Nkind (N) = N_Subprogram_Body
|
||||
and then Address_Taken (Spec_Id)
|
||||
and then
|
||||
Ekind_In (Scope (Spec_Id), E_Block, E_Procedure, E_Function)
|
||||
then
|
||||
declare
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
Decls : constant List_Id := Declarations (N);
|
||||
Chk : Node_Id;
|
||||
|
||||
begin
|
||||
-- No need to generate this check if first entry in the
|
||||
-- declaration list is a raise of Program_Error now.
|
||||
|
||||
if Present (Decls)
|
||||
and then Nkind (First (Decls)) = N_Raise_Program_Error
|
||||
then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Otherwise generate the check
|
||||
|
||||
Chk :=
|
||||
Make_Raise_Program_Error (Loc,
|
||||
Condition =>
|
||||
Make_Op_Eq (Loc,
|
||||
Left_Opnd => New_Occurrence_Of (Ent, Loc),
|
||||
Right_Opnd => Make_Integer_Literal (Loc, Uint_0)),
|
||||
Reason => PE_Access_Before_Elaboration);
|
||||
|
||||
if No (Decls) then
|
||||
Set_Declarations (N, New_List (Chk));
|
||||
else
|
||||
Prepend (Chk, Decls);
|
||||
end if;
|
||||
|
||||
Analyze (Chk);
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end Set_Elaboration_Flag;
|
||||
|
|
|
|||
|
|
@ -1703,9 +1703,7 @@ __gnat_install_handler ()
|
|||
#include <signal.h>
|
||||
#include <taskLib.h>
|
||||
|
||||
#ifdef __RTP__
|
||||
#include <base/b_ucontext_t.h>
|
||||
#else
|
||||
#ifndef __RTP__
|
||||
#include <intLib.h>
|
||||
#include <iv.h>
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -10568,6 +10568,49 @@ package body Sem_Attr is
|
|||
if Is_Entity_Name (P) then
|
||||
Set_Address_Taken (Entity (P));
|
||||
end if;
|
||||
|
||||
if Is_Entity_Name (P) then
|
||||
declare
|
||||
E : constant Entity_Id := Entity (P);
|
||||
Flag : Entity_Id;
|
||||
|
||||
-- If the access has been taken and the body of the subprogram
|
||||
-- has not been see yet, indirect calls must be protected with
|
||||
-- elaboration checks. We have the proper elaboration machinery
|
||||
-- for subprograms declared in packages, but within a block or
|
||||
-- a subprogram the body will appear in the same declarative
|
||||
-- part, and we must insert a check in the eventual body itself
|
||||
-- using the elaboration flag that we generate now. The check
|
||||
-- is then inserted when the body is expanded.
|
||||
|
||||
begin
|
||||
if Is_Subprogram (E)
|
||||
and then Comes_From_Source (E)
|
||||
and then Comes_From_Source (N)
|
||||
and then In_Open_Scopes (Scope (E))
|
||||
and then
|
||||
Ekind_In (Scope (E), E_Block, E_Procedure, E_Function)
|
||||
and then not Has_Completion (E)
|
||||
and then No (Elaboration_Entity (E))
|
||||
and then Expander_Active
|
||||
then
|
||||
-- Create elaboration variable for it
|
||||
|
||||
Flag := Make_Temporary (Loc, 'E');
|
||||
|
||||
Set_Elaboration_Entity (E, Flag);
|
||||
|
||||
Insert_Action (N,
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Flag,
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of (Standard_Short_Integer, Loc),
|
||||
Expression =>
|
||||
Make_Integer_Literal (Loc, Uint_0)));
|
||||
Set_Is_Frozen (Flag);
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
end Access_Attribute;
|
||||
|
||||
-------------
|
||||
|
|
|
|||
Loading…
Reference in New Issue