diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 27 | ||||
| -rw-r--r-- | gcc/ada/debug.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 41 | ||||
| -rw-r--r-- | gcc/ada/gnat1drv.adb | 19 | ||||
| -rw-r--r-- | gcc/ada/sem_ch5.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 33 |
6 files changed, 106 insertions, 30 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7ea6b94..71014fb 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,32 @@ 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 subprogram renaming needs a body if the renamed unit is declared outside the current compilation unit. diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index e3c53dd..d936737 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 b28be4f..96ae4e4 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 929bfcc..605bac5 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 8e9e2b6..5897454 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 4544e0b..814d118 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)); |