CVS difference for acats/new/b611006.a

Differences between 1.2 and version 1.3
Log of other versions for file acats/new/b611006.a

--- acats/new/b611006.a	2016/02/25 05:53:39	1.2
+++ acats/new/b611006.a	2016/03/29 06:12:09	1.3
@@ -66,6 +66,7 @@
 -- CHANGE HISTORY:
 --     04 Feb 2016   RLB   Created test.
 --     22 Feb 2016   RLB   Corrected operations of Intf to be abstract.
+--     28 Mar 2016   RLB   Generalized error messages, added location codes.
 --
 --!
 package B611006 is
@@ -77,20 +78,20 @@
    function Is_OK (Obj : Root) return Boolean;
 
    procedure Proc1 (Obj : in out Root)
-                                    with Pre'Class => Is_OK (Obj);   -- OK.
+                                with Pre'Class => Is_OK (Obj);   -- OK. {38}
 
    procedure Proc2 (Obj : in out Root)
-                                    with Post'Class => Is_OK (Obj);  -- OK.
+                                with Post'Class => Is_OK (Obj);  -- OK. {38}
 
    type Intf is limited interface;
 
    function Is_Old (Obj : Intf) return Boolean is abstract;
 
    procedure Proc3 (Obj : in out Intf) is abstract
-                                    with Pre'Class => Is_Old (Obj);  -- OK.
+                                with Pre'Class => Is_Old (Obj);  -- OK. {38}
 
    procedure Proc4 (Obj : in out Intf) is abstract
-                                    with Post'Class => Is_Old (Obj); -- OK.
+                                with Post'Class => Is_Old (Obj); -- OK. {38}
 
    type NRT is new Root with null record;
 
@@ -108,16 +109,16 @@
    -- First objective:
 
    procedure Proc1 (Obj : in out NRT)
-             with Pre'Class => Is_OK (Obj);                          -- OK.
+             with Pre'Class => Is_OK (Obj);                      -- OK. {19}
 
    procedure Proc2 (Obj : in out NRT)
-             with Post'Class => Is_OK (Obj);                         -- OK.
+             with Post'Class => Is_OK (Obj);                     -- OK. {19}
 
    procedure Proc3 (Obj : in out NRT)
-             with Pre'Class => Pack1.Is_Bad (Obj);                   -- ERROR:
+             with Pre'Class => Pack1.Is_Bad (Obj);               -- ERROR: {19}
 
    procedure Proc4 (Obj : in out NRT)
-             with Post'Class => Pack1.Is_Bad (Obj);                  -- ERROR:
+             with Post'Class => Pack1.Is_Bad (Obj);              -- ERROR: {19}
 
    -- As always, the situation with class-wide types is asymetrical:
    -- an object of a descendant of type NRT can be passed to a
@@ -126,22 +127,22 @@
    -- below is illegal, but Is_Cool is legal.
 
    procedure Proc5 (Obj : in out NRT)
-             with Pre'Class => Is_OK (Pack1.Fooey);                  -- ERROR:
+             with Pre'Class => Is_OK (Pack1.Fooey);              -- ERROR: {19}
 
    procedure Proc6 (Obj : in out NRT)
-             with Post'Class => Is_OK (Pack1.Fooey);                 -- ERROR:
+             with Post'Class => Is_OK (Pack1.Fooey);             -- ERROR: {19}
 
    procedure Proc7 (Obj : in out NRT)
-             with Pre'Class => Is_OK (Pack1.Blooey);                 -- ERROR:
+             with Pre'Class => Is_OK (Pack1.Blooey);             -- ERROR: {19}
 
    procedure Proc8 (Obj : in out NRT)
-             with Post'Class => Is_OK (Pack1.Blooey);                -- ERROR:
+             with Post'Class => Is_OK (Pack1.Blooey);            -- ERROR: {19}
 
    procedure Proc9 (Obj : in out NRT)
-             with Pre'Class => Pack1.Is_Cool (Obj);                  -- OK.
+             with Pre'Class => Pack1.Is_Cool (Obj);              -- OK.    {19}
 
    procedure ProcA (Obj : in out NRT)
-             with Post'Class => Pack1.Is_Cool (Obj);                 -- OK.
+             with Post'Class => Pack1.Is_Cool (Obj);             -- OK.    {19}
 
    -- Second objective:
    -- Note: Because an object of type T freezes type T, and we cannot
@@ -158,22 +159,22 @@
    Unrelated_Glob : Boolean := True;
 
    procedure ProcB (Obj : in out NRT)
-             with Pre'Class => Obj /= Specific_Glob.all;             -- ERROR:
+             with Pre'Class => Obj /= Specific_Glob.all;         -- ERROR: {19}
 
    procedure ProcC (Obj : in out NRT)
-             with Post'Class => Obj /= Specific_Glob.all;            -- ERROR:
+             with Post'Class => Obj /= Specific_Glob.all;        -- ERROR: {19}
 
    procedure ProcD (Obj : in out NRT)
-             with Pre'Class => Obj /= Classwide_Glob.all;            -- ERROR:
+             with Pre'Class => Obj /= Classwide_Glob.all;        -- ERROR: {19}
 
    procedure ProcE (Obj : in out NRT)
-             with Post'Class => Obj /= Classwide_Glob.all;           -- ERROR:
+             with Post'Class => Obj /= Classwide_Glob.all;       -- ERROR: {19}
 
    procedure ProcF (Obj : in out NRT)
-             with Pre'Class => Is_OK (Obj) and Unrelated_Glob;       -- OK.
+             with Pre'Class => Is_OK (Obj) and Unrelated_Glob;   -- OK. {19}
 
    procedure ProcG (Obj : in out NRT)
-             with Post'Class => Is_OK (Obj) and Unrelated_Glob;      -- OK.
+             with Post'Class => Is_OK (Obj) and Unrelated_Glob;  -- OK. {19}
 
    -- Third objective:
 
@@ -182,13 +183,13 @@
 
       function Is_OK (Obj : NAT) return Boolean is abstract;
 
-      procedure Proc1 (Obj : in out NAT);                            -- ERROR:
+      procedure Proc1 (Obj : in out NAT);                        -- ERROR: {7}
          -- The inherited Pre'Class expression Is_OK (Obj) makes
          -- a non-dispatching call on an abstract routine.
          -- A statically bound call of the form Proc1 (NAT(Some_Obj));
          -- would have to evaluate this expression.
 
-      procedure Proc2 (Obj : in out NAT) is abstract;                -- OK.
+      procedure Proc2 (Obj : in out NAT) is abstract;            -- OK. {7}
          -- We don't recheck class-wide precondition and postcondition
          -- expressions for abstract routines, as they can't be called,
          -- either with a statically bound call or through a dispatching
@@ -197,14 +198,15 @@
    end Pack2;
 
    package Pack3 is
-      type NAT2 is abstract new Root with null record;
+      type NAT2 is abstract new Root
+            with null record;                -- POSSIBLE ERROR: [Set1] {1:7}
 
       function Is_OK (Obj : NAT2) return Boolean is abstract;
 
-      procedure Proc1 (Obj : in out NAT2) is abstract;                -- OK.
+      procedure Proc1 (Obj : in out NAT2) is abstract;           -- OK. {7}
 
       -- Inherits procedure Proc2 (Obj : in out NAT2), which is illegal
-      -- for the same reason as above.                                -- ERROR:
+      -- for the same reason as above.       -- POSSIBLE ERROR: [Set1] {0;-1:0}
    end Pack3;
 
    package Pack4 is
@@ -218,13 +220,14 @@
       -- procedure Proc2 (Obj : in out NAT3), which are OK as Is_OK is not
       -- abstract.
 
-      procedure Proc3 (Obj : in out NAT3);                           -- ERROR:
+      procedure Proc3 (Obj : in out NAT3);                       -- ERROR: {7}
 
-      procedure Proc4 (Obj : in out NAT3) is abstract;               -- OK.
+      procedure Proc4 (Obj : in out NAT3) is abstract;           -- OK. {7}
    end Pack4;
 
    package Pack5 is
-      type NAT4 is abstract new Root and Intf with null record;
+      type NAT4 is abstract new Root and Intf
+          with null record;                  -- POSSIBLE ERROR: [Set2] {1:7}
 
       function Is_OK (Obj : NAT4) return Boolean;
 
@@ -234,10 +237,10 @@
       -- procedure Proc2 (Obj : in out NAT4), which are OK as Is_OK is not
       -- abstract.
 
-      procedure Proc3 (Obj : in out NAT4) is abstract;               -- OK.
+      procedure Proc3 (Obj : in out NAT4) is abstract;           -- OK. {7}
 
       -- Inherits procedure Proc4 (Obj : in out NAT4), which is illegal.
-                                                                     -- ERROR:
+                                             -- POSSIBLE ERROR: [Set2] {0;-1:0}
    end Pack5;
 
 end B611006;

Questions? Ask the ACAA Technical Agent