From 8eb8461dc13600aafd77b89928196366a4747786 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 13 Oct 2016 14:58:24 +0200 Subject: [PATCH] [multiple changes] 2016-10-13 Hristian Kirtchev * 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 * sem_ch5.adb (Analyze_Iterator_Specification): Also create a renaming in GNATprove mode. 2016-10-13 Ed Schonberg * 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 * 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 --- gcc/ada/ChangeLog | 27 +++++++++++++++++++++++++++ gcc/ada/debug.adb | 6 +++++- gcc/ada/freeze.adb | 41 ++++++++++++++++++++++++++++++----------- gcc/ada/gnat1drv.adb | 19 ++++++++++++------- gcc/ada/sem_ch5.adb | 10 ++++------ gcc/ada/sem_ch6.adb | 33 ++++++++++++++++++++++++++++----- 6 files changed, 106 insertions(+), 30 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7ea6b94515f..71014fb429b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,30 @@ +2016-10-13 Hristian Kirtchev + + * 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 + + * sem_ch5.adb (Analyze_Iterator_Specification): + Also create a renaming in GNATprove mode. + +2016-10-13 Ed Schonberg + + * 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 + + * 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 * sem_ch10.adb (Entity_Needs_Body): A generic diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index e3c53dda462..d9367375e7b 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -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 -- diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index b28be4fcecb..96ae4e4c98c 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -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; diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 929bfcc316d..605bac59858 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -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). diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 8e9e2b6d4bf..5897454d427 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -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 diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 4544e0b7861..814d1183003 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -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));