c37213h.ada

来自「用于进行gcc测试」· ADA 代码 · 共 458 行 · 第 1/2 页

                    BEGIN
                         DECLARE
                              X : NREC;
                         BEGIN
                              FAILED ("INDEX CHECK NOT PERFORMED - 5");
                              IF X /= (1, (1, 1)) THEN
                                   COMMENT ("INCORRECT VALUES FOR X " &
                                            "- 5");
                              END IF;
                         END;
                    EXCEPTION
                         WHEN CONSTRAINT_ERROR =>
                              NULL;
                         WHEN OTHERS =>
                              FAILED ("UNEXPECTED EXCEPTION RAISED " &
                                       "- 5A");
                    END;
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 5B");
               END;

               BEGIN
                    DECLARE
                         TYPE ACC_CONS IS ACCESS CONS;
                    BEGIN
                         DECLARE
                              X : ACC_CONS;
                         BEGIN
                              X := NEW CONS;
                              FAILED ("INDEX CHECK NOT PERFORMED - 6");
                              IF X.ALL /= (1, (1, 1)) THEN
                                   COMMENT ("INCORRECT VALUES FOR X " &
                                            "- 6");
                              END IF;
                         EXCEPTION
                              WHEN CONSTRAINT_ERROR =>
                                   NULL;
                              WHEN OTHERS =>
                                   COMMENT ("UNEXPECTED EXCEPTION " &
                                            "RAISED - 6A");
                         END;
                    EXCEPTION
                         WHEN OTHERS =>
                              COMMENT ("UNEXPECTED EXCEPTION RAISED " &
                                       "- 6B");
                    END;
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 6C");
               END;
          END;


-- CASE D2: DISCRIMINANT-DEPENDENT COMPONENT IS ABSENT.

          F1_CONS := 2;

          SEQUENCE_NUMBER := 3;
          DECLARE
               TYPE CONS (D3 : DISCR := IDENT_INT(-6)) IS
                    RECORD
                         CASE D3 IS
                              WHEN -5..10 =>
                                   C1 : MY_ARR(D3..F1); -- F1 EVALUATED.
                              WHEN OTHERS =>
                                   C2 : INTEGER := IDENT_INT(0);
                         END CASE;
                    END RECORD;
               CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");

               X : CONS;                      -- F1 NOT EVALUATED AGAIN.
               Y : CONS;                      -- F1 NOT EVALUATED AGAIN.

               CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");
          BEGIN
               IF X /= (-6, 0) OR Y /= (-6, 0) THEN
                    FAILED ("VALUES NOT CORRECT");
               END IF;
          END;

          F1_CONS := 12;

          SEQUENCE_NUMBER := 4;
          DECLARE
               TYPE CONS (D3 : DISCR := IDENT_INT(11)) IS
                    RECORD
                         CASE D3 IS
                              WHEN -5..10 =>
                                   C1 : MY_ARR(D3..F1);
                              WHEN OTHERS =>
                                   C2 : INTEGER := IDENT_INT(0);
                         END CASE;
                    END RECORD;
          BEGIN
               BEGIN
                    DECLARE
                         X : CONS;
                    BEGIN
                         IF X /= (11, 0) THEN
                              FAILED ("X VALUE IS INCORRECT - 11");
                         END IF;
                    END;
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 11");
               END;

               BEGIN
                    DECLARE
                         SUBTYPE SCONS IS CONS;
                    BEGIN
                         DECLARE
                              X : SCONS;
                         BEGIN
                              IF X /= (11, 0) THEN
                                   FAILED ("X VALUE INCORRECT - 12");
                              END IF;
                         END;
                    EXCEPTION
                         WHEN OTHERS =>
                              FAILED ("UNEXPECTED EXCEPTION RAISED - " &
                                      "12A");
                    END;
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 12B");
               END;

               BEGIN
                    DECLARE
                         TYPE ARR IS ARRAY (1..5) OF CONS;
                    BEGIN
                         DECLARE
                              X : ARR;
                         BEGIN
                              IF X /= (1..5 => (11, 0)) THEN
                                   FAILED ("X VALUE INCORRECT - 13");
                              END IF;
                         END;
                    EXCEPTION
                         WHEN OTHERS =>
                              FAILED ("UNEXPECTED EXCEPTION RAISED - " &
                                      "13A");
                    END;
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 13B");
               END;

               BEGIN
                    DECLARE
                         TYPE NREC IS
                              RECORD
                                   C1 : CONS;
                              END RECORD;
                    BEGIN
                         DECLARE
                              X : NREC;
                         BEGIN
                              IF X /= (C1 => (11, 0)) THEN
                                   FAILED ("X VALUE INCORRECT - 14");
                              END IF;
                         END;
                    EXCEPTION
                         WHEN OTHERS =>
                              FAILED ("UNEXPECTED EXCEPTION RAISED - " &
                                      "14A");
                    END;
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 14B");
               END;

               BEGIN
                    DECLARE
                         TYPE NREC IS NEW CONS;
                    BEGIN
                         DECLARE
                              X : NREC;
                         BEGIN
                              IF X /= (11, 0) THEN
                                   FAILED ("X VALUE INCORRECT - 15");
                              END IF;
                         END;
                    EXCEPTION
                         WHEN CONSTRAINT_ERROR =>
                              NULL;
                         WHEN OTHERS =>
                              FAILED ("UNEXPECTED EXCEPTION RAISED - " &
                                      "15A");
                    END;
               EXCEPTION
                    WHEN OTHERS =>
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 15B");
               END;

               BEGIN
                    DECLARE
                         TYPE ACC_CONS IS ACCESS CONS;
                         X : ACC_CONS;
                    BEGIN
                         X := NEW CONS;
                         IF X.ALL /= (11, 0) THEN
                              FAILED ("X VALUE INCORRECT - 17");
                         END IF;
                    EXCEPTION
                         WHEN OTHERS =>
                              FAILED ("UNEXPECTED EXCEPTION RAISED - " &
                                      "17A");
                    END;
               EXCEPTION
                    WHEN OTHERS =>
                          FAILED ("UNEXPECTED EXCEPTION RAISED - 17B");
               END;
          END;

     EXCEPTION
          WHEN CONSTRAINT_ERROR =>
               FAILED ("INDEX VALUES IMPROPERLY CHECKED - " &
                       INTEGER'IMAGE (SEQUENCE_NUMBER));
          WHEN OTHERS =>
               FAILED ("UNEXPECTED EXCEPTION RAISED " &
                       INTEGER'IMAGE (SEQUENCE_NUMBER));
     END;

     RESULT;
END C37213H;