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

[multiple changes]

Browse Source 
2015-11-12  Gary Dismukes  <dismukes@adacore.com>

	* exp_ch5.adb, sem_ch3.adb, exp_util.ads, inline.adb, freeze.adb,
	sem_util.adb, sem_util.ads, par-ch6.adb, sem_elab.adb: Minor
	reformatting and a typo fix.

2015-11-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Preanalyze_Actuals): Add guard on use of
	Incomplete_Actuals, which are only stored for a package
	instantiation, in order to place the instance in the body of
	the enclosing unit.

2015-11-12  Ed Schonberg  <schonberg@adacore.com>

	* exp_intr.adb: Add legality checks on calls to a
	Generic_Dispatching_Constructor: the given tag must be defined,
	it cannot be the tag of an abstract type, and its accessibility
	level must not be greater than that of the constructor.

2015-11-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Try_Container_Indexing, Constant_Indexing_OK):	If
	the context is an overloaded call, assume that Constant_Indexing
	is not OK if an interpretation has an assignable parameter
	corresponding to the indexing expression.

2015-11-12  Jerome Lambourg  <lambourg@adacore.com>

	* init.c (__gnat_error_handler): Force the SPE bit of the MSR
	when executing on e500v2 CPU.

2015-11-12  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Constituent): Stop the
	analysis after detecting a misplaced constituent as this is a
	critical error.

From-SVN: r230239
This commit is contained in:
Arnaud Charlet 2015-11-12 12:38:28 +01:00
parent 3095f7c6eb
commit 311014705a
16 changed files with 154 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
gcc/ada/ChangeLog
View File

@ -1,3 +1,41 @@
2015-11-12 Gary Dismukes <dismukes@adacore.com>
* exp_ch5.adb, sem_ch3.adb, exp_util.ads, inline.adb, freeze.adb,
sem_util.adb, sem_util.ads, par-ch6.adb, sem_elab.adb: Minor
reformatting and a typo fix.
2015-11-12 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Preanalyze_Actuals): Add guard on use of
Incomplete_Actuals, which are only stored for a package
instantiation, in order to place the instance in the body of
the enclosing unit.
2015-11-12 Ed Schonberg <schonberg@adacore.com>
* exp_intr.adb: Add legality checks on calls to a
Generic_Dispatching_Constructor: the given tag must be defined,
it cannot be the tag of an abstract type, and its accessibility
level must not be greater than that of the constructor.
2015-11-12 Ed Schonberg <schonberg@adacore.com>
* sem_ch4.adb (Try_Container_Indexing, Constant_Indexing_OK): If
the context is an overloaded call, assume that Constant_Indexing
is not OK if an interpretation has an assignable parameter
corresponding to the indexing expression.
2015-11-12 Jerome Lambourg <lambourg@adacore.com>
* init.c (__gnat_error_handler): Force the SPE bit of the MSR
when executing on e500v2 CPU.
2015-11-12 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_Constituent): Stop the
analysis after detecting a misplaced constituent as this is a
critical error.
2015-11-12 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch10.adb, atree.adb: Minor reformatting.

2
gcc/ada/exp_ch5.adb
View File

@ -4285,7 +4285,7 @@ package body Exp_Ch5 is
-- with element iterators, where debug information must be generated
-- for the temporary that holds the element value. These temporaries
-- are created within a transient block whose local declarations are
-- transferred to the loop, which now has non-trivial local objects.
-- transferred to the loop, which now has nontrivial local objects.
if Nkind (N) = N_Loop_Statement
and then Present (Identifier (N))

44
gcc/ada/exp_intr.adb
View File

@ -311,6 +311,31 @@ package body Exp_Intr is
Remove_Side_Effects (Tag_Arg);
-- Check that we have a proper tag
Insert_Action (N,
Make_Implicit_If_Statement (N,
Condition => Make_Op_Eq (Loc,
Left_Opnd => New_Copy_Tree (Tag_Arg),
Right_Opnd => New_Occurrence_Of (RTE (RE_No_Tag), Loc)),
Then_Statements => New_List (
Make_Raise_Statement (Loc,
New_Occurrence_Of (RTE (RE_Tag_Error), Loc)))));
-- Check that it is not the tag of an abstract type
Insert_Action (N,
Make_Implicit_If_Statement (N,
Condition => Make_Function_Call (Loc,
Name =>
New_Occurrence_Of (RTE (RE_Type_Is_Abstract), Loc),
Parameter_Associations => New_List (New_Copy_Tree (Tag_Arg))),
Then_Statements => New_List (
Make_Raise_Statement (Loc,
New_Occurrence_Of (RTE (RE_Tag_Error), Loc)))));
-- The subprogram is the third actual in the instantiation, and is
-- retrieved from the corresponding renaming declaration. However,
-- freeze nodes may appear before, so we retrieve the declaration
@ -324,6 +349,22 @@ package body Exp_Intr is
Act_Constr := Entity (Name (Act_Rename));
Result_Typ := Class_Wide_Type (Etype (Act_Constr));
-- Check that the accessibility level of the tag is no deeper than that
-- of the constructor function.
Insert_Action (N,
Make_Implicit_If_Statement (N,
Condition =>
Make_Op_Gt (Loc,
Left_Opnd =>
Build_Get_Access_Level (Loc, New_Copy_Tree (Tag_Arg)),
Right_Opnd =>
Make_Integer_Literal (Loc, Scope_Depth (Act_Constr))),
Then_Statements => New_List (
Make_Raise_Statement (Loc,
New_Occurrence_Of (RTE (RE_Tag_Error), Loc)))));
if Is_Interface (Etype (Act_Constr)) then
-- If the result type is not known to be a parent of Tag_Arg then we
@ -390,7 +431,6 @@ package body Exp_Intr is
-- conversion of the call to the actual constructor.
Rewrite (N, Convert_To (Result_Typ, Cnstr_Call));
Analyze_And_Resolve (N, Etype (Act_Constr));
-- Do not generate a run-time check on the built object if tag
-- checks are suppressed for the result type or tagged type expansion
@ -458,6 +498,8 @@ package body Exp_Intr is
Make_Raise_Statement (Loc,
Name => New_Occurrence_Of (RTE (RE_Tag_Error), Loc)))));
end if;
Analyze_And_Resolve (N, Etype (Act_Constr));
end Expand_Dispatching_Constructor_Call;
---------------------------

2
gcc/ada/exp_util.ads
View File

@ -806,7 +806,7 @@ package Exp_Util is
(Decl : Node_Id;
Typ : Entity_Id) return Boolean;
-- Check whether the expression in an address clause is restricted to
-- consist of constants, when the object has a non-trivial initialization
-- consist of constants, when the object has a nontrivial initialization
-- or is controlled.
function Needs_Finalization (T : Entity_Id) return Boolean;

2
gcc/ada/freeze.adb
View File

@ -1452,7 +1452,7 @@ package body Freeze is
return;
end if;
-- The situation that is non trivial is something like
-- The situation that is nontrivial is something like:
-- subtype x1 is integer range -10 .. +10;
-- subtype x2 is x1 range 0 .. V1;

4
gcc/ada/init.c
View File

@ -1919,11 +1919,11 @@ __gnat_error_handler (int sig, siginfo_t *si, void *sc)
{
sigset_t mask;
/* VxWorks 7 on e500v2 clears the SPE bit of the MSR when entering CPU
/* VxWorks on e500v2 clears the SPE bit of the MSR when entering CPU
exception state. To allow the handler and exception to work properly
when they contain SPE instructions, we need to set it back before doing
anything else. */
#if (CPU == PPCE500V2) && (_WRS_VXWORKS_MAJOR == 7)
#if (CPU == PPCE500V2) || (CPU == PPC85XX)
register unsigned msr;
/* Read the MSR value */
asm volatile ("mfmsr %0" : "=r" (msr));

2
gcc/ada/inline.adb
View File

@ -193,7 +193,7 @@ package body Inline is
function Has_Initialized_Type (E : Entity_Id) return Boolean;
-- If a candidate for inlining contains type declarations for types with
-- non-trivial initialization procedures, they are not worth inlining.
-- nontrivial initialization procedures, they are not worth inlining.
function Has_Single_Return (N : Node_Id) return Boolean;
-- In general we cannot inline functions that return unconstrained type.

2
gcc/ada/par-ch6.adb
View File

@ -1878,7 +1878,7 @@ package body Ch6 is
Scan; -- past ;
Ret_Node := New_Node (N_Simple_Return_Statement, Ret_Sloc);
-- Non-trivial case
-- Nontrivial case
else
-- Simple_return_statement with expression

2
gcc/ada/rtsfind.ads
View File

@ -640,6 +640,7 @@ package Rtsfind is
RE_Max_Predef_Prims, -- Ada.Tags
RE_Needs_Finalization, -- Ada.Tags
RE_No_Dispatch_Table_Wrapper, -- Ada.Tags
RE_No_Tag, -- Ada.Tags
RE_NDT_Prims_Ptr, -- Ada.Tags
RE_NDT_TSD, -- Ada.Tags
RE_Num_Prims, -- Ada.Tags
@ -1871,6 +1872,7 @@ package Rtsfind is
RE_Max_Predef_Prims => Ada_Tags,
RE_Needs_Finalization => Ada_Tags,
RE_No_Dispatch_Table_Wrapper => Ada_Tags,
RE_No_Tag => Ada_Tags,
RE_NDT_Prims_Ptr => Ada_Tags,
RE_NDT_TSD => Ada_Tags,
RE_Num_Prims => Ada_Tags,

5
gcc/ada/sem_ch12.adb
View File

@ -13434,9 +13434,14 @@ package body Sem_Ch12 is
elsif Nkind (Act) /= N_Operator_Symbol then
Analyze (Act);
-- Within a package instance, mark actuals that are limited
-- views, so their use can be moved to the body of the
-- enclosing unit.
if Is_Entity_Name (Act)
and then Is_Type (Entity (Act))
and then From_Limited_With (Entity (Act))
and then Present (Inst)
then
Append_Elmt (Entity (Act), Incomplete_Actuals (Inst));
end if;

6
gcc/ada/sem_ch3.adb
View File

@ -3051,9 +3051,9 @@ package body Sem_Ch3 is
End_Scope;
end if;
-- If the type has discriminants, non-trivial subtypes may be
-- declared before the full view of the type. The full views of those
-- subtypes will be built after the full view of the type.
-- If the type has discriminants, nontrivial subtypes may be declared
-- before the full view of the type. The full views of those subtypes
-- will be built after the full view of the type.
Set_Private_Dependents (T, New_Elmt_List);
Set_Is_Pure (T, F);

37
gcc/ada/sem_ch4.adb
View File

@ -7190,10 +7190,43 @@ package body Sem_Ch4 is
begin
-- We should look for an interpretation with the proper
-- number of formals, and determine whether it is an
-- In_Parameter, but for now assume that in the overloaded
-- case constant indexing is legal. To be improved ???
-- In_Parameter, but for now we examine the formal that
-- corresponds to the indexing, and assume that variable
-- indexing is required if some interpretation has an
-- assignable formal at that position. Still does not
-- cover the most complex cases ???
if Is_Overloaded (Name (Parent (Par))) then
declare
Proc : constant Node_Id := Name (Parent (Par));
A : Node_Id;
F : Entity_Id;
I : Interp_Index;
It : Interp;
begin
Get_First_Interp (Proc, I, It);
while Present (It.Nam) loop
F := First_Formal (It.Nam);
A := First (Parameter_Associations (Parent (Par)));
while Present (F) and then Present (A) loop
if A = Par then
if Ekind (F) /= E_In_Parameter then
return False;
else
exit; -- interpretation is safe
end if;
end if;
Next_Formal (F);
Next_Actual (A);
end loop;
Get_Next_Interp (I, It);
end loop;
end;
return True;
else

8
gcc/ada/sem_elab.adb
View File

@ -599,7 +599,7 @@ package body Sem_Elab is
Is_DIC_Proc : Boolean := False;
-- Flag set when the call denotes the Default_Initial_Condition
-- procedure of a private type which wraps a non-trivila assertion
-- procedure of a private type that wraps a nontrivial assertion
-- expression.
Issue_In_SPARK : Boolean;
@ -971,13 +971,13 @@ package body Sem_Elab is
return;
end if;
Is_DIC_Proc := Is_Non_Trivial_Default_Init_Cond_Procedure (Ent);
Is_DIC_Proc := Is_Nontrivial_Default_Init_Cond_Procedure (Ent);
-- Elaboration issues in SPARK are reported only for source constructs
-- and for non-trivial Default_Initial_Condition procedures. The latter
-- and for nontrivial Default_Initial_Condition procedures. The latter
-- must be checked because the default initialization of an object of a
-- private type triggers the evaluation of the Default_Initial_Condition
-- expression which in turn may have side effects.
-- expression, which in turn may have side effects.
Issue_In_SPARK :=
SPARK_Mode = On and (Comes_From_Source (Ent) or Is_DIC_Proc);

8
gcc/ada/sem_prag.adb
View File

@ -25408,6 +25408,14 @@ package body Sem_Prag is
SPARK_Msg_N
("\all constituents must be declared before body #",
N);
-- A misplaced constituent is a critical error because
-- pragma Refined_Depends or Refined_Global depends on
-- the proper link between a state and a constituent.
-- Stop the compilation, as this leads to a multitude
-- of misleading cascaded errors.
raise Program_Error;
end if;
-- The constituent is a valid state or object

12
gcc/ada/sem_util.adb
View File

@ -12362,11 +12362,11 @@ package body Sem_Util is
end if;
end Is_Local_Variable_Reference;
------------------------------------------------
-- Is_Non_Trivial_Default_Init_Cond_Procedure --
------------------------------------------------
-----------------------------------------------
-- Is_Nontrivial_Default_Init_Cond_Procedure --
-----------------------------------------------
function Is_Non_Trivial_Default_Init_Cond_Procedure
function Is_Nontrivial_Default_Init_Cond_Procedure
(Id : Entity_Id) return Boolean
is
Body_Decl : Node_Id;
@ -12386,7 +12386,7 @@ package body Sem_Util is
pragma Assert (Present (Handled_Statement_Sequence (Body_Decl)));
-- To qualify as non-trivial, the first statement of the procedure
-- To qualify as nontrivial, the first statement of the procedure
-- must be a check in the form of an if statement. If the original
-- Default_Initial_Condition expression was folded, then the first
-- statement is not a check.
@ -12399,7 +12399,7 @@ package body Sem_Util is
end if;
return False;
end Is_Non_Trivial_Default_Init_Cond_Procedure;
end Is_Nontrivial_Default_Init_Cond_Procedure;
-------------------------
-- Is_Object_Reference --

6
gcc/ada/sem_util.ads
View File

@ -1433,11 +1433,11 @@ package Sem_Util is
-- parameter of the current enclosing subprogram.
-- Why are OUT parameters not considered here ???
function Is_Non_Trivial_Default_Init_Cond_Procedure
function Is_Nontrivial_Default_Init_Cond_Procedure
(Id : Entity_Id) return Boolean;
-- Determine whether entity Id denotes the procedure which verifies the
-- Determine whether entity Id denotes the procedure that verifies the
-- assertion expression of pragma Default_Initial_Condition and if it does,
-- the encapsulated expression is non-trivial.
-- the encapsulated expression is nontrivial.
function Is_Object_Reference (N : Node_Id) return Boolean;
-- Determines if the tree referenced by N represents an object. Both