[multiple changes]

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/

From-SVN: r241115
This commit is contained in:
Arnaud Charlet 2016-10-13 14:58:24 +02:00
parent 870ce4d51b
commit 8eb8461dc1
6 changed files with 106 additions and 30 deletions

View File

@ -1,3 +1,30 @@
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

View File

@ -163,7 +163,7 @@ package body Debug is
-- d.6
-- d.7
-- d.8
-- d.9
-- d.9 Enable validation of pragma Compile_Time_[Error/Warning]
-- Debug flags for binder (GNATBIND)
@ -774,6 +774,10 @@ package body Debug is
-- 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 --

View File

@ -7661,18 +7661,37 @@ package body Freeze is
-- 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;

View File

@ -875,13 +875,18 @@ procedure Gnat1drv is
-- 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).

View File

@ -1932,13 +1932,11 @@ package body Sem_Ch5 is
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

View File

@ -7307,11 +7307,9 @@ package body Sem_Ch6 is
--------------------------
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;
@ -7377,6 +7375,11 @@ package body Sem_Ch6 is
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
@ -7402,7 +7405,6 @@ package body Sem_Ch6 is
P_Formal := First_Formal (Alias (E));
end if;
Last_Extra := Empty;
Formal := First_Formal (E);
while Present (Formal) loop
Last_Extra := Formal;
@ -7548,6 +7550,7 @@ package body Sem_Ch6 is
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);
@ -7630,6 +7633,26 @@ package body Sem_Ch6 is
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));