-- C731001.A
|
-- C731001.A
|
--
|
--
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
|
-- F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
|
-- F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
|
-- software and documentation contained herein. Unlimited rights are
|
-- software and documentation contained herein. Unlimited rights are
|
-- defined in DFAR 252.227-7013(a)(19). By making this public release,
|
-- defined in DFAR 252.227-7013(a)(19). By making this public release,
|
-- the Government intends to confer upon all recipients unlimited rights
|
-- the Government intends to confer upon all recipients unlimited rights
|
-- equal to those held by the Government. These rights include rights to
|
-- equal to those held by the Government. These rights include rights to
|
-- use, duplicate, release or disclose the released technical data and
|
-- use, duplicate, release or disclose the released technical data and
|
-- computer software in whole or in part, in any manner and for any purpose
|
-- computer software in whole or in part, in any manner and for any purpose
|
-- whatsoever, and to have or permit others to do so.
|
-- whatsoever, and to have or permit others to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
--
|
--
|
-- OBJECTIVE
|
-- OBJECTIVE
|
-- Check that inherited operations can be overridden, even when they are
|
-- Check that inherited operations can be overridden, even when they are
|
-- inherited in a body.
|
-- inherited in a body.
|
-- The test cases here are inspired by the AARM examples given in
|
-- The test cases here are inspired by the AARM examples given in
|
-- the discussion of AARM-7.3.1(7.a-7.v).
|
-- the discussion of AARM-7.3.1(7.a-7.v).
|
-- This discussion was confirmed by AI95-00035.
|
-- This discussion was confirmed by AI95-00035.
|
--
|
--
|
-- TEST DESCRIPTION
|
-- TEST DESCRIPTION
|
-- See AARM-7.3.1.
|
-- See AARM-7.3.1.
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 29 JUN 1999 RAD Initial Version
|
-- 29 JUN 1999 RAD Initial Version
|
-- 23 SEP 1999 RLB Improved comments, renamed, issued.
|
-- 23 SEP 1999 RLB Improved comments, renamed, issued.
|
-- 20 AUG 2001 RLB Corrected 'verbose' flag.
|
-- 20 AUG 2001 RLB Corrected 'verbose' flag.
|
--
|
--
|
--!
|
--!
|
|
|
with Report; use Report; pragma Elaborate_All(Report);
|
with Report; use Report; pragma Elaborate_All(Report);
|
package C731001_1 is
|
package C731001_1 is
|
pragma Elaborate_Body;
|
pragma Elaborate_Body;
|
private
|
private
|
procedure Check_String(X, Y: String);
|
procedure Check_String(X, Y: String);
|
function Check_String(X, Y: String) return String;
|
function Check_String(X, Y: String) return String;
|
-- This one is a function, so we can call it in package specs.
|
-- This one is a function, so we can call it in package specs.
|
end C731001_1;
|
end C731001_1;
|
|
|
package body C731001_1 is
|
package body C731001_1 is
|
|
|
Verbose: Boolean := False;
|
Verbose: Boolean := False;
|
|
|
procedure Check_String(X, Y: String) is
|
procedure Check_String(X, Y: String) is
|
begin
|
begin
|
if Verbose then
|
if Verbose then
|
Comment("""" & X & """ = """ & Y & """?");
|
Comment("""" & X & """ = """ & Y & """?");
|
end if;
|
end if;
|
if X /= Y then
|
if X /= Y then
|
Failed("""" & X & """ should be """ & Y & """");
|
Failed("""" & X & """ should be """ & Y & """");
|
end if;
|
end if;
|
end Check_String;
|
end Check_String;
|
|
|
function Check_String(X, Y: String) return String is
|
function Check_String(X, Y: String) return String is
|
begin
|
begin
|
Check_String(X, Y);
|
Check_String(X, Y);
|
return X;
|
return X;
|
end Check_String;
|
end Check_String;
|
|
|
end C731001_1;
|
end C731001_1;
|
|
|
private package C731001_1.Parent is
|
private package C731001_1.Parent is
|
|
|
procedure Call_Main;
|
procedure Call_Main;
|
|
|
type Root is tagged null record;
|
type Root is tagged null record;
|
subtype Renames_Root is Root;
|
subtype Renames_Root is Root;
|
subtype Root_Class is Renames_Root'Class;
|
subtype Root_Class is Renames_Root'Class;
|
function Make return Root;
|
function Make return Root;
|
function Op1(X: Root) return String;
|
function Op1(X: Root) return String;
|
function Call_Op2(X: Root'Class) return String;
|
function Call_Op2(X: Root'Class) return String;
|
private
|
private
|
function Op2(X: Root) return String;
|
function Op2(X: Root) return String;
|
end C731001_1.Parent;
|
end C731001_1.Parent;
|
|
|
procedure C731001_1.Parent.Main;
|
procedure C731001_1.Parent.Main;
|
|
|
with C731001_1.Parent.Main;
|
with C731001_1.Parent.Main;
|
package body C731001_1.Parent is
|
package body C731001_1.Parent is
|
|
|
procedure Call_Main is
|
procedure Call_Main is
|
begin
|
begin
|
Main;
|
Main;
|
end Call_Main;
|
end Call_Main;
|
|
|
function Make return Root is
|
function Make return Root is
|
Result: Root;
|
Result: Root;
|
begin
|
begin
|
return Result;
|
return Result;
|
end Make;
|
end Make;
|
|
|
function Op1(X: Root) return String is
|
function Op1(X: Root) return String is
|
begin
|
begin
|
return "Parent.Op1 body";
|
return "Parent.Op1 body";
|
end Op1;
|
end Op1;
|
|
|
function Op2(X: Root) return String is
|
function Op2(X: Root) return String is
|
begin
|
begin
|
return "Parent.Op2 body";
|
return "Parent.Op2 body";
|
end Op2;
|
end Op2;
|
|
|
function Call_Op2(X: Root'Class) return String is
|
function Call_Op2(X: Root'Class) return String is
|
begin
|
begin
|
return Op2(X);
|
return Op2(X);
|
end Call_Op2;
|
end Call_Op2;
|
|
|
begin
|
begin
|
|
|
Check_String(Op1(Root'(Make)), "Parent.Op1 body");
|
Check_String(Op1(Root'(Make)), "Parent.Op1 body");
|
Check_String(Op1(Root_Class(Root'(Make))), "Parent.Op1 body");
|
Check_String(Op1(Root_Class(Root'(Make))), "Parent.Op1 body");
|
|
|
Check_String(Op2(Root'(Make)), "Parent.Op2 body");
|
Check_String(Op2(Root'(Make)), "Parent.Op2 body");
|
Check_String(Op2(Root_Class(Root'(Make))), "Parent.Op2 body");
|
Check_String(Op2(Root_Class(Root'(Make))), "Parent.Op2 body");
|
|
|
end C731001_1.Parent;
|
end C731001_1.Parent;
|
|
|
with C731001_1.Parent; use C731001_1.Parent;
|
with C731001_1.Parent; use C731001_1.Parent;
|
private package C731001_1.Unrelated is
|
private package C731001_1.Unrelated is
|
|
|
type T2 is new Root with null record;
|
type T2 is new Root with null record;
|
subtype T2_Class is T2'Class;
|
subtype T2_Class is T2'Class;
|
function Make return T2;
|
function Make return T2;
|
function Op2(X: T2) return String;
|
function Op2(X: T2) return String;
|
end C731001_1.Unrelated;
|
end C731001_1.Unrelated;
|
|
|
with C731001_1.Parent; use C731001_1.Parent;
|
with C731001_1.Parent; use C731001_1.Parent;
|
pragma Elaborate(C731001_1.Parent);
|
pragma Elaborate(C731001_1.Parent);
|
package body C731001_1.Unrelated is
|
package body C731001_1.Unrelated is
|
|
|
function Make return T2 is
|
function Make return T2 is
|
Result: T2;
|
Result: T2;
|
begin
|
begin
|
return Result;
|
return Result;
|
end Make;
|
end Make;
|
|
|
function Op2(X: T2) return String is
|
function Op2(X: T2) return String is
|
begin
|
begin
|
return "Unrelated.Op2 body";
|
return "Unrelated.Op2 body";
|
end Op2;
|
end Op2;
|
begin
|
begin
|
|
|
Check_String(Op1(T2'(Make)), "Parent.Op1 body");
|
Check_String(Op1(T2'(Make)), "Parent.Op1 body");
|
Check_String(Op1(T2_Class(T2'(Make))), "Parent.Op1 body");
|
Check_String(Op1(T2_Class(T2'(Make))), "Parent.Op1 body");
|
Check_String(Op1(Root_Class(T2'(Make))), "Parent.Op1 body");
|
Check_String(Op1(Root_Class(T2'(Make))), "Parent.Op1 body");
|
|
|
Check_String(Op2(T2'(Make)), "Unrelated.Op2 body");
|
Check_String(Op2(T2'(Make)), "Unrelated.Op2 body");
|
Check_String(Op2(T2_Class(T2'(Make))), "Unrelated.Op2 body");
|
Check_String(Op2(T2_Class(T2'(Make))), "Unrelated.Op2 body");
|
Check_String(Call_Op2(T2'(Make)), "Parent.Op2 body");
|
Check_String(Call_Op2(T2'(Make)), "Parent.Op2 body");
|
Check_String(Call_Op2(T2_Class(T2'(Make))), "Parent.Op2 body");
|
Check_String(Call_Op2(T2_Class(T2'(Make))), "Parent.Op2 body");
|
Check_String(Call_Op2(Root_Class(T2'(Make))), "Parent.Op2 body");
|
Check_String(Call_Op2(Root_Class(T2'(Make))), "Parent.Op2 body");
|
|
|
end C731001_1.Unrelated;
|
end C731001_1.Unrelated;
|
|
|
package C731001_1.Parent.Child is
|
package C731001_1.Parent.Child is
|
pragma Elaborate_Body;
|
pragma Elaborate_Body;
|
|
|
type T3 is new Root with null record;
|
type T3 is new Root with null record;
|
subtype T3_Class is T3'Class;
|
subtype T3_Class is T3'Class;
|
function Make return T3;
|
function Make return T3;
|
|
|
T3_Obj: T3;
|
T3_Obj: T3;
|
T3_Class_Obj: T3_Class := T3_Obj;
|
T3_Class_Obj: T3_Class := T3_Obj;
|
T3_Root_Class_Obj: Root_Class := T3_Obj;
|
T3_Root_Class_Obj: Root_Class := T3_Obj;
|
|
|
X3: constant String :=
|
X3: constant String :=
|
Check_String(Op1(T3_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T3_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T3_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T3_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T3_Root_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T3_Root_Class_Obj), "Parent.Op1 body") &
|
|
|
Check_String(Call_Op2(T3_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T3_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T3_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T3_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T3_Root_Class_Obj), "Parent.Op2 body");
|
Check_String(Call_Op2(T3_Root_Class_Obj), "Parent.Op2 body");
|
|
|
package Nested is
|
package Nested is
|
type T4 is new Root with null record;
|
type T4 is new Root with null record;
|
subtype T4_Class is T4'Class;
|
subtype T4_Class is T4'Class;
|
function Make return T4;
|
function Make return T4;
|
|
|
T4_Obj: T4;
|
T4_Obj: T4;
|
T4_Class_Obj: T4_Class := T4_Obj;
|
T4_Class_Obj: T4_Class := T4_Obj;
|
T4_Root_Class_Obj: Root_Class := T4_Obj;
|
T4_Root_Class_Obj: Root_Class := T4_Obj;
|
|
|
X4: constant String :=
|
X4: constant String :=
|
Check_String(Op1(T4_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
|
|
|
Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body");
|
Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body");
|
|
|
private
|
private
|
|
|
XX4: constant String :=
|
XX4: constant String :=
|
Check_String(Op1(T4_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
|
|
|
Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body");
|
Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body");
|
|
|
end Nested;
|
end Nested;
|
|
|
use Nested;
|
use Nested;
|
|
|
XXX4: constant String :=
|
XXX4: constant String :=
|
Check_String(Op1(T4_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
|
|
|
Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body");
|
Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body");
|
|
|
private
|
private
|
|
|
XX3: constant String :=
|
XX3: constant String :=
|
Check_String(Op1(T3_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T3_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T3_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T3_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T3_Root_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T3_Root_Class_Obj), "Parent.Op1 body") &
|
|
|
Check_String(Call_Op2(T3_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T3_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T3_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T3_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T3_Root_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T3_Root_Class_Obj), "Parent.Op2 body") &
|
|
|
Check_String(Op2(T3_Obj), "Parent.Op2 body") &
|
Check_String(Op2(T3_Obj), "Parent.Op2 body") &
|
Check_String(Op2(T3_Class_Obj), "Parent.Op2 body") &
|
Check_String(Op2(T3_Class_Obj), "Parent.Op2 body") &
|
Check_String(Op2(T3_Root_Class_Obj), "Parent.Op2 body");
|
Check_String(Op2(T3_Root_Class_Obj), "Parent.Op2 body");
|
|
|
XXXX4: constant String :=
|
XXXX4: constant String :=
|
Check_String(Op1(T4_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
|
|
|
Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body") &
|
|
|
Check_String(Op2(T4_Root_Class_Obj), "Parent.Op2 body");
|
Check_String(Op2(T4_Root_Class_Obj), "Parent.Op2 body");
|
|
|
end C731001_1.Parent.Child;
|
end C731001_1.Parent.Child;
|
|
|
with C731001_1.Unrelated; use C731001_1.Unrelated;
|
with C731001_1.Unrelated; use C731001_1.Unrelated;
|
pragma Elaborate(C731001_1.Unrelated);
|
pragma Elaborate(C731001_1.Unrelated);
|
package body C731001_1.Parent.Child is
|
package body C731001_1.Parent.Child is
|
|
|
XXX3: constant String :=
|
XXX3: constant String :=
|
Check_String(Op1(T3_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T3_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T3_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T3_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T3_Root_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T3_Root_Class_Obj), "Parent.Op1 body") &
|
|
|
Check_String(Call_Op2(T3_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T3_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T3_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T3_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T3_Root_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T3_Root_Class_Obj), "Parent.Op2 body") &
|
|
|
Check_String(Op2(T3_Obj), "Parent.Op2 body") &
|
Check_String(Op2(T3_Obj), "Parent.Op2 body") &
|
Check_String(Op2(T3_Class_Obj), "Parent.Op2 body") &
|
Check_String(Op2(T3_Class_Obj), "Parent.Op2 body") &
|
Check_String(Op2(T3_Root_Class_Obj), "Parent.Op2 body");
|
Check_String(Op2(T3_Root_Class_Obj), "Parent.Op2 body");
|
|
|
XXXXX4: constant String :=
|
XXXXX4: constant String :=
|
Check_String(Op1(T4_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
|
|
|
Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body") &
|
|
|
Check_String(Op2(T4_Root_Class_Obj), "Parent.Op2 body");
|
Check_String(Op2(T4_Root_Class_Obj), "Parent.Op2 body");
|
|
|
function Make return T3 is
|
function Make return T3 is
|
Result: T3;
|
Result: T3;
|
begin
|
begin
|
return Result;
|
return Result;
|
end Make;
|
end Make;
|
|
|
package body Nested is
|
package body Nested is
|
function Make return T4 is
|
function Make return T4 is
|
Result: T4;
|
Result: T4;
|
begin
|
begin
|
return Result;
|
return Result;
|
end Make;
|
end Make;
|
|
|
XXXXXX4: constant String :=
|
XXXXXX4: constant String :=
|
Check_String(Op1(T4_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
|
|
|
Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body") &
|
|
|
Check_String(Op2(T4_Obj), "Parent.Op2 body") &
|
Check_String(Op2(T4_Obj), "Parent.Op2 body") &
|
Check_String(Op2(T4_Class_Obj), "Parent.Op2 body") &
|
Check_String(Op2(T4_Class_Obj), "Parent.Op2 body") &
|
Check_String(Op2(T4_Root_Class_Obj), "Parent.Op2 body");
|
Check_String(Op2(T4_Root_Class_Obj), "Parent.Op2 body");
|
|
|
end Nested;
|
end Nested;
|
|
|
type T5 is new T2 with null record;
|
type T5 is new T2 with null record;
|
subtype T5_Class is T5'Class;
|
subtype T5_Class is T5'Class;
|
function Make return T5;
|
function Make return T5;
|
|
|
function Make return T5 is
|
function Make return T5 is
|
Result: T5;
|
Result: T5;
|
begin
|
begin
|
return Result;
|
return Result;
|
end Make;
|
end Make;
|
|
|
XXXXXXX4: constant String :=
|
XXXXXXX4: constant String :=
|
Check_String(Op1(T4_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
|
Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body") &
|
|
|
Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body") &
|
Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body") &
|
|
|
Check_String(Op2(T4_Root_Class_Obj), "Parent.Op2 body");
|
Check_String(Op2(T4_Root_Class_Obj), "Parent.Op2 body");
|
|
|
end C731001_1.Parent.Child;
|
end C731001_1.Parent.Child;
|
|
|
procedure C731001_1.Main;
|
procedure C731001_1.Main;
|
|
|
with C731001_1.Parent;
|
with C731001_1.Parent;
|
procedure C731001_1.Main is
|
procedure C731001_1.Main is
|
begin
|
begin
|
C731001_1.Parent.Call_Main;
|
C731001_1.Parent.Call_Main;
|
end C731001_1.Main;
|
end C731001_1.Main;
|
|
|
with C731001_1.Parent.Child;
|
with C731001_1.Parent.Child;
|
use C731001_1.Parent;
|
use C731001_1.Parent;
|
use C731001_1.Parent.Child;
|
use C731001_1.Parent.Child;
|
use C731001_1.Parent.Child.Nested;
|
use C731001_1.Parent.Child.Nested;
|
with C731001_1.Unrelated; use C731001_1.Unrelated;
|
with C731001_1.Unrelated; use C731001_1.Unrelated;
|
procedure C731001_1.Parent.Main is
|
procedure C731001_1.Parent.Main is
|
|
|
Root_Obj: Root := Make;
|
Root_Obj: Root := Make;
|
Root_Class_Obj: Root_Class := Root'(Make);
|
Root_Class_Obj: Root_Class := Root'(Make);
|
|
|
T2_Obj: T2 := Make;
|
T2_Obj: T2 := Make;
|
T2_Class_Obj: T2_Class := T2_Obj;
|
T2_Class_Obj: T2_Class := T2_Obj;
|
T2_Root_Class_Obj: Root_Class := T2_Class_Obj;
|
T2_Root_Class_Obj: Root_Class := T2_Class_Obj;
|
|
|
T3_Obj: T3 := Make;
|
T3_Obj: T3 := Make;
|
T3_Class_Obj: T3_Class := T3_Obj;
|
T3_Class_Obj: T3_Class := T3_Obj;
|
T3_Root_Class_Obj: Root_Class := T3_Obj;
|
T3_Root_Class_Obj: Root_Class := T3_Obj;
|
|
|
T4_Obj: T4 := Make;
|
T4_Obj: T4 := Make;
|
T4_Class_Obj: T4_Class := T4_Obj;
|
T4_Class_Obj: T4_Class := T4_Obj;
|
T4_Root_Class_Obj: Root_Class := T4_Obj;
|
T4_Root_Class_Obj: Root_Class := T4_Obj;
|
|
|
begin
|
begin
|
Test("C731001_1", "Check that inherited operations can be overridden, even"
|
Test("C731001_1", "Check that inherited operations can be overridden, even"
|
& " when they are inherited in a body");
|
& " when they are inherited in a body");
|
|
|
Check_String(Op1(Root_Obj), "Parent.Op1 body");
|
Check_String(Op1(Root_Obj), "Parent.Op1 body");
|
Check_String(Op1(Root_Class_Obj), "Parent.Op1 body");
|
Check_String(Op1(Root_Class_Obj), "Parent.Op1 body");
|
|
|
Check_String(Call_Op2(Root_Obj), "Parent.Op2 body");
|
Check_String(Call_Op2(Root_Obj), "Parent.Op2 body");
|
Check_String(Call_Op2(Root_Class_Obj), "Parent.Op2 body");
|
Check_String(Call_Op2(Root_Class_Obj), "Parent.Op2 body");
|
|
|
Check_String(Op1(T2_Obj), "Parent.Op1 body");
|
Check_String(Op1(T2_Obj), "Parent.Op1 body");
|
Check_String(Op1(T2_Class_Obj), "Parent.Op1 body");
|
Check_String(Op1(T2_Class_Obj), "Parent.Op1 body");
|
Check_String(Op1(T2_Root_Class_Obj), "Parent.Op1 body");
|
Check_String(Op1(T2_Root_Class_Obj), "Parent.Op1 body");
|
|
|
Check_String(Op2(T2_Obj), "Unrelated.Op2 body");
|
Check_String(Op2(T2_Obj), "Unrelated.Op2 body");
|
Check_String(Op2(T2_Class_Obj), "Unrelated.Op2 body");
|
Check_String(Op2(T2_Class_Obj), "Unrelated.Op2 body");
|
Check_String(Call_Op2(T2_Obj), "Parent.Op2 body");
|
Check_String(Call_Op2(T2_Obj), "Parent.Op2 body");
|
Check_String(Call_Op2(T2_Class_Obj), "Parent.Op2 body");
|
Check_String(Call_Op2(T2_Class_Obj), "Parent.Op2 body");
|
Check_String(Call_Op2(T2_Root_Class_Obj), "Parent.Op2 body");
|
Check_String(Call_Op2(T2_Root_Class_Obj), "Parent.Op2 body");
|
|
|
Check_String(Op1(T3_Obj), "Parent.Op1 body");
|
Check_String(Op1(T3_Obj), "Parent.Op1 body");
|
Check_String(Op1(T3_Class_Obj), "Parent.Op1 body");
|
Check_String(Op1(T3_Class_Obj), "Parent.Op1 body");
|
Check_String(Op1(T3_Root_Class_Obj), "Parent.Op1 body");
|
Check_String(Op1(T3_Root_Class_Obj), "Parent.Op1 body");
|
|
|
Check_String(Call_Op2(T3_Obj), "Parent.Op2 body");
|
Check_String(Call_Op2(T3_Obj), "Parent.Op2 body");
|
Check_String(Call_Op2(T3_Class_Obj), "Parent.Op2 body");
|
Check_String(Call_Op2(T3_Class_Obj), "Parent.Op2 body");
|
Check_String(Call_Op2(T3_Root_Class_Obj), "Parent.Op2 body");
|
Check_String(Call_Op2(T3_Root_Class_Obj), "Parent.Op2 body");
|
|
|
Check_String(Op1(T4_Obj), "Parent.Op1 body");
|
Check_String(Op1(T4_Obj), "Parent.Op1 body");
|
Check_String(Op1(T4_Class_Obj), "Parent.Op1 body");
|
Check_String(Op1(T4_Class_Obj), "Parent.Op1 body");
|
Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body");
|
Check_String(Op1(T4_Root_Class_Obj), "Parent.Op1 body");
|
|
|
Check_String(Call_Op2(T4_Obj), "Parent.Op2 body");
|
Check_String(Call_Op2(T4_Obj), "Parent.Op2 body");
|
Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body");
|
Check_String(Call_Op2(T4_Class_Obj), "Parent.Op2 body");
|
Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body");
|
Check_String(Call_Op2(T4_Root_Class_Obj), "Parent.Op2 body");
|
|
|
Result;
|
Result;
|
end C731001_1.Parent.Main;
|
end C731001_1.Parent.Main;
|
|
|
with C731001_1.Main;
|
with C731001_1.Main;
|
procedure C731001 is
|
procedure C731001 is
|
begin
|
begin
|
C731001_1.Main;
|
C731001_1.Main;
|
end C731001;
|
end C731001;
|
|
|
