From 88f47280999b57fce68aeee692d1820f12fc8264 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 4 Aug 2011 15:05:56 +0200 Subject: [PATCH] [multiple changes] 2011-08-04 Pascal Obry * urealp.adb: Minor reformatting. 2011-08-04 Tristan Gingold * exp_ch7.adb (build_finalizer.process_declarations.processing_actions): Handle the case when Cleanup_Protected_Object returns Empty. 2011-08-04 Yannick Moy * frontend.adb (Frontend): only qualify names in non-ALFA mode 2011-08-04 Ed Schonberg * sem_ch4.adb (Try_Class_Wide_Operation): if the context is a procedure call, ignore functions. From-SVN: r177377 --- gcc/ada/ChangeLog | 18 ++++++++++++++++++ gcc/ada/exp_ch7.adb | 6 ++++-- gcc/ada/frontend.adb | 12 +++++++----- gcc/ada/sem_ch4.adb | 13 ++++++++++++- gcc/ada/urealp.adb | 6 +++++- 5 files changed, 46 insertions(+), 9 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e42cd8e0863..2895bd877c1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2011-08-04 Pascal Obry + + * urealp.adb: Minor reformatting. + +2011-08-04 Tristan Gingold + + * exp_ch7.adb (build_finalizer.process_declarations.processing_actions): + Handle the case when Cleanup_Protected_Object returns Empty. + +2011-08-04 Yannick Moy + + * frontend.adb (Frontend): only qualify names in non-ALFA mode + +2011-08-04 Ed Schonberg + + * sem_ch4.adb (Try_Class_Wide_Operation): if the context is a procedure + call, ignore functions. + 2011-08-04 Geert Bosch * urealp.adb (Equivalent_Decimal_Exponent): Avoid the use of floating diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 357f9ef7d1c..9a648e5fb5d 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -2419,8 +2419,10 @@ package body Exp_Ch7 is Fin_Stmts := No_List; if Is_Simple_Protected_Type (Obj_Typ) then - Fin_Stmts := - New_List (Cleanup_Protected_Object (Decl, Obj_Ref)); + Fin_Call := Cleanup_Protected_Object (Decl, Obj_Ref); + if Present (Fin_Call) then + Fin_Stmts := New_List (Fin_Call); + end if; elsif Has_Simple_Protected_Object (Obj_Typ) then if Is_Record_Type (Obj_Typ) then diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index fd83b5d5b5c..02a272f9d88 100644 --- a/gcc/ada/frontend.adb +++ b/gcc/ada/frontend.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, 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- -- @@ -370,11 +370,13 @@ begin end if; -- Qualify all entity names in inner packages, package bodies, etc., - -- except when compiling for the VM back-ends, which depend on - -- having unqualified names in certain cases and handles the - -- generation of qualified names when needed. + -- except when compiling for the VM back-ends, which depend on having + -- unqualified names in certain cases and handles the generation of + -- qualified names when needed, and when compiling for formal verification, + -- in which the back-end calls directly Qualify_All_Entity_Names after some + -- preprocessing which uses the non-qualified names. - if VM_Target = No_VM then + if VM_Target = No_VM and then not ALFA_Mode then Exp_Dbug.Qualify_All_Entity_Names; end if; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 5850c3c59e4..f1b53fca670 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -6866,6 +6866,16 @@ package body Sem_Ch4 is (Designated_Type (Etype (First_Formal (Hom)))) = Cls_Type)) then + -- If the context is a procedure call, ignore functions + -- in the name of the call. + + if Ekind (Hom) = E_Function + and then Nkind (Parent (N)) = N_Procedure_Call_Statement + and then N = Name (Parent (N)) + then + goto Next_Hom; + end if; + Set_Etype (Call_Node, Any_Type); Set_Is_Overloaded (Call_Node, False); Success := False; @@ -6907,7 +6917,8 @@ package body Sem_Ch4 is end if; end if; - Hom := Homonym (Hom); + <> + Hom := Homonym (Hom); end loop; end Traverse_Homonyms; diff --git a/gcc/ada/urealp.adb b/gcc/ada/urealp.adb index e11235f3769..029789938f1 100644 --- a/gcc/ada/urealp.adb +++ b/gcc/ada/urealp.adb @@ -149,7 +149,7 @@ package body Urealp is function Store_Ureal_Normalized (Val : Ureal_Entry) return Ureal; pragma Inline (Store_Ureal_Normalized); - -- Like Store_Ureal, but normalizes its operand first. + -- Like Store_Ureal, but normalizes its operand first ------------------------- -- Decimal_Exponent_Hi -- @@ -276,6 +276,10 @@ package body Urealp is function Scale (X : Int; R : Ratio) return Int; -- Compute the value of X scaled by R + ----------- + -- Scale -- + ----------- + function Scale (X : Int; R : Ratio) return Int is type Wide_Int is range -2**63 .. 2**63 - 1; -- 2.30.2