From fb757f7da43d13603d3d8b821f62076336e412a9 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 16 Jun 2016 11:44:04 +0200 Subject: [PATCH] [multiple changes] 2016-06-16 Hristian Kirtchev * exp_attr.adb, inline.adb, sem_attr.adb, sem_elab.adb: Minor reformatting. 2016-06-16 Bob Duff * sem_util.adb (Collect): Avoid Empty Full_T. Otherwise Etype (Full_T) crashes when assertions are on. * sem_ch12.adb (Matching_Actual): Correctly handle the case where "others => <>" appears in a generic formal package, other than by itself. 2016-06-16 Arnaud Charlet * usage.adb: Remove confusing comment in usage line. * bindgen.adb: Fix binder generated file in codepeer mode wrt recent additions. 2016-06-16 Javier Miranda * restrict.adb (Check_Restriction_No_Use_Of_Entity): Avoid never-ending loop, code cleanup; adding also support for Text_IO. * sem_ch8.adb (Find_Expanded_Name): Invoke Check_Restriction_No_Use_Entity. 2016-06-16 Tristan Gingold * exp_ch9.adb: Minor comment fix. * einfo.ads (Has_Protected): Clarify comment. * sem_ch9.adb (Analyze_Protected_Type_Declaration): Do not consider private protected types declared in the runtime for the No_Local_Protected_Types restriction. From-SVN: r237507 --- gcc/ada/ChangeLog | 34 +++++++++++++++++++++++++++++++++ gcc/ada/bindgen.adb | 45 +++++++++++++++++++++++--------------------- gcc/ada/einfo.ads | 8 ++++---- gcc/ada/exp_attr.adb | 5 +++-- gcc/ada/exp_ch9.adb | 2 +- gcc/ada/inline.adb | 4 ++-- gcc/ada/restrict.adb | 28 +++++++++++++-------------- gcc/ada/sem_attr.adb | 1 + gcc/ada/sem_ch12.adb | 13 +++++++++---- gcc/ada/sem_ch8.adb | 2 ++ gcc/ada/sem_ch9.adb | 19 ++++++++++++++++++- gcc/ada/sem_elab.adb | 17 ++++++++--------- gcc/ada/sem_util.adb | 6 +++++- gcc/ada/usage.adb | 2 +- 14 files changed, 126 insertions(+), 60 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ebdf963de00..d514eaff5bc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,37 @@ +2016-06-16 Hristian Kirtchev + + * exp_attr.adb, inline.adb, sem_attr.adb, sem_elab.adb: Minor + reformatting. + +2016-06-16 Bob Duff + + * sem_util.adb (Collect): Avoid Empty Full_T. Otherwise Etype + (Full_T) crashes when assertions are on. + * sem_ch12.adb (Matching_Actual): Correctly handle the case where + "others => <>" appears in a generic formal package, other than + by itself. + +2016-06-16 Arnaud Charlet + + * usage.adb: Remove confusing comment in usage line. + * bindgen.adb: Fix binder generated file in codepeer mode wrt + recent additions. + +2016-06-16 Javier Miranda + + * restrict.adb (Check_Restriction_No_Use_Of_Entity): Avoid + never-ending loop, code cleanup; adding also support for Text_IO. + * sem_ch8.adb (Find_Expanded_Name): Invoke + Check_Restriction_No_Use_Entity. + +2016-06-16 Tristan Gingold + + * exp_ch9.adb: Minor comment fix. + * einfo.ads (Has_Protected): Clarify comment. + * sem_ch9.adb (Analyze_Protected_Type_Declaration): Do not + consider private protected types declared in the runtime for + the No_Local_Protected_Types restriction. + 2016-06-14 Ed Schonberg * sem_ch6.adb (Set_Actual_Subtypes): Do not generate actual diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 144ab5148cc..079ebb40cbc 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -930,35 +930,38 @@ package body Bindgen is Gen_Elab_Calls; - -- Call System.Elaboration_Allocators.Mark_Start_Of_Elaboration if - -- restriction No_Standard_Allocators_After_Elaboration is active. + if not CodePeer_Mode then + -- Call System.Elaboration_Allocators.Mark_Start_Of_Elaboration if + -- restriction No_Standard_Allocators_After_Elaboration is active. - if Cumulative_Restrictions.Set - (No_Standard_Allocators_After_Elaboration) - then - WBI (" System.Elaboration_Allocators.Mark_End_Of_Elaboration;"); - end if; + if Cumulative_Restrictions.Set + (No_Standard_Allocators_After_Elaboration) + then + WBI + (" System.Elaboration_Allocators.Mark_End_Of_Elaboration;"); + end if; - -- From this point, no new dispatching domain can be created + -- From this point, no new dispatching domain can be created - if Dispatching_Domains_Used then - WBI (" Freeze_Dispatching_Domains;"); - end if; + if Dispatching_Domains_Used then + WBI (" Freeze_Dispatching_Domains;"); + end if; - -- Sequential partition elaboration policy + -- Sequential partition elaboration policy - if Partition_Elaboration_Policy_Specified = 'S' then - if System_Interrupts_Used then - WBI (" Install_Restricted_Handlers_Sequential;"); - end if; + if Partition_Elaboration_Policy_Specified = 'S' then + if System_Interrupts_Used then + WBI (" Install_Restricted_Handlers_Sequential;"); + end if; - if System_Tasking_Restricted_Stages_Used then - WBI (" Activate_All_Tasks_Sequential;"); + if System_Tasking_Restricted_Stages_Used then + WBI (" Activate_All_Tasks_Sequential;"); + end if; end if; - end if; - if System_BB_CPU_Primitives_Multiprocessors_Used then - WBI (" Start_Slave_CPUs;"); + if System_BB_CPU_Primitives_Multiprocessors_Used then + WBI (" Start_Slave_CPUs;"); + end if; end if; WBI (" end " & Ada_Init_Name.all & ";"); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 19e40871c97..a8212984c05 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -1936,10 +1936,10 @@ package Einfo is -- Has_Protected (Flag271) [base type only] -- Defined in all type entities. Set on protected types themselves, and -- also (recursively) on any composite type which has a component for --- which Has_Protected is set. The meaning is that an allocator for --- or declaration of such an object must create the required protected --- objects. Note: the flag is not set on access types, even if they --- designate an object that Has_Protected. +-- which Has_Protected is set, unless the protected type is declared in +-- the private part of an internal unit. The meaning is that restrictions +-- for protected types apply to this type. Note: the flag is not set on +-- access types, even if they designate an object that Has_Protected. -- Has_Qualified_Name (Flag161) -- Defined in all entities. Set if the name in the Chars field has diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 4907c66d9e9..6c5f3b5e7c5 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -4398,8 +4398,9 @@ package body Exp_Attr is -- _Postconditions must be in the tree (or inlined if we are -- generating C code). - pragma Assert (Present (Subp) - or else (Modify_Tree_For_C and then In_Inlined_Body)); + pragma Assert + (Present (Subp) + or else (Modify_Tree_For_C and then In_Inlined_Body)); Temp := Make_Temporary (Loc, 'T', Pref); diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index d8ccafa6f40..9f4563106b1 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -14142,7 +14142,7 @@ package body Exp_Ch9 is -- or, in the case of Ravenscar: -- Install_Restricted_Handlers - -- (Prio, (Expr1, Proc1'access), ...., (ExprN, ProcN'access)); + -- (Prio, ((Expr1, Proc1'access), ...., (ExprN, ProcN'access))); declare Args : constant List_Id := New_List; diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 8b0e331e884..b6db273430e 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -2323,8 +2323,8 @@ package body Inline is and then Present (Postconditions_Proc (Enclosing_Subp))); if Ekind (Enclosing_Subp) = E_Function then - if Nkind (First (Parameter_Associations (N))) - in N_Numeric_Or_String_Literal + if Nkind (First (Parameter_Associations (N))) in + N_Numeric_Or_String_Literal then Append_To (Declarations (Blk), Make_Object_Declaration (Loc, diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index f49f9d8e8fa..6cc308f5fe7 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -759,9 +759,16 @@ package body Restrict is Ent := Entity (N); Expr := NE_Ent.Entity; loop - -- Here if at outer level of entity name in reference - - if Scope (Ent) = Standard_Standard then + -- Here if at outer level of entity name in reference (handle + -- also the direct use of Text_IO in the pragma). For example: + -- pragma Restrictions (No_Use_Of_Entity => Text_IO.Put); + + if Scope (Ent) = Standard_Standard + or else (Nkind (Expr) = N_Identifier + and then Chars (Ent) = Name_Text_IO + and then Chars (Scope (Ent)) = Name_Ada + and then Scope (Scope (Ent)) = Standard_Standard) + then if Nkind_In (Expr, N_Identifier, N_Operator_Symbol) and then Chars (Ent) = Chars (Expr) then @@ -774,22 +781,19 @@ package body Restrict is return; else - goto Continue; + exit; end if; -- Here if at outer level of entity name in table elsif Nkind_In (Expr, N_Identifier, N_Operator_Symbol) then - goto Continue; + exit; -- Here if neither at the outer level else pragma Assert (Nkind (Expr) = N_Selected_Component); - - if Chars (Selector_Name (Expr)) /= Chars (Ent) then - goto Continue; - end if; + exit when Chars (Selector_Name (Expr)) /= Chars (Ent); end if; -- Move up a level @@ -800,10 +804,6 @@ package body Restrict is end loop; Expr := Prefix (Expr); - - -- Entry did not match - - <> null; end loop; end; end loop; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index a0740f0d3e7..f1535179c1b 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -1384,6 +1384,7 @@ package body Sem_Attr is and then Chars (Scope (Spec_Id)) = Name_uPostconditions then -- This situation occurs only when preanalyzing the inlined body + pragma Assert (not Full_Analysis); Spec_Id := Scope (Spec_Id); diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 78c161f0ab0..f62c30f1aec 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -1112,7 +1112,7 @@ package body Sem_Ch12 is -- Find actual that corresponds to a given a formal parameter. If the -- actuals are positional, return the next one, if any. If the actuals -- are named, scan the parameter associations to find the right one. - -- A_F is the corresponding entity in the analyzed generic,which is + -- A_F is the corresponding entity in the analyzed generic, which is -- placed on the selector name for ASIS use. -- -- In Ada 2005, a named association may be given with a box, in which @@ -1257,7 +1257,7 @@ package body Sem_Ch12 is elsif No (Selector_Name (Actual)) then Found_Assoc := Actual; - Act := Explicit_Generic_Actual_Parameter (Actual); + Act := Explicit_Generic_Actual_Parameter (Actual); Num_Matched := Num_Matched + 1; Next (Actual); @@ -1271,12 +1271,17 @@ package body Sem_Ch12 is Prev := Empty; while Present (Actual) loop - if Chars (Selector_Name (Actual)) = Chars (F) then + if Nkind (Actual) = N_Others_Choice then + Found_Assoc := Empty; + Act := Empty; + + elsif Chars (Selector_Name (Actual)) = Chars (F) then Set_Entity (Selector_Name (Actual), A_F); Set_Etype (Selector_Name (Actual), Etype (A_F)); Generate_Reference (A_F, Selector_Name (Actual)); + Found_Assoc := Actual; - Act := Explicit_Generic_Actual_Parameter (Actual); + Act := Explicit_Generic_Actual_Parameter (Actual); Num_Matched := Num_Matched + 1; exit; end if; diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 05f1d469b18..a6900a3b9bd 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -6224,6 +6224,8 @@ package body Sem_Ch8 is if Is_Overloadable (Id) and then not Is_Overloaded (N) then Generate_Reference (Id, N); end if; + + Check_Restriction_No_Use_Of_Entity (N); end Find_Expanded_Name; ------------------------- diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index aa2a18de792..d981b5f18fa 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -32,8 +32,10 @@ with Einfo; use Einfo; with Errout; use Errout; with Exp_Ch9; use Exp_Ch9; with Elists; use Elists; +with Fname; use Fname; with Freeze; use Freeze; with Layout; use Layout; +with Lib; use Lib; with Lib.Xref; use Lib.Xref; with Namet; use Namet; with Nlists; use Nlists; @@ -1985,12 +1987,27 @@ package body Sem_Ch9 is Set_Ekind (T, E_Protected_Type); Set_Is_First_Subtype (T, True); - Set_Has_Protected (T, True); Init_Size_Align (T); Set_Etype (T, T); Set_Has_Delayed_Freeze (T, True); Set_Stored_Constraint (T, No_Elist); + -- Mark this type as a protected type for the sake of restrictions, + -- unless the protected type is declared in a private part of a package + -- of the runtime. With this exception, the Suspension_Object from + -- Ada.Synchronous_Task_Control can be implemented using a protected + -- without triggering violations of No_Local_Protected_Objects when the + -- user locally declares such an object. This may look like a trick but + -- the user doesn't have to know how Suspension_Object is implemented. + + if In_Private_Part (Current_Scope) + and then Is_Internal_File_Name (Unit_File_Name (Current_Sem_Unit)) + then + Set_Has_Protected (T, False); + else + Set_Has_Protected (T, True); + end if; + -- Set the SPARK_Mode from the current context (may be overwritten later -- with an explicit pragma). diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 48054400464..fd5a70360cf 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -516,8 +516,7 @@ package body Sem_Elab is Access_Case : constant Boolean := Nkind (N) = N_Attribute_Reference; -- Indicates if we have Access attribute case - function Call_To_Instance_From_Outside - (Ent : Entity_Id) return Boolean; + function Call_To_Instance_From_Outside (Id : Entity_Id) return Boolean; -- True if we're calling an instance of a generic subprogram, or a -- subprogram in an instance of a generic package, and the call is -- outside that instance. @@ -543,21 +542,20 @@ package body Sem_Elab is -- Call_To_Instance_From_Outside -- ----------------------------------- - function Call_To_Instance_From_Outside - (Ent : Entity_Id) return Boolean is + function Call_To_Instance_From_Outside (Id : Entity_Id) return Boolean is + Scop : Entity_Id := Id; - X : Entity_Id := Ent; begin loop - if X = Standard_Standard then + if Scop = Standard_Standard then return False; end if; - if Is_Generic_Instance (X) then - return not In_Open_Scopes (X); + if Is_Generic_Instance (Scop) then + return not In_Open_Scopes (Scop); end if; - X := Scope (X); + Scop := Scope (Scop); end loop; end Call_To_Instance_From_Outside; @@ -602,6 +600,7 @@ package body Sem_Elab is function Find_W_Scope return Entity_Id is Refed_Ent : constant Entity_Id := Get_Referenced_Ent (N); W_Scope : Entity_Id; + begin if Is_Init_Proc (Refed_Ent) and then not In_Same_Extended_Unit (N, Refed_Ent) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index c39e3a66545..021ceac6a35 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -4239,7 +4239,11 @@ package body Sem_Util is Full_T := Full_View (Typ); if Ekind (Full_T) = E_Record_Subtype then - Full_T := Full_View (Etype (Typ)); + Full_T := Etype (Typ); + + if Present (Full_View (Full_T)) then + Full_T := Full_View (Full_T); + end if; end if; end if; diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index cb7d6a386b6..6421a08fbfa 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -347,7 +347,7 @@ begin -- Line for -gnato switch Write_Switch_Char ("o0"); - Write_Line ("Disable overflow checking (on by default)"); + Write_Line ("Disable overflow checking"); Write_Switch_Char ("o"); Write_Line ("Enable overflow checking in STRICT (-gnato1) mode (default)"); -- 2.30.2