From: Anh Vo <anhvofrcaus@gmail.com>
Subject: Class Wide Type Invariants - My bug or compiler bug
Date: Tue, 25 Feb 2014 19:29:45 -0800 (PST)
Date: 2014-02-25T19:29:45-08:00 [thread overview]
Message-ID: <3b16296c-3a9b-478e-a113-44415f665121@googlegroups.com> (raw)
GNAT did not raise Assertion_Error where I thought it should for the following codes. Either I misunderstood the LRM or it is a compiler bug.
-- places.ads
package Places is
type Disc_Pt is tagged private
with Type_Invariant'Class => Check_In (Disc_Pt);
Initial_Disc_Pt : constant Disc_Pt;
function Check_In (D : Disc_Pt) return Boolean with Inline;
procedure Set_X_Coord (D : in out Disc_Pt; X : Float)
with Pre => (X >= -1.0 and then X <= 1.0);
procedure Set_Y_Coord (D : in out Disc_Pt; Y : Float)
with Pre => (Y >= -1.0 and then Y <= 1.0);
private
type Disc_Pt is tagged
record
X, Y : Float range -1.0 .. +1.0;
end record;
Initial_Disc_Pt : constant Disc_Pt := (others => 0.5);
end Places;
-- places.adb
package body Places is
function Check_In (D : Disc_Pt) return Boolean is
begin
return (D.X**2 + D.Y**2 <= 1.0);
end Check_In;
procedure Set_X_Coord (D : in out Disc_Pt; X : Float) is
begin
D.X := X;
end Set_X_Coord;
procedure Set_Y_Coord (D : in out Disc_Pt; Y : Float) is
begin
D.Y := Y;
end Set_Y_Coord;
end Places;
-- places.inner.ads
package Places.Inner is
type Ring_Pt is new Disc_Pt with private
with Type_Invariant'Class => Check_Out(Ring_Pt);
Initial_Ring_Pt : constant Ring_Pt;
function Check_Out (R : Ring_Pt) return Boolean
with Inline;
private
type Ring_Pt is new Disc_Pt with null record;
Initial_Ring_Pt : constant Ring_Pt := Ring_Pt'(Initial_Disc_Pt with null record);
function Check_Out (R : Ring_Pt) return Boolean is
(R.X**2 + R.Y**2 >= 0.25);
end Places.Inner;
-- invariants_inheritance_test.adb
with Ada.Text_Io;
with Ada.Exceptions; use Ada;
with Places.Inner;
procedure Invariants_Inheritance_Test is
use Text_Io;
Child_Pt : Places.Inner.Ring_Pt := Places.Inner.Initial_Ring_Pt;
begin
Places.Inner.Set_X_Coord(Child_Pt, 0.0); -- OK since 0.5**2 + 0.0 >= 0.25
Places.Inner.Set_Y_Coord(Child_Pt, 0.1); -- should fail Check_Out(...),
-- 0.1**2 + 0.0 < 0.25
exception
when Err : others =>
Put_Line ("Houston help!!! " & Exceptions.Exception_Information(Err));
end Invariants_Inheritance_Test;
next reply other threads:[~2014-02-26 3:29 UTC|newest]
Thread overview: 5+ messages / expand[flat|nested] mbox.gz Atom feed top
2014-02-26 3:29 Anh Vo [this message]
2014-02-26 22:35 ` Class Wide Type Invariants - My bug or compiler bug adambeneschan
2014-02-26 23:59 ` Anh Vo
2014-02-27 1:01 ` Randy Brukardt
2014-02-27 1:16 ` adambeneschan
replies disabled
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox