From 10dfac72b18e12e0879c9d4f83af3526e2ab3b8a Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 7 Jan 2015 11:26:56 +0100 Subject: [multiple changes] 2015-01-07 Ed Schonberg * exp_ch5.adb (Expand_Predicated_Loop): Handle properly loops over static predicates when the loop parameter specification carries a Reverse indicator. 2015-01-07 Ed Schonberg * sem_ch12.adb (Instantiate_Object): If formal has a default, actual is missing and formal has an anonymous access type, copy access definition in full so that tree for instance is properly formatted for ASIS use. 2015-01-07 Bob Duff * sem_elab.adb (Check_Internal_Call_Continue): Give a warning for P'Access, where P is a subprogram in the same package as the P'Access, and the P'Access is evaluated at elaboration time, and occurs before the body of P. For example, "X : T := P'Access;" would allow a subsequent call to X.all to be an access-before-elaboration error; hence the warning. This warning is enabled by the -gnatw.f switch. * opt.ads (Warn_On_Elab_Access): New flag for warning switch. * warnsw.adb (Set_Dot_Warning_Switch): Set Warn_On_Elab_Access. * gnat_ugn.texi: Document the new warning. From-SVN: r219293 --- gcc/ada/sem_elab.adb | 33 +++++++++++++++++++++++++-------- 1 file changed, 25 insertions(+), 8 deletions(-) (limited to 'gcc/ada/sem_elab.adb') diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 940f90f..227469a 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -1990,10 +1990,21 @@ package body Sem_Elab is Inst_Case : constant Boolean := Nkind (N) in N_Generic_Instantiation; begin - -- If not function or procedure call or instantiation, then ignore - -- call (this happens in some error cases and rewriting cases). + -- For P'Access, we want to warn if the -gnatw.f switch is set, and the + -- node comes from source. - if not Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement) + if Nkind (N) = N_Attribute_Reference and then + (not Warn_On_Elab_Access or else not Comes_From_Source (N)) + then + return; + + -- If not function or procedure call, instantiation, or 'Access, then + -- ignore call (this happens in some error cases and rewriting cases). + + elsif not Nkind_In + (N, N_Function_Call, + N_Procedure_Call_Statement, + N_Attribute_Reference) and then not Inst_Case then return; @@ -2001,7 +2012,7 @@ package body Sem_Elab is -- Nothing to do if this is a call or instantiation that has already -- been found to be a sure ABE. - elsif ABE_Is_Certain (N) then + elsif Nkind (N) /= N_Attribute_Reference and then ABE_Is_Certain (N) then return; -- Nothing to do if errors already detected (avoid cascaded errors) @@ -2323,7 +2334,7 @@ package body Sem_Elab is -- Not that special case, warning and dynamic check is required -- If we have nothing in the call stack, then this is at the outer - -- level, and the ABE is bound to occur. + -- level, and the ABE is bound to occur, unless it's a 'Access. if Elab_Call.Last = 0 then Error_Msg_Warn := SPARK_Mode /= On; @@ -2331,13 +2342,19 @@ package body Sem_Elab is if Inst_Case then Error_Msg_NE ("cannot instantiate& before body seen<<", N, Orig_Ent); - else + elsif Nkind (N) /= N_Attribute_Reference then Error_Msg_NE ("cannot call& before body seen<<", N, Orig_Ent); + else + Error_Msg_NE + ("Access attribute of & before body seen<<", N, Orig_Ent); + Error_Msg_N ("\possible Program_Error on later references<", N); end if; - Error_Msg_N ("\Program_Error [<<", N); - Insert_Elab_Check (N); + if Nkind (N) /= N_Attribute_Reference then + Error_Msg_N ("\Program_Error [<<", N); + Insert_Elab_Check (N); + end if; -- Call is not at outer level -- cgit v1.1