[multiple changes]

2015-01-06  Arnaud Charlet  <charlet@adacore.com>

	* a-reatim.adb ("/"): Add explicit pragma Unsuppress (Division_Check).

2015-01-06  Robert Dewar  <dewar@adacore.com>

	* sem_prag.adb (Process_Suppress_Unsuppress): Add extra warning
	for ignoring pragma Suppress (Elaboration_Check) in SPARK mode.

2015-01-06  Javier Miranda  <miranda@adacore.com>

	* exp_disp.adb (Expand_Interface_Conversion): No displacement
	of the pointer to the object needed when the type of the operand
	is not an interface type and the interface is one of its parent
	types (since they share the primary dispatch table).

From-SVN: r219227

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a8f36b90dec161debc39828b85e3aa9acef8d639..64c02b3b572f2022b441758b07aa56d338afd5c4 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,19 @@
+2015-01-06  Arnaud Charlet  <charlet@adacore.com>
+
+       * a-reatim.adb ("/"): Add explicit pragma Unsuppress (Division_Check).
+
+2015-01-06  Robert Dewar  <dewar@adacore.com>
+
+       * sem_prag.adb (Process_Suppress_Unsuppress): Add extra warning
+       for ignoring pragma Suppress (Elaboration_Check) in SPARK mode.
+
+2015-01-06  Javier Miranda  <miranda@adacore.com>
+
+       * exp_disp.adb (Expand_Interface_Conversion): No displacement
+       of the pointer to the object needed when the type of the operand
+       is not an interface type and the interface is one of its parent
+       types (since they share the primary dispatch table).
+
 2015-01-06  Vincent Celier  <celier@adacore.com>
 
        * prj-env.adb: Minor comment update.

diff --git a/gcc/ada/a-reatim.adb b/gcc/ada/a-reatim.adb
index ef0632bc5bc1058b407734b49db0b83cabe9824d..f59d083b03c11b3859aeda8908fd883c0cb361b6 100644 (file)
--- a/gcc/ada/a-reatim.adb
+++ b/gcc/ada/a-reatim.adb
@@ -7,7 +7,7 @@
 --                                 B o d y                                  --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
---                     Copyright (C) 1995-2010, AdaCore                     --
+--                     Copyright (C) 1995-2014, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -114,12 +114,14 @@ package body Ada.Real_Time is
 
    function "/" (Left, Right : Time_Span) return Integer is
       pragma Unsuppress (Overflow_Check);
+      pragma Unsuppress (Division_Check);
    begin
       return Integer (Duration (Left) / Duration (Right));
    end "/";
 
    function "/" (Left : Time_Span; Right : Integer) return Time_Span is
       pragma Unsuppress (Overflow_Check);
+      pragma Unsuppress (Division_Check);
    begin
       return Time_Span (Duration (Left) / Right);
    end "/";

diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 99105e0ea4f1052aee2dc73522dfc9e975362279..302f7210b13a33f5f66619b6ace6e10c1608267c 100644 (file)
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -1138,6 +1138,25 @@ package body Exp_Disp is
          Operand_Typ := Base_Type (Corresponding_Record_Type (Operand_Typ));
       end if;
 
+      --  No displacement of the pointer to the object needed when the type of
+      --  the operand is not an interface type and the interface is one of
+      --  its parent types (since they share the primary dispatch table).
+
+      declare
+         Opnd : Entity_Id := Operand_Typ;
+
+      begin
+         if Is_Access_Type (Opnd) then
+            Opnd := Designated_Type (Opnd);
+         end if;
+
+         if not Is_Interface (Opnd)
+           and then Is_Ancestor (Iface_Typ, Opnd, Use_Full_View => True)
+         then
+            return;
+         end if;
+      end;
+
       --  Evaluate if we can statically displace the pointer to the object
 
       declare
@@ -1177,11 +1196,6 @@ package body Exp_Disp is
                        Prefix         => New_Occurrence_Of (Iface_Typ, Loc),
                        Attribute_Name => Name_Tag))));
             end if;
-
-            --  Just do a conversion ???
-
-            Rewrite (N, Unchecked_Convert_To (Etype (N), N));
-            Analyze (N);
          end if;
 
          return;

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 58acefdd7a79c890329a23f0947fa2efcc546115..207f4ba20eb5ff734fc6388abaffc64cd9e79a0a 100644 (file)
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -9050,7 +9050,9 @@ package body Sem_Prag is
 
          if C = Elaboration_Check and then SPARK_Mode = On then
             Error_Pragma_Arg
-              ("Suppress of Elaboration_Check ignored in SPARK??", Arg1);
+              ("Suppress of Elaboration_Check ignored in SPARK??",
+               "\elaboration checking rules are statically enforced "
+               & "(SPARK RM 7.7)", Arg1);
          end if;
 
          --  One-argument case