[multiple changes]

2011-08-04  Pascal Obry  <obry@adacore.com>

	* urealp.adb: Minor reformatting.

2011-08-04  Tristan Gingold  <gingold@adacore.com>

	* exp_ch7.adb (build_finalizer.process_declarations.processing_actions):
	Handle the case when Cleanup_Protected_Object returns Empty.

2011-08-04  Yannick Moy  <moy@adacore.com>

	* frontend.adb (Frontend): only qualify names in non-ALFA mode

2011-08-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Try_Class_Wide_Operation): if the context is a procedure
	call, ignore functions.

From-SVN: r177377

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e42cd8e..2895bd8 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,21 @@
+2011-08-04  Pascal Obry  <obry@adacore.com>
+
+       * urealp.adb: Minor reformatting.
+
+2011-08-04  Tristan Gingold  <gingold@adacore.com>
+
+       * exp_ch7.adb (build_finalizer.process_declarations.processing_actions):
+       Handle the case when Cleanup_Protected_Object returns Empty.
+
+2011-08-04  Yannick Moy  <moy@adacore.com>
+
+       * frontend.adb (Frontend): only qualify names in non-ALFA mode
+
+2011-08-04  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch4.adb (Try_Class_Wide_Operation): if the context is a procedure
+       call, ignore functions.
+
 2011-08-04  Geert Bosch  <bosch@adacore.com>
 
        * 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 357f9ef..9a648e5 100644 (file)
--- 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 fd83b5d..02a272f 100644 (file)
--- 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 5850c3c..f1b53fc 100644 (file)
--- 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);
+               <<Next_Hom>>
+                  Hom := Homonym (Hom);
             end loop;
          end Traverse_Homonyms;
 

diff --git a/gcc/ada/urealp.adb b/gcc/ada/urealp.adb
index e11235f..0297899 100644 (file)
--- 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;