From c8a3028c36d9c8fd7f6f07b8571e6db0db337616 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 21 May 2014 15:14:06 +0200 Subject: [multiple changes] 2014-05-21 Robert Dewar * sem_elab.adb: Minor reformatting. * s-taprop.ads: Minor comment fix. * sem_ch8.adb (Analyze_Subprogram_Renaming): Remove call to Kill_Elaboration_Checks. * errout.adb, erroutc.adb: Minor reformatting. 2014-05-21 Thomas Quinot * exp_pakd.adb (Byte_Swap): Handle the case of a sub-byte component. No byte swapping occurs, but this procedure also takes care of appropriately justifying the argument. 2014-05-21 Hristian Kirtchev * sem_ch6.adb: sem_ch6.adb (Analyze_Aspects_On_Body_Or_Stub): New routine. (Analyze_Subprogram_Body_Helper): Move the analysis of aspect specifications and the processing of the subprogram body contract after inlining has taken place. (Diagnose_Misplaced_Aspect_Specifications): Removed. 2014-05-21 Javier Miranda * sem_ch3.adb (Build_Derived_Record_Type): Revert previous change. 2014-05-21 Robert Dewar * sem_eval.ads, sem_eval.adb (Why_Not_Static): Messages are not continuations any more. 2014-05-21 Ed Schonberg * sinfo.ads, sinfo.adb: New flag Needs_Initialized_Actual, present in formal_Private_Definitions and on private extension declarations of a formal derived type. Set when the use of the formal type in a generic suggests that the actual should be a fully initialized type. * sem_warn.adb (May_Need_Initialized_Actual): new subprogram to indicate that an entity of a generic type has default initialization, and that the corresponing actual type in any subsequent instantiation should be fully initialized. * sem_ch12.adb (Check_Initialized_Type): new subprogram, to emit a warning if the actual for a generic type on which Needs_Initialized_Actual is set is not a fully initialized type. From-SVN: r210705 --- gcc/ada/sem_elab.adb | 107 ++++++++++++++++++++------------------------------- 1 file changed, 42 insertions(+), 65 deletions(-) (limited to 'gcc/ada/sem_elab.adb') diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 19c6aa2..fa39312 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -578,16 +578,15 @@ package body Sem_Elab is if Nkind (Decl) = N_Subprogram_Body then Body_Acts_As_Spec := True; - elsif Nkind (Decl) = N_Subprogram_Declaration - or else Nkind (Decl) = N_Subprogram_Body_Stub + elsif Nkind_In (Decl, N_Subprogram_Declaration, N_Subprogram_Body_Stub) or else Inst_Case then Body_Acts_As_Spec := False; - -- If we have none of an instantiation, subprogram body or - -- subprogram declaration, then it is not a case that we want - -- to check. (One case is a call to a generic formal subprogram, - -- where we do not want the check in the template). + -- If we have none of an instantiation, subprogram body or subprogram + -- declaration, then it is not a case that we want to check. (One case + -- is a call to a generic formal subprogram, where we do not want the + -- check in the template). else return; @@ -605,7 +604,7 @@ package body Sem_Elab is exit when Is_Compilation_Unit (E_Scope) and then (Is_Child_Unit (E_Scope) - or else Scope (E_Scope) = Standard_Standard); + or else Scope (E_Scope) = Standard_Standard); -- If we did not find a compilation unit, other than standard, -- then nothing to check (happens in some instantiation cases) @@ -633,17 +632,15 @@ package body Sem_Elab is -- However, this assumption is only valid if we are in static mode. if not Dynamic_Elaboration_Checks - and then Instantiation_Depth (Sloc (Ent)) > - Instantiation_Depth (Sloc (N)) + and then + Instantiation_Depth (Sloc (Ent)) > Instantiation_Depth (Sloc (N)) then return; end if; -- Do not give a warning for a package with no body - if Ekind (Ent) = E_Generic_Package - and then not Has_Generic_Body (N) - then + if Ekind (Ent) = E_Generic_Package and then not Has_Generic_Body (N) then return; end if; @@ -738,7 +735,7 @@ package body Sem_Elab is -- the sgi build and storage errors. To be resolved later ??? if (Callee_Unit_Internal and Caller_Unit_Internal) - and then not Debug_Flag_EE + and then not Debug_Flag_EE then return; end if; @@ -776,7 +773,14 @@ package body Sem_Elab is if Unit_Caller /= No_Unit and then Unit_Callee /= Unit_Caller and then not Dynamic_Elaboration_Checks + + -- This is an attempt to solve the problem of mishandling of + -- generic formal parameters, but it does not work right yet ??? + + -- and then not Used_As_Generic_Actual (Ent) then + -- It is here that things go wrong for calling a generic formal??? + E_Scope := Spec_Entity (Cunit_Entity (Unit_Caller)); -- If we don't get a spec entity, just ignore call. Not quite @@ -802,9 +806,7 @@ package body Sem_Elab is -- Loop to carefully follow renamings and derivations one step -- outside the current unit, but not further. - if not Inst_Case - and then Present (Alias (Ent)) - then + if not Inst_Case and then Present (Alias (Ent)) then E_Scope := Alias (Ent); else E_Scope := Ent; @@ -1182,7 +1184,7 @@ package body Sem_Elab is -- For an entry call, check relevant restriction if Nkind (N) = N_Entry_Call_Statement - and then not In_Subprogram_Or_Concurrent_Unit + and then not In_Subprogram_Or_Concurrent_Unit then Check_Restriction (No_Entry_Calls_In_Elaboration_Code, N); @@ -1339,9 +1341,8 @@ package body Sem_Elab is -- Filter out case of default expressions, where we do not -- do the check at this stage. - if Nkind (P) = N_Parameter_Specification - or else - Nkind (P) = N_Component_Declaration + if Nkind_In (P, N_Parameter_Specification, + N_Component_Declaration) then return; end if; @@ -1352,13 +1353,10 @@ package body Sem_Elab is if Nkind (P) = N_Protected_Body then return; - elsif Nkind (P) = N_Subprogram_Body - or else - Nkind (P) = N_Task_Body - or else - Nkind (P) = N_Block_Statement - or else - Nkind (P) = N_Entry_Body + elsif Nkind_In (P, N_Subprogram_Body, + N_Task_Body, + N_Block_Statement, + N_Entry_Body) then if L = Declarations (P) then exit; @@ -1499,9 +1497,7 @@ package body Sem_Elab is -- treat the current node as a call to each of these functions, to check -- their elaboration impact. - if Is_Init_Proc (Ent) - and then From_Elab_Code - then + if Is_Init_Proc (Ent) and then From_Elab_Code then Process_Init_Proc : declare Unit_Decl : constant Node_Id := Unit_Declaration_Node (Ent); @@ -1713,7 +1709,7 @@ package body Sem_Elab is begin if Nkind (Decl) = N_Object_Declaration and then (Present (Expression (Decl)) - or else No_Initialization (Decl)) + or else No_Initialization (Decl)) then return; end if; @@ -1842,9 +1838,7 @@ package body Sem_Elab is C_Scope := Current_Scope; - if Present (Outer_Scope) - and then Within (Scope (Ent), Outer_Scope) - then + if Present (Outer_Scope) and then Within (Scope (Ent), Outer_Scope) then Set_C_Scope; Check_A_Call (N, Ent, Outer_Scope, Inter_Unit_Only => False); @@ -1992,8 +1986,8 @@ package body Sem_Elab is -- code, do not trace past an accept statement, because the rendez- -- vous will happen after elaboration. - if (Nkind (Original_Node (N)) = N_Accept_Statement - or else Nkind (Original_Node (N)) = N_Selective_Accept) + if Nkind_In (Original_Node (N), N_Accept_Statement, + N_Selective_Accept) and then Restriction_Active (No_Entry_Calls_In_Elaboration_Code) then return Abandon; @@ -2021,8 +2015,8 @@ package body Sem_Elab is return OK; - -- If we have an access attribute for a subprogram, check - -- it. Suppress this behavior under debug flag. + -- If we have an access attribute for a subprogram, check it. + -- Suppress this behavior under debug flag. elsif not Debug_Flag_Dot_UU and then Nkind (N) = N_Attribute_Reference @@ -2086,10 +2080,7 @@ package body Sem_Elab is Sbody := Unit_Declaration_Node (E); - if Nkind (Sbody) /= N_Subprogram_Body - and then - Nkind (Sbody) /= N_Package_Body - then + if not Nkind_In (Sbody, N_Subprogram_Body, N_Package_Body) then Ebody := Corresponding_Body (Sbody); if No (Ebody) then @@ -2406,8 +2397,7 @@ package body Sem_Elab is if No (Corresponding_Body (Unit_Declaration_Node (Proc))) and then (not Is_Generic_Instance (Scope (Proc)) - or else - Scope (Proc) = Scope (Defining_Identifier (Decl))) + or else Scope (Proc) = Scope (Defining_Identifier (Decl))) then Error_Msg_Warn := SPARK_Mode /= On; Error_Msg_N @@ -2636,9 +2626,8 @@ package body Sem_Elab is -- that is, on which we need to place to elaboration flag. This happens -- with init proc calls. - if Is_Init_Proc (Subp) - or else Init_Call - then + if Is_Init_Proc (Subp) or else Init_Call then + -- The initialization call is on an object whose type is not declared -- in the same scope as the subprogram. The type of the object must -- be a subtype of the type of operation. This object is the first @@ -2996,9 +2985,7 @@ package body Sem_Elab is begin -- Check whether Id is a procedure with at least one parameter - if Ekind (Id) = E_Procedure - and then Present (First_Formal (Id)) - then + if Ekind (Id) = E_Procedure and then Present (First_Formal (Id)) then declare Typ : constant Entity_Id := Etype (First_Formal (Id)); Deep_Fin : Entity_Id := Empty; @@ -3025,10 +3012,8 @@ package body Sem_Elab is Fin := Find_Prim_Op (Typ, Name_Finalize); end if; - return - (Present (Deep_Fin) and then Id = Deep_Fin) - or else - (Present (Fin) and then Id = Fin); + return (Present (Deep_Fin) and then Id = Deep_Fin) + or else (Present (Fin) and then Id = Fin); end; end if; @@ -3100,11 +3085,7 @@ package body Sem_Elab is S1 := Scop1; while S1 /= Standard_Standard and then not Is_Compilation_Unit (S1) - and then (Ekind (S1) = E_Package - or else - Ekind (S1) = E_Protected_Type - or else - Ekind (S1) = E_Block) + and then Ekind_In (S1, E_Package, E_Protected_Type, E_Block) loop S1 := Scope (S1); end loop; @@ -3114,11 +3095,7 @@ package body Sem_Elab is S2 := Scop2; while S2 /= Standard_Standard and then not Is_Compilation_Unit (S2) - and then (Ekind (S2) = E_Package - or else - Ekind (S2) = E_Protected_Type - or else - Ekind (S2) = E_Block) + and then Ekind_In (S2, E_Package, E_Protected_Type, E_Block) loop S2 := Scope (S2); end loop; @@ -3172,8 +3149,8 @@ package body Sem_Elab is if Nkind (N) = N_Subprogram_Declaration then declare Ent : constant Entity_Id := Defining_Unit_Name (Specification (N)); - begin + begin -- Internal subprograms will already have a generated body, so -- there is no need to provide a stub for them. -- cgit v1.1