* 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).
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@219227
138bc75d-0d04-0410-961f-
82ee72b054a4
+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.
-- 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- --
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 "/";
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
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;
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