CVS difference for acats/new/b611003.a
--- acats/new/b611003.a 2016/02/05 05:44:25 1.1
+++ acats/new/b611003.a 2016/03/29 06:12:09 1.2
@@ -52,6 +52,7 @@
--
-- CHANGE HISTORY:
-- 04 Feb 2016 RLB Created test.
+-- 28 Mar 2016 RLB Added error location codes.
--
--!
package B611003 is
@@ -67,10 +68,10 @@
function Is_OK (Obj : in Intf) return Boolean is abstract;
procedure Proc1 (Obj : in out Intf) is null
- with Pre'Class => Is_OK (Obj); -- OK.
+ with Pre'Class => Is_OK (Obj); -- OK. {35;1}
procedure Proc2 (Obj : in out Intf) is null
- with Post'Class => Is_OK (Obj); -- OK.
+ with Post'Class => Is_OK (Obj); -- OK. {35;1}
type Root is tagged record
C : Character;
@@ -79,75 +80,75 @@
function Is_Old (Obj : in Root) return Boolean;
procedure Proc3 (Obj : in out Root)
- with Pre'Class => Is_Old (Obj); -- OK.
+ with Pre'Class => Is_Old (Obj); -- OK. {35;1}
procedure Proc4 (Obj : in out Root)
- with Post'Class => Is_Old (Obj); -- OK.
+ with Post'Class => Is_Old (Obj); -- OK. {35;1}
---- First objective:
generic
procedure GProc1 (Obj : in out Intf)
- with Pre'Class => Is_OK (Obj); -- ERROR:
+ with Pre'Class => Is_OK (Obj); -- ERROR: {35;1}
generic
procedure GProc2 (Obj : in out Intf)
- with Post'Class => Is_OK (Obj); -- ERROR:
+ with Post'Class => Is_OK (Obj); -- ERROR: {35;1}
generic
procedure GProc3 (Obj : in out Root)
- with Pre'Class => Is_Old (Obj); -- ERROR:
+ with Pre'Class => Is_Old (Obj); -- ERROR: {35;1}
generic
procedure GProc4 (Obj : in out Root)
- with Post'Class => Is_Old (Obj); -- ERROR:
+ with Post'Class => Is_Old (Obj); -- ERROR: {35;1}
---- Second objective:
procedure Proc5 (Obj : in out Natural)
- with Pre'Class => Obj mod 2 = 0; -- ERROR:
+ with Pre'Class => Obj mod 2 = 0; -- ERROR: {35;1}
procedure Proc6 (Obj : in out Natural)
- with Post'Class => Obj mod 2 = 0; -- ERROR:
+ with Post'Class => Obj mod 2 = 0; -- ERROR: {35;1}
package Nest is
procedure NProc1 (Obj : in out Intf) is null
- with Pre'Class => Is_OK (Obj); -- ERROR:
+ with Pre'Class => Is_OK (Obj); -- ERROR: {35;1}
procedure NProc2 (Obj : in out Intf) is null
- with Post'Class => Is_OK (Obj); -- ERROR:
+ with Post'Class => Is_OK (Obj); -- ERROR: {35;1}
procedure NProc3 (Obj : in out Root) is null
- with Pre'Class => Is_Old (Obj); -- ERROR:
+ with Pre'Class => Is_Old (Obj); -- ERROR: {35;1}
procedure NProc4 (Obj : in out Root) is null
- with Post'Class => Is_Old (Obj); -- ERROR:
+ with Post'Class => Is_Old (Obj); -- ERROR: {35;1}
procedure IProc1 is new Gen (Root)
- with Pre'Class => Is_OK (Obj); -- ERROR:
+ with Pre'Class => Is_OK (Obj); -- ERROR: {35;1}
procedure IProc2 is new Gen (Root)
- with Post'Class => Is_OK (Obj); -- ERROR:
+ with Post'Class => Is_OK (Obj); -- ERROR: {35;1}
procedure IProc3 is new Gen (Root)
- with Pre'Class => Is_Old (Obj); -- ERROR:
+ with Pre'Class => Is_Old (Obj); -- ERROR: {35;1}
procedure IProc4 is new Gen (Root)
- with Post'Class => Is_Old (Obj); -- ERROR:
+ with Post'Class => Is_Old (Obj); -- ERROR: {35;1}
end Nest;
procedure CProc1 (Obj : in out Intf'Class)
- with Pre'Class => Is_OK (Obj); -- ERROR:
+ with Pre'Class => Is_OK (Obj); -- ERROR: {35;1}
procedure CProc2 (Obj : in out Intf'Class)
- with Post'Class => Is_OK (Obj); -- ERROR:
+ with Post'Class => Is_OK (Obj); -- ERROR: {35;1}
procedure CProc3 (Obj : in out Root'Class)
- with Pre'Class => Is_Old (Obj); -- ERROR:
+ with Pre'Class => Is_Old (Obj); -- ERROR: {35;1}
procedure CProc4 (Obj : in out Root'Class)
- with Post'Class => Is_Old (Obj); -- ERROR:
+ with Post'Class => Is_Old (Obj); -- ERROR: {35;1}
generic
type Gen_Tagged is tagged limited private;
@@ -156,44 +157,46 @@
function Is_OK (Obj : in Gen_Tagged) return Boolean;
procedure Proc1 (Obj : in out Gen_Tagged)
- with Pre'Class => Is_OK (Obj); -- ERROR:
+ with Pre'Class => Is_OK (Obj); -- ERROR: {35;1}
procedure Proc2 (Obj : in out Gen_Tagged)
- with Post'Class => Is_OK (Obj); -- ERROR:
+ with Post'Class => Is_OK (Obj); -- ERROR: {35;1}
-- Subprograms with parameters of New_Gen_Tagged are primitive.
type New_Gen_Tagged is new Gen_Tagged with null record;
function Is_OK (Obj : in New_Gen_Tagged) return Boolean;
procedure Proc3 (Obj : in out New_Gen_Tagged)
- with Pre'Class => Is_OK (Obj); -- OK.
+ with Pre'Class => Is_OK (Obj); -- OK. {35;1}
procedure Proc4 (Obj : in out New_Gen_Tagged)
- with Post'Class => Is_OK (Obj); -- OK.
+ with Post'Class => Is_OK (Obj); -- OK. {35;1}
end GenP;
---- Third objective:
- package Nest1 with Pre'Class => Glob > 0 is -- ERROR:
+ package Nest1 with Pre'Class => Glob > 0 is -- ERROR: {23;3}
procedure P (Arg : in out Root);
end Nest1;
- package Nest2 with Post'Class => Glob = 0 is -- ERROR:
+ package Nest2 with Post'Class => Glob = 0 is -- ERROR: {23;3}
procedure P (Arg : in out Root);
end Nest2;
- Fooey1 : Root := (C => 'A') with Pre'Class => Is_Old(Fooey1); -- ERROR:
+ Fooey1 : Root := (C => 'A')
+ with Pre'Class => Is_Old(Fooey1); -- ERROR: {29;1}
- Fooey2 : Root := (C => 'A') with Post'Class => Is_Old(Fooey2); -- ERROR:
+ Fooey2 : Root := (C => 'A')
+ with Post'Class => Is_Old(Fooey2); -- ERROR: {29;1}
type Rec1 is tagged record
C : Character;
- end record with Pre'Class => Is_OK(Rec1); -- ERROR:
+ end record with Pre'Class => Is_OK(Rec1); -- ERROR: {20;1}
function Is_OK (Obj : in Rec1) return Boolean;
- type Rec2 is tagged private with Post'Class => Is_OK(Rec2); -- ERROR:
+ type Rec2 is tagged private with Post'Class => Is_OK(Rec2); -- ERROR: {37;1}
function Is_OK (Obj : in Rec2) return Boolean;
Questions? Ask the ACAA Technical Agent