diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c3/c392013.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/c3/c392013.a | 179 |
1 files changed, 0 insertions, 179 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c3/c392013.a b/gcc/testsuite/ada/acats/tests/c3/c392013.a deleted file mode 100644 index 3873d9e62d5..00000000000 --- a/gcc/testsuite/ada/acats/tests/c3/c392013.a +++ /dev/null @@ -1,179 +0,0 @@ --- C392013.A --- --- Grant of Unlimited Rights --- --- The Ada Conformity Assessment Authority (ACAA) holds unlimited --- rights in the software and documentation contained herein. Unlimited --- rights are the same as those granted by the U.S. Government for older --- parts of the Ada Conformity Assessment Test Suite, and are defined --- in DFAR 252.227-7013(a)(19). By making this public release, the ACAA --- intends to confer upon all recipients unlimited rights equal to those --- held by the ACAA. These rights include rights to use, duplicate, --- release or disclose the released technical data and computer software --- in whole or in part, in any manner and for any purpose whatsoever, and --- to have or permit others to do so. --- --- DISCLAIMER --- --- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR --- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED --- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE --- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE --- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A --- PARTICULAR PURPOSE OF SAID MATERIAL. ---* --- --- OBJECTIVE: --- Check that the "/=" implicitly declared with the declaration of "=" for --- a tagged type is legal and can be used in a dispatching call. --- (Defect Report 8652/0010, as reflected in Technical Corrigendum 1). --- --- CHANGE HISTORY: --- 23 JAN 2001 PHL Initial version. --- 16 MAR 2001 RLB Readied for release; added identity and negative --- result cases. --- 24 MAY 2001 RLB Corrected the result for the 9 vs. 9 case. ---! -with Report; -use Report; -procedure C392013 is - - package P1 is - type T is tagged - record - C1 : Integer; - end record; - function "=" (L, R : T) return Boolean; - end P1; - - package P2 is - type T is new P1.T with private; - function Make (Ancestor : P1.T; X : Float) return T; - private - type T is new P1.T with - record - C2 : Float; - end record; - function "=" (L, R : T) return Boolean; - end P2; - - package P3 is - type T is new P2.T with - record - C3 : Character; - end record; - private - function "=" (L, R : T) return Boolean; - function Make (Ancestor : P1.T; X : Float) return T; - end P3; - - - package body P1 is separate; - package body P2 is separate; - package body P3 is separate; - - - type Cwat is access P1.T'Class; - type Cwat_Array is array (Positive range <>) of Cwat; - - A : constant Cwat_Array := - (1 => new P1.T'(C1 => Ident_Int (3)), - 2 => new P2.T'(P2.Make (Ancestor => (C1 => Ident_Int (5)), X => 4.0)), - 3 => new P2.T'(P2.Make (Ancestor => (C1 => Ident_Int (-5)), X => 4.2)), - 4 => new P1.T'(C1 => Ident_Int (-3)), - 5 => new P2.T'(P2.Make (Ancestor => (C1 => Ident_Int (5)), X => 3.6)), - 6 => new P1.T'(C1 => Ident_Int (4)), - 7 => new P3.T'(P2.Make - (Ancestor => (C1 => Ident_Int (4)), X => 1.2) with - Ident_Char ('a')), - 8 => new P3.T'(P2.Make - (Ancestor => (C1 => Ident_Int (-4)), X => 1.3) with - Ident_Char ('A')), - 9 => new P3.T'(P2.Make - (Ancestor => (C1 => Ident_Int (4)), X => 1.0) with - Ident_Char ('B'))); - - type Truth is ('F', 'T'); - type Truth_Table is array (Positive range <>, Positive range <>) of Truth; - - Equality : constant Truth_Table (A'Range, A'Range) := ("TFFTFFFFF", - "FTTFTFFFF", - "FTTFFFFFF", - "TFFTFFFFF", - "FTFFTFFFF", - "FFFFFTFFF", - "FFFFFFTTF", - "FFFFFFTTF", - "FFFFFFFFT"); - -begin - Test ("C392013", "Check that the ""/="" implicitly declared " & - "with the declaration of ""="" for a tagged " & - "type is legal and can be used in a dispatching call"); - - for I in A'Range loop - for J in A'Range loop - -- Test identity: - if P1."=" (A (I).all, A (J).all) /= - (not P1."/=" (A (I).all, A (J).all)) then - Failed ("Incorrect identity comparing objects" & - Positive'Image (I) & " and" & Positive'Image (J)); - end if; - -- Test the result of "/=": - if Equality (I, J) = 'T' then - if P1."/=" (A (I).all, A (J).all) then - Failed ("Incorrect result comparing objects" & - Positive'Image (I) & " and" & Positive'Image (J) & " - T"); - end if; - else - if not P1."/=" (A (I).all, A (J).all) then - Failed ("Incorrect result comparing objects" & - Positive'Image (I) & " and" & Positive'Image (J) & " - F"); - end if; - end if; - end loop; - end loop; - - Result; -end C392013; -separate (C392013) -package body P1 is - - function "=" (L, R : T) return Boolean is - begin - return abs L.C1 = abs R.C1; - end "="; - -end P1; -separate (C392013) -package body P2 is - - function "=" (L, R : T) return Boolean is - begin - return P1."=" (P1.T (L), P1.T (R)) and then abs (L.C2 - R.C2) <= 0.5; - end "="; - - - function Make (Ancestor : P1.T; X : Float) return T is - begin - return (Ancestor with X); - end Make; - -end P2; -with Ada.Characters.Handling; -separate (C392013) -package body P3 is - - function "=" (L, R : T) return Boolean is - begin - return P2."=" (P2.T (L), P2.T (R)) and then - Ada.Characters.Handling.To_Upper (L.C3) = - Ada.Characters.Handling.To_Upper (R.C3); - end "="; - - function Make (Ancestor : P1.T; X : Float) return T is - begin - return (P2.Make (Ancestor, X) with ' '); - end Make; - -end P3; |