+2016-10-13 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch6.adb (Create_Extra_Formals): Generate
+ an Itype reference for the object extra formal in case the
+ subprogram is called within the same or nested scope.
+
+2016-10-13 Claire Dross <dross@adacore.com>
+
+ * sem_ch5.adb (Analyze_Iterator_Specification):
+ Also create a renaming in GNATprove mode.
+
+2016-10-13 Ed Schonberg <schonberg@adacore.com>
+
+ * freeze.adb (Freeze_Fixed_Point_Type): in SPARK mode, the
+ given bounds of the type must be strictly representable, and the
+ range reduction by one delta ("shaving") allowed by the Ada RM,
+ is not applicable in SPARK.
+
+2016-10-13 Javier Miranda <miranda@adacore.com>
+
+ * debug.adb (switch d.9): Used to temporarily disable the support
+ needed for this enhancement since it causes regressions with
+ large sources.
+ * gnat1drv.adb (Post_Compilation_Validation_Checks): Temporarily
+ leave the validation of pragmas Compile_Time_Warning and
+ Compile_Time_Error under control of -gnatd.9/
+
2016-10-13 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch10.adb (Entity_Needs_Body): A generic
-- d.6
-- d.7
-- d.8
- -- d.9
+ -- d.9 Enable validation of pragma Compile_Time_[Error/Warning]
-- Debug flags for binder (GNATBIND)
-- d.5 By default a subprogram imported generates a subprogram profile.
-- This debug flag disables this generation when generating C code,
-- assuming a proper #include will be used instead.
+ --
+ -- d.9 Flag used temporarily to enable the validation of pragmas Compile_
+ -- Time_Error and Compile_Time_Warning after the back end has been
+ -- called.
------------------------------------------
-- Documentation for Binder Debug Flags --
-- Check for shaving
if Comes_From_Source (Typ) then
- if Orig_Lo < Expr_Value_R (Lo) then
- Error_Msg_N
- ("declared low bound of type & is outside type range??", Typ);
- Error_Msg_N
- ("\low bound adjusted up by delta (RM 3.5.9(13))??", Typ);
- end if;
- if Orig_Hi > Expr_Value_R (Hi) then
- Error_Msg_N
- ("declared high bound of type & is outside type range??", Typ);
- Error_Msg_N
- ("\high bound adjusted down by delta (RM 3.5.9(13))??", Typ);
+ -- In SPARK mode the given bounds must be strictly representable
+
+ if SPARK_Mode = On then
+ if Orig_Lo < Expr_Value_R (Lo) then
+ Error_Msg_NE
+ ("declared low bound of type & is outside type range",
+ Lo, Typ);
+ end if;
+
+ if Orig_Hi > Expr_Value_R (Hi) then
+ Error_Msg_NE
+ ("declared high bound of type & is outside type range",
+ Hi, Typ);
+ end if;
+
+ else
+ if Orig_Lo < Expr_Value_R (Lo) then
+ Error_Msg_N
+ ("declared low bound of type & is outside type range??", Typ);
+ Error_Msg_N
+ ("\low bound adjusted up by delta (RM 3.5.9(13))??", Typ);
+ end if;
+
+ if Orig_Hi > Expr_Value_R (Hi) then
+ Error_Msg_N
+ ("declared high bound of type & is outside type range??",
+ Typ);
+ Error_Msg_N
+ ("\high bound adjusted down by delta (RM 3.5.9(13))??", Typ);
+ end if;
end if;
end if;
end Freeze_Fixed_Point_Type;
-- and alignment annotated by the backend where possible). We need to
-- unlock temporarily these tables to reanalyze their expression.
- Atree.Unlock;
- Nlists.Unlock;
- Sem.Unlock;
- Sem_Ch13.Validate_Compile_Time_Warning_Errors;
- Sem.Lock;
- Nlists.Lock;
- Atree.Lock;
+ -- ??? temporarily disabled since it causes regressions with large
+ -- sources
+
+ if Debug_Flag_Dot_9 then
+ Atree.Unlock;
+ Nlists.Unlock;
+ Sem.Unlock;
+ Sem_Ch13.Validate_Compile_Time_Warning_Errors;
+ Sem.Lock;
+ Nlists.Lock;
+ Atree.Lock;
+ end if;
-- Validate unchecked conversions (using the values for size and
-- alignment annotated by the backend where possible).
and then (Nkind (Parent (N)) /= N_Quantified_Expression
or else Operating_Mode = Check_Semantics)
- -- Do not perform this expansion in SPARK mode, since the formal
- -- verification directly deals with the source form of the iterator.
- -- Ditto for ASIS and when expansion is disabled, where the temporary
- -- may hide the transformation of a selected component into a prefixed
- -- function call, and references need to see the original expression.
+ -- Do not perform this expansion for ASIS and when expansion is
+ -- disabled, where the temporary may hide the transformation of a
+ -- selected component into a prefixed function call, and references
+ -- need to see the original expression.
- and then not GNATprove_Mode
and then Expander_Active
then
declare
--------------------------
procedure Create_Extra_Formals (E : Entity_Id) is
- Formal : Entity_Id;
First_Extra : Entity_Id := Empty;
- Last_Extra : Entity_Id;
- Formal_Type : Entity_Id;
- P_Formal : Entity_Id := Empty;
+ Formal : Entity_Id;
+ Last_Extra : Entity_Id := Empty;
function Add_Extra_Formal
(Assoc_Entity : Entity_Id;
return EF;
end Add_Extra_Formal;
+ -- Local variables
+
+ Formal_Type : Entity_Id;
+ P_Formal : Entity_Id := Empty;
+
-- Start of processing for Create_Extra_Formals
begin
P_Formal := First_Formal (Alias (E));
end if;
- Last_Extra := Empty;
Formal := First_Formal (E);
while Present (Formal) loop
Last_Extra := Formal;
Result_Subt : constant Entity_Id := Etype (E);
Full_Subt : constant Entity_Id := Available_View (Result_Subt);
Formal_Typ : Entity_Id;
+ Subp_Decl : Node_Id;
Discard : Entity_Id;
pragma Warnings (Off, Discard);
Layout_Type (Formal_Typ);
+ -- Force the definition of the Itype in case of internal function
+ -- calls within the same or nested scope.
+
+ if Is_Subprogram_Or_Generic_Subprogram (E) then
+ Subp_Decl := Parent (E);
+
+ -- The insertion point for an Itype reference should be after
+ -- the unit declaration node of the subprogram. An exception
+ -- to this are inherited operations from a parent type in which
+ -- case the derived type acts as their parent.
+
+ if Nkind_In (Subp_Decl, N_Function_Specification,
+ N_Procedure_Specification)
+ then
+ Subp_Decl := Parent (Subp_Decl);
+ end if;
+
+ Build_Itype_Reference (Formal_Typ, Subp_Decl);
+ end if;
+
Discard :=
Add_Extra_Formal
(E, Formal_Typ, E, BIP_Formal_Suffix (BIP_Object_Access));
projects / gcc.git / commitdiff