+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.
-- 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))
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
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
-- 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
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;
---------------------------
(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;
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;
{
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));
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.
Scan; -- past ;
Ret_Node := New_Node (N_Simple_Return_Statement, Ret_Sloc);
- -- Non-trivial case
+ -- Nontrivial case
else
-- Simple_return_statement with expression
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
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,
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;
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);
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
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;
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);
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
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;
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.
end if;
return False;
- end Is_Non_Trivial_Default_Init_Cond_Procedure;
+ end Is_Nontrivial_Default_Init_Cond_Procedure;
-------------------------
-- Is_Object_Reference --
-- 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
projects / gcc.git / commitdiff