Commit 8eb8461d by Arnaud Charlet

[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
parent 870ce4d5
2016-10-13 Hristian Kirtchev <kirtchev@adacore.com> 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 * sem_ch10.adb (Entity_Needs_Body): A generic
subprogram renaming needs a body if the renamed unit is declared subprogram renaming needs a body if the renamed unit is declared
outside the current compilation unit. outside the current compilation unit.
......
...@@ -163,7 +163,7 @@ package body Debug is ...@@ -163,7 +163,7 @@ package body Debug is
-- d.6 -- d.6
-- d.7 -- d.7
-- d.8 -- d.8
-- d.9 -- d.9 Enable validation of pragma Compile_Time_[Error/Warning]
-- Debug flags for binder (GNATBIND) -- Debug flags for binder (GNATBIND)
...@@ -774,6 +774,10 @@ package body Debug is ...@@ -774,6 +774,10 @@ package body Debug is
-- d.5 By default a subprogram imported generates a subprogram profile. -- d.5 By default a subprogram imported generates a subprogram profile.
-- This debug flag disables this generation when generating C code, -- This debug flag disables this generation when generating C code,
-- assuming a proper #include will be used instead. -- 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 -- -- Documentation for Binder Debug Flags --
......
...@@ -7661,18 +7661,37 @@ package body Freeze is ...@@ -7661,18 +7661,37 @@ package body Freeze is
-- Check for shaving -- Check for shaving
if Comes_From_Source (Typ) then 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 -- In SPARK mode the given bounds must be strictly representable
Error_Msg_N
("declared high bound of type & is outside type range??", Typ); if SPARK_Mode = On then
Error_Msg_N if Orig_Lo < Expr_Value_R (Lo) then
("\high bound adjusted down by delta (RM 3.5.9(13))??", Typ); 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 if; end if;
end Freeze_Fixed_Point_Type; end Freeze_Fixed_Point_Type;
......
...@@ -875,13 +875,18 @@ procedure Gnat1drv is ...@@ -875,13 +875,18 @@ procedure Gnat1drv is
-- and alignment annotated by the backend where possible). We need to -- and alignment annotated by the backend where possible). We need to
-- unlock temporarily these tables to reanalyze their expression. -- unlock temporarily these tables to reanalyze their expression.
Atree.Unlock; -- ??? temporarily disabled since it causes regressions with large
Nlists.Unlock; -- sources
Sem.Unlock;
Sem_Ch13.Validate_Compile_Time_Warning_Errors; if Debug_Flag_Dot_9 then
Sem.Lock; Atree.Unlock;
Nlists.Lock; Nlists.Unlock;
Atree.Lock; 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 -- Validate unchecked conversions (using the values for size and
-- alignment annotated by the backend where possible). -- alignment annotated by the backend where possible).
......
...@@ -1932,13 +1932,11 @@ package body Sem_Ch5 is ...@@ -1932,13 +1932,11 @@ package body Sem_Ch5 is
and then (Nkind (Parent (N)) /= N_Quantified_Expression and then (Nkind (Parent (N)) /= N_Quantified_Expression
or else Operating_Mode = Check_Semantics) or else Operating_Mode = Check_Semantics)
-- Do not perform this expansion in SPARK mode, since the formal -- Do not perform this expansion for ASIS and when expansion is
-- verification directly deals with the source form of the iterator. -- disabled, where the temporary may hide the transformation of a
-- Ditto for ASIS and when expansion is disabled, where the temporary -- selected component into a prefixed function call, and references
-- may hide the transformation of a selected component into a prefixed -- need to see the original expression.
-- function call, and references need to see the original expression.
and then not GNATprove_Mode
and then Expander_Active and then Expander_Active
then then
declare declare
......
...@@ -7307,11 +7307,9 @@ package body Sem_Ch6 is ...@@ -7307,11 +7307,9 @@ package body Sem_Ch6 is
-------------------------- --------------------------
procedure Create_Extra_Formals (E : Entity_Id) is procedure Create_Extra_Formals (E : Entity_Id) is
Formal : Entity_Id;
First_Extra : Entity_Id := Empty; First_Extra : Entity_Id := Empty;
Last_Extra : Entity_Id; Formal : Entity_Id;
Formal_Type : Entity_Id; Last_Extra : Entity_Id := Empty;
P_Formal : Entity_Id := Empty;
function Add_Extra_Formal function Add_Extra_Formal
(Assoc_Entity : Entity_Id; (Assoc_Entity : Entity_Id;
...@@ -7377,6 +7375,11 @@ package body Sem_Ch6 is ...@@ -7377,6 +7375,11 @@ package body Sem_Ch6 is
return EF; return EF;
end Add_Extra_Formal; end Add_Extra_Formal;
-- Local variables
Formal_Type : Entity_Id;
P_Formal : Entity_Id := Empty;
-- Start of processing for Create_Extra_Formals -- Start of processing for Create_Extra_Formals
begin begin
...@@ -7402,7 +7405,6 @@ package body Sem_Ch6 is ...@@ -7402,7 +7405,6 @@ package body Sem_Ch6 is
P_Formal := First_Formal (Alias (E)); P_Formal := First_Formal (Alias (E));
end if; end if;
Last_Extra := Empty;
Formal := First_Formal (E); Formal := First_Formal (E);
while Present (Formal) loop while Present (Formal) loop
Last_Extra := Formal; Last_Extra := Formal;
...@@ -7548,6 +7550,7 @@ package body Sem_Ch6 is ...@@ -7548,6 +7550,7 @@ package body Sem_Ch6 is
Result_Subt : constant Entity_Id := Etype (E); Result_Subt : constant Entity_Id := Etype (E);
Full_Subt : constant Entity_Id := Available_View (Result_Subt); Full_Subt : constant Entity_Id := Available_View (Result_Subt);
Formal_Typ : Entity_Id; Formal_Typ : Entity_Id;
Subp_Decl : Node_Id;
Discard : Entity_Id; Discard : Entity_Id;
pragma Warnings (Off, Discard); pragma Warnings (Off, Discard);
...@@ -7630,6 +7633,26 @@ package body Sem_Ch6 is ...@@ -7630,6 +7633,26 @@ package body Sem_Ch6 is
Layout_Type (Formal_Typ); 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 := Discard :=
Add_Extra_Formal Add_Extra_Formal
(E, Formal_Typ, E, BIP_Formal_Suffix (BIP_Object_Access)); (E, Formal_Typ, E, BIP_Formal_Suffix (BIP_Object_Access));
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment