gcc/testsuite/ada/acats/tests/c4/c45273a.ada

   1 -- C45273A.ADA
   2
   3 --                             Grant of Unlimited Rights
   4 --
   5 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   6 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   7 --     unlimited rights in the software and documentation contained herein.
   8 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
   9 --     this public release, the Government intends to confer upon all
  10 --     recipients unlimited rights  equal to those held by the Government.
  11 --     These rights include rights to use, duplicate, release or disclose the
  12 --     released technical data and computer software in whole or in part, in
  13 --     any manner and for any purpose whatsoever, and to have or permit others
  14 --     to do so.
  15 --
  16 --                                    DISCLAIMER
  17 --
  18 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  19 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  20 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  21 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  22 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  23 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  24 --*
  25 -- OBJECTIVE:
  26 --     CHECK THAT EQUALITY AND INEQUALITY ARE EVALUATED CORRECTLY FOR
  27 --     RECORD OBJECTS HAVING DIFFERENT VALUES OF THE 'CONSTRAINED
  28 --     ATTRIBUTE.
  29
  30 -- HISTORY:
  31 --     TBN  08/07/86  CREATED ORIGINAL TEST.
  32 --     VCL  10/27/87  MODIFIED THIS HEADER; RELOCATED THE CALL TO
  33 --                    REPORT.TEST SO THAT IT COMES BEFORE ANY
  34 --                    DECLARATIONS; CHANGED THE 'ELSEIF' CONDITION IN
  35 --                    THE PROCEDURE 'PROC' SO THAT IT REFERS TO THE
  36 --                    FORMAL PARAMETERS.
  37
  38 WITH REPORT; USE REPORT;
  39 PROCEDURE C45273A IS
  40 BEGIN
  41      TEST ("C45273A", "EQUALITY AND INEQUALITY ARE " &
  42                       "EVALUATED CORRECTLY FOR RECORD OBJECTS HAVING " &
  43                       "DIFFERENT VALUES OF THE 'CONSTRAINED' " &
  44                       " ATTRIBUTE");
  45
  46      DECLARE
  47           SUBTYPE INT IS INTEGER RANGE 1 .. 20;
  48           TYPE REC_TYPE1 IS
  49                RECORD
  50                     A : INTEGER;
  51                END RECORD;
  52
  53           TYPE REC_TYPE2 (LEN : INT := 3) IS
  54                RECORD
  55                     A : STRING (1 .. LEN);
  56                END RECORD;
  57
  58           TYPE REC_TYPE3 (NUM : INT := 1) IS
  59                RECORD
  60                     A : REC_TYPE1;
  61                END RECORD;
  62
  63           REC1 : REC_TYPE2 (3) := (3, "WHO");
  64           REC2 : REC_TYPE2;
  65           REC3 : REC_TYPE2 (5) := (5, "WHERE");
  66           REC4 : REC_TYPE3;
  67           REC5 : REC_TYPE3 (1) := (1, A => (A => 5));
  68
  69           PROCEDURE PROC (PREC1 : REC_TYPE2;
  70                           PREC2 : IN OUT REC_TYPE2) IS
  71           BEGIN
  72                IF NOT (PREC1'CONSTRAINED) OR PREC2'CONSTRAINED THEN
  73                     FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
  74                             "ATTRIBUTE - 6");
  75                ELSIF PREC1 /= PREC2 THEN
  76                     FAILED ("INCORRECT RESULTS FOR RECORDS - 6");
  77                END IF;
  78                PREC2.A := "WHO";
  79           END PROC;
  80
  81      BEGIN
  82           REC2.A := "WHO";
  83           IF NOT (REC1'CONSTRAINED) OR REC2'CONSTRAINED THEN
  84                FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
  85                        "ATTRIBUTE - 1");
  86           ELSIF REC1 /= REC2 THEN
  87                FAILED ("INCORRECT RESULTS FOR RECORDS - 1");
  88           END IF;
  89
  90           IF REC2'CONSTRAINED OR NOT (REC3'CONSTRAINED) THEN
  91                FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
  92                        "ATTRIBUTE - 2");
  93           ELSIF REC2 = REC3 THEN
  94                FAILED ("INCORRECT RESULTS FOR RECORDS - 2");
  95           END IF;
  96
  97           REC2 := (5, "WHERE");
  98           IF REC2'CONSTRAINED OR NOT (REC3'CONSTRAINED) THEN
  99                FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
 100                        "ATTRIBUTE - 3");
 101           ELSIF REC2 /= REC3 THEN
 102                FAILED ("INCORRECT RESULTS FOR RECORDS - 3");
 103           END IF;
 104
 105           REC4.A.A := 5;
 106           IF REC4'CONSTRAINED OR NOT (REC5'CONSTRAINED) THEN
 107                FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
 108                        "ATTRIBUTE - 4");
 109           ELSIF REC4 /= REC5 THEN
 110                FAILED ("INCORRECT RESULTS FOR RECORDS - 4");
 111           END IF;
 112
 113           REC5.A := (A => 6);
 114           IF REC4'CONSTRAINED OR NOT (REC5'CONSTRAINED) THEN
 115                FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
 116                        "ATTRIBUTE - 5");
 117           ELSIF REC4 = REC5 THEN
 118                FAILED ("INCORRECT RESULTS FOR RECORDS - 5");
 119           END IF;
 120
 121           REC1.A := "WHY";
 122           REC2 := (3, "WHY");
 123           PROC (REC1, REC2);
 124           IF NOT (REC1'CONSTRAINED) OR REC2'CONSTRAINED THEN
 125                FAILED ("INCORRECT RESULTS FROM 'CONSTRAINED " &
 126                        "ATTRIBUTE - 7");
 127           ELSIF REC1 = REC2 THEN
 128                FAILED ("INCORRECT RESULTS FOR RECORDS - 7");
 129           END IF;
 130      END;
 131
 132      RESULT;
 133 END C45273A;