CVS difference for acats/new/bc40003.a

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

--- acats/new/bc40003.a	2018/06/13 06:35:57	1.1
+++ acats/new/bc40003.a	2018/09/08 02:52:44	1.2
@@ -32,26 +32,30 @@
 --     ISO/IEC 18009 and any applicable ACAA procedures.
 --*
 -- OBJECTIVE:
---  object with a null_exclusion or an
+--     For a generic formal in out object with a null_exclusion or an
 --     access_definition with a null_exclusion, check that an instantiation
 --     is illegal if the subtype of the actual object does not exclude null.
 --
 --     For an instance of a generic in the specification of an outer
--- ic formal object with a
+--     generic with a generic formal in out object with a
 --     null_exclusion or an access_definition with a null_exclusion whose
--- luding generic formal object of an outer generic,
--- tiation of the outer generic is illegal if the
--- l object does not exclude null.
+--     actual is a null excluding generic formal in out object of the outer
+--     generic, check that an instantiation of the outer generic is illegal if
+--     the subtype of the actual object does not exclude null.
 --
 --     For an instance of a generic in the body of an outer
--- ic formal object with a
+--     generic with a generic formal in out object with a
 --     null_exclusion or an access_definition with a null_exclusion whose
--- luding generic formal object of an outer generic,
--- nce is illegal if the formal object does
--- xclusion.
+--     actual is a null excluding generic formal in out object of the
+--     outer generic, check that the instance is illegal if the formal object
+--     does not include a null_exclusion.
 --
 -- CHANGE HISTORY:
 --     12 Jun 2018 RLB Created test from similar B851004.
+--     06 Sep 2018 RLB Corrected test to remove cases whose results might
+--                     change because of AI12-0287-1. (They should be replaced
+--                     in the Ada 2020 test suite.) Added additional "in out"
+--                     cases to cover cases that won't change by that AI.
 --
 procedure BC40003 is
 
@@ -90,11 +94,23 @@
    end Gen02;
 
    generic
+      GObj2 : in out not null access Integer;
+   package Gen02A is
+      B : Boolean := False;
+   end Gen02A;
+
+   generic
       GObj3 : not null Int_PS_Ptr;
    package Gen03 is
       B : Boolean := GObj3 /= null;
    end Gen03;
 
+   generic
+      GObj3 : in out not null Int_PS_Ptr;
+   package Gen03A is
+      B : Boolean := GObj3 /= null;
+   end Gen03A;
+
    type Func_Ptr is access function (X : Float) return Float;
    subtype NN_Func_Ptr is not null Func_Ptr;
    subtype NN2_Func_Ptr is NN_Func_Ptr;
@@ -106,19 +122,19 @@
    ObjE : not null access function (X : Float) return Float;
 
    generic
-      GObj4 : Func_Ptr;
+      GObj4 : in out Func_Ptr;
    package Gen04 is
       B : Boolean := GObj4 /= null;
    end Gen04;
 
    generic
-      GObj5 : not null Func_Ptr;
+      GObj5 : in out not null Func_Ptr;
    package Gen05 is
       B : Boolean := GObj5 /= null;
    end Gen05;
 
    generic
-      GObj6 : not null access function (X : Float) return Float;
+      GObj6 : in out not null access function (X : Float) return Float;
    package Gen06 is
       B : Boolean := False;
    end Gen06;
@@ -129,11 +145,19 @@
       package Inst11 is new Gen01 (Obj1);                -- ERROR: {7;1}
       package Inst21 is new Gen01 (Obj2);                -- OK. {7;1}
       package Inst31 is new Gen01 (Obj3);                -- OK. {7;1}
-      package Inst41 is new Gen02 (Obj4);                -- ERROR: {7;1}
+      --package Inst41 is new Gen02 (Obj4);              -- OK. {7;1}
+         -- Above is OK by AI12-0287-1, but was illegal by the original rules.
       package Inst51 is new Gen02 (Obj5);                -- OK. {7;1}
-      package Inst61 is new Gen03 (Obj6);                -- ERROR: {7;1}
-      package Inst71 is new Gen03 (Obj7);                -- ERROR: {7;1}
-      package Inst81 is new Gen03 (Obj8);                -- OK. {7;1}
+      package Inst61 is new Gen02A (Obj4);               -- ERROR: {7;1}
+      package Inst71 is new Gen02A (Obj5);               -- OK. {7;1}
+      --package Inst81 is new Gen03 (Obj6);              -- OK. {7;1}
+         -- Above is OK by AI12-0287-1, but was illegal by the original rules.
+      --package Inst91 is new Gen03 (Obj7);              -- OK. {7;1}
+         -- Above is OK by AI12-0287-1, but was illegal by the original rules.
+      package InstA1 is new Gen03 (Obj8);                -- OK. {7;1}
+      package InstB1 is new Gen03A (Obj6);               -- ERROR: {7;1}
+      package InstC1 is new Gen03A (Obj7);               -- ERROR: {7;1}
+      package InstD1 is new Gen03A (Obj8);               -- OK. {7;1}
 
       package InstX1 is new Gen00 (Obj1);                -- OK. {7;1}
       package InstY1 is new Gen00 (Obj2);                -- OK. {7;1}
@@ -157,20 +181,24 @@
          procedure Prim (A : access A_Tagged; B : access Integer) is
             package InstPA is new Gen07 (A);             -- OK. {13;1}
                -- (A is a controlling parameter, see 3.10(13.1/2)).
-            package InstPB is new Gen02 (B);             -- ERROR: {13;1}
+            --package InstPB is new Gen02 (B);           -- OK. {13;1}
+                 -- Above is OK by AI12-0287-1, but was an error by the
+                 -- original rules.
+            -- Note: We cannot write an error case here, as B is a constant,
+            -- an a generic in out parameter requires a variable.
          begin
             null;
          end Prim;
       end Pack;
 
-      package InstA1 is new Gen05 (ObjA);                -- ERROR: {7;1}
-      package InstB1 is new Gen05 (ObjB);                -- OK. {7;1}
-      package InstC1 is new Gen05 (ObjC);                -- OK. {7;1}
-      package InstD1 is new Gen06 (ObjD);                -- ERROR: {7;1}
-      package InstE1 is new Gen06 (ObjE);                -- OK. {7;1}
-      package InstF1 is new Gen04 (ObjA);                -- OK. {7;1}
-      package InstG1 is new Gen04 (ObjB);                -- OK. {7;1}
-      package InstH1 is new Gen04 (ObjC);                -- OK. {7;1}
+      package InstG1 is new Gen05 (ObjA);                -- ERROR: {7;1}
+      package InstH1 is new Gen05 (ObjB);                -- OK. {7;1}
+      package InstI1 is new Gen05 (ObjC);                -- OK. {7;1}
+      package InstJ1 is new Gen06 (ObjD);                -- ERROR: {7;1}
+      package InstK1 is new Gen06 (ObjE);                -- OK. {7;1}
+      package InstL1 is new Gen04 (ObjA);                -- OK. {7;1}
+      package InstM1 is new Gen04 (ObjB);                -- OK. {7;1}
+      package InstN1 is new Gen04 (ObjC);                -- OK. {7;1}
 
       -- Second objective:
 
@@ -197,7 +225,7 @@
       package Inst2_4 is new GenT2 (Obj1);               -- ERROR: {7;1}(Inst2)
 
       generic
-         GObj3 : NN_Func_Ptr;
+         GObj3 : in out NN_Func_Ptr;
       package GenT3 is
          package Inst3 is new Gen05 (GObj3);             -- OK. {10;1}
       private
@@ -208,7 +236,7 @@
       package Inst2_6 is new GenT3 (ObjA);               -- ERROR: {7;1}(Inst3)
 
       generic
-         GObj4 : NN2_Func_Ptr;
+         GObj4 : in out NN2_Func_Ptr;
       package GenT4 is
          package Inst4OK is new Gen04 (GObj4);           -- OK. {10;1}
       private
@@ -225,7 +253,17 @@
       end GenT5;
 
       package Inst2_9 is new GenT5 (Obj8);               -- OK. {7;1}
-      package Inst2_A is new GenT5 (Obj6);               -- ERROR: {7;1}(Inst5)
+      --package Inst2_A is new GenT5 (Obj6);             -- OK. {7;1}(Inst5)
+         -- Above is OK by AI12-0287-1, but was illegal by the original rules.
+
+      generic
+         GObj6 : in out NN_Int_PS_Ptr;
+      package GenT6 is
+         package Inst6 is new Gen03A (GObj6);            -- OK. {10;1}
+      end GenT6;
+
+      package Inst2_B is new GenT6 (Obj8);               -- OK. {7;1}
+      package Inst2_C is new GenT6 (Obj6);               -- ERROR: {7;1}(Inst6)
 
 
       -- Third objective:
@@ -237,6 +275,8 @@
          GObj4 : access Integer;
          GObj5 : not null Int_PS_Ptr;
          GObj6 : NN_Int_PS_Ptr;
+         GObj7 : in out not null Int_PS_Ptr;
+         GObj8 : in out NN_Int_PS_Ptr;
       package GenTA is
          procedure Dummy;
       end GenTA;
@@ -248,13 +288,20 @@
          package InstG12 is new Gen00 (GObj1);           -- OK. {10;1}
          package InstG21 is new Gen01 (GObj2);           -- OK. {10;1}
          package InstG31 is new Gen02 (GObj3);           -- OK. {10;1}
-         package InstG41 is new Gen02 (GObj4);           -- ERROR: {10;1}
-         package InstG51 is new Gen03 (GObj5);           -- ERROR: {10;1}
-         package InstG61 is new Gen03 (GObj6);           -- OK. {10;1}
+         --package InstG41 is new Gen02 (GObj4);         -- OK. {10;1}
+         -- Above is OK by AI12-0287-1, but was illegal by the original rules.
+         package InstG51 is new Gen03 (GObj5);           -- OK. {10;1}
+         --package InstG61 is new Gen03 (GObj6);         -- OK. {10;1}
+         -- Above is OK by AI12-0287-1, but was illegal by the original rules.
+         package InstG71 is new Gen03A (GObj7);          -- OK. {10;1}
+         package InstG81 is new Gen03A (GObj8);          -- ERROR: {10;1}
 
          procedure Dummy is
-            package InstG71 is new Gen01 (GObj1);        -- ERROR: {13;1}
-            package InstG81 is new Gen02 (GObj4);        -- ERROR: {13;1}
+            package InstG91 is new Gen01 (GObj1);        -- ERROR: {13;1}
+            --package InstGA1 is new Gen02 (GObj4);      -- OK. {13;1}
+              -- Above is OK by AI12-0287-1, but was an error by the
+              -- original rules.
+            package InstGB1 is new Gen03A (GObj8);       -- ERROR: {13;1}
          begin
             null;
          end Dummy;
@@ -262,10 +309,10 @@
       end GenTA;
 
       generic
-         GObj1 : NN_Func_Ptr;
-         GObj2 : not null Func_Ptr;
-         GObj3 : not null access function (X : Float) return Float;
-         GObj4 : access function (X : Float) return Float;
+         GObj1 : in out NN_Func_Ptr;
+         GObj2 : in out not null Func_Ptr;
+         GObj3 : in out not null access function (X : Float) return Float;
+         GObj4 : in out access function (X : Float) return Float;
       package GenTB is
          package Nest is
             procedure Dummy;

Questions? Ask the ACAA Technical Agent