--- acats/new/c650b04.a 2016/01/23 01:25:06 1.3
+++ acats/new/c650b04.a 2016/01/23 04:12:19 1.4
@@ -41,8 +41,8 @@
-- TEST DESCRIPTION:
-- We try returning objects of types declared at various nesting levels.
-- Note that a type declared at an inner or parallel nesting level is
--- s can only occur at run-time when returned from
--- unction.
+-- not visible, and thus can only occur at run-time when passed in as
+-- a parameter.
--
-- The test cases here are derived from the legal cases in test
-- B650005, which tests the matching Legality Rule. (Obviously, we only
@@ -59,6 +59,7 @@
--
-- CHANGE HISTORY:
-- 21 Jan 2016 RLB Created test.
+-- 22 Jan 2016 RLB Added parameter subtests.
with F650B00_2, F650B00_3;
with Report, TCTouch;
@@ -77,6 +78,21 @@
return F650B00_2.Create; --- 'd'
end Get_Windmill;
+ function Return_Param (Obj : in F650B00_2.Windmill'Class;
+ Use_Ext : in Boolean)
+ return F650B00_2.Windmill'Class is
+ begin
+ if Use_Ext then
+ return Result : F650B00_2.Windmill'Class := Obj do
+ null; -- Might raise Program_Error,
+ -- depending upon the tag of the object.
+ end return;
+ else
+ return Obj; -- Might raise Program_Error,
+ -- depending upon the tag of the object.
+ end if;
+ end Return_Param;
+
function Test_Function (Subtest : in Natural)
return F650B00_2.Windmill'Class is
@@ -175,6 +191,23 @@
when 7 =>
return ACW.all; -- OK here, but P_E
-- for Test_Function.
+ when 8 =>
+ return Nest_Windmill'Class(
+ Return_Param (F650B00_2.Windmill'Class(IW_Obj),
+ Use_Ext => True)); -- P_E here.
+ when 9 =>
+ return Nest_Windmill'Class(
+ Return_Param (F650B00_2.Windmill'Class(IW_Obj),
+ Use_Ext => False)); -- P_E here.
+ when 10 =>
+ return Nest_Windmill'Class(
+ Return_Param (F650B00_2.Windmill'Class(N_Obj),
+ Use_Ext => True)); -- P_E here.
+ when 11 =>
+ return Nest_Windmill'Class(
+ Return_Param (F650B00_2.Windmill'Class(N_Obj),
+ Use_Ext => False)); -- P_E here.
+
when others =>
raise Constraint_Error with "Incorrect parameter";
end case;
@@ -241,6 +274,28 @@
when 17..23 =>
return F650B00_2.Windmill'Class(
Nest_Test_Function(Subtest-16, N_Obj'Access));
+ when 24..27 =>
+ return F650B00_2.Windmill'Class(
+ Nest_Test_Function(Subtest-16, N_Obj'Access));
+ when 28 =>
+ return Return_Param (F650B00_2.Windmill'Class(N_Obj),
+ Use_Ext => False); -- P_E.
+ when 29 =>
+ return Return_Param (F650B00_2.Windmill'Class(N_Obj),
+ Use_Ext => True); -- P_E.
+ when 30 =>
+ return Return_Param (F650B00_2.Windmill'Class(L_Obj),
+ Use_Ext => False); -- P_E.
+ when 31 =>
+ return Return_Param (F650B00_2.Windmill'Class(L_Obj),
+ Use_Ext => True); -- P_E.
+ when 32 =>
+ return Return_Param (Class_Obj,
+ Use_Ext => False); -- OK.
+ when 33 =>
+ return Return_Param (Class_Obj,
+ Use_Ext => True); -- OK.
+
when others =>
raise Constraint_Error with "Incorrect parameter";
end case;
@@ -274,7 +329,7 @@
--Report.Comment ("Test function raised Program_Error " &
-- "as expected (" & Natural'Image(Subtest) & ')');
else
- Report.Comment ("Test function unexpectedly raised " &
+ Report.Failed ("Test function unexpectedly raised " &
"Program_Error (" & Natural'Image(Subtest) & ')');
end if;
end Check_Result;
@@ -334,6 +389,26 @@
Check_Result (Base_RPM + 22, Fails => True, Subtest => 22);
Check_Result (Base_RPM + 23, Fails => True, Subtest => 23);
+
+ Check_Result (Base_RPM + 8, Fails => True, Subtest => 24);
+
+ Check_Result (Base_RPM + 9, Fails => True, Subtest => 25);
+
+ Check_Result (Base_RPM + 26, Fails => True, Subtest => 26);
+
+ Check_Result (Base_RPM + 27, Fails => True, Subtest => 27);
+
+ Check_Result (Base_RPM + 26, Fails => True, Subtest => 28);
+
+ Check_Result (Base_RPM + 27, Fails => True, Subtest => 29);
+
+ Check_Result (Base_RPM + 15, Fails => True, Subtest => 30);
+
+ Check_Result (Base_RPM + 15, Fails => True, Subtest => 31);
+
+ Check_Result (Base_RPM, Fails => False, Subtest => 32);
+
+ Check_Result (Base_RPM, Fails => False, Subtest => 33);
Report.Result;
end C650B04;
Questions? Ask the ACAA Technical Agent