cc1224a.ada

来自「Mac OS X 10.4.9 for x86 Source Code gcc」· ADA 代码 · 共 559 行 · 第 1/2 页

          IF B3 (3) /= FA3 (3) THEN
               REPORT.FAILED ("INCORRECT RESULTS - 11" );
          END IF;

          B4 := FARR4'(FA5'RANGE (1) => (FA5'RANGE (2) => T1'VAL (4)));

          IF B4 (4, 4) /= FA4 (4, 4) THEN
               REPORT.FAILED ("INCORRECT RESULTS - 12" );
          END IF;

          B5 := FARR5'(REPORT.IDENT_INT (1) .. 
                       REPORT.IDENT_INT (6) =>  (1 .. 6 => 5));

          IF B5 (5, 5) /= FA5 (5, 5) THEN
               REPORT.FAILED ("INCORRECT RESULTS - 13" );
          END IF;

          B6 := FARR6'(FA6'RANGE => X2);

          IF B6 (T1'FIRST) /= FA6 (T1'FIRST) THEN
               REPORT.FAILED ("INCORRECT RESULTS - 14" );
          END IF;

          IF B1 NOT IN FARR1 THEN
               REPORT.FAILED ("INCORRECT RESULTS - 15" );
          END IF;

          IF FA2 NOT IN FARR2 THEN
               REPORT.FAILED ("INCORRECT RESULTS - 16" );
          END IF;

          IF FA3 NOT IN FARR3 THEN
               REPORT.FAILED ("INCORRECT RESULTS - 17" );
          END IF;

          IF B4 NOT IN FARR4 THEN
               REPORT.FAILED ("INCORRECT RESULTS - 18" );
          END IF;

          IF B5 NOT IN FARR5 THEN
               REPORT.FAILED ("INCORRECT RESULTS - 19" );
          END IF;

          IF FA6 NOT IN FARR6 THEN
               REPORT.FAILED ("INCORRECT RESULTS - 20" );
          END IF;

          IF FA1'LENGTH /= FA1'LAST - FA1'FIRST + 1 THEN
               REPORT.FAILED ("INCORRECT RESULTS - 27" );
          END IF;

          IF FA2'LENGTH /= FA2'LAST - FA2'FIRST + 1 THEN
               REPORT.FAILED ("INCORRECT RESULTS - 28" );
          END IF;

          IF FA3'LENGTH /= FA3'LAST - FA3'FIRST + 1 THEN
               REPORT.FAILED ("INCORRECT RESULTS - 29" );
          END IF;

          IF FA4'LENGTH /= FA4'LAST - FA4'FIRST + 1 THEN
               REPORT.FAILED ("INCORRECT RESULTS - 30" );
          END IF;

          IF FA4'LENGTH (2) /= FA4'LAST (2) - FA4'FIRST (2) + 1 THEN
               REPORT.FAILED ("INCORRECT RESULTS - 31" );
          END IF;

          IF FA5'LENGTH /= FA5'LAST - FA5'FIRST + 1 THEN
               REPORT.FAILED ("INCORRECT RESULTS - 32" );
          END IF;

          IF FA5'LENGTH (2) /= FA5'LAST (2) - FA5'FIRST (2) + 1 THEN
               REPORT.FAILED ("INCORRECT RESULTS - 33" );
          END IF;

          IF FA6'LENGTH /= T1'POS (FA6'LAST) - 
             T1'POS (FA6'FIRST) + 1 THEN
               REPORT.FAILED ("INCORRECT RESULTS - 34" );
          END IF;

     END P ;

     PROCEDURE TEST_PROCEDURE (FIRST        : IN UNCONSTRAINED_ARRAY ;
                               FFIFS        : IN FIRST_INDEX ;
                               FFILS        : IN FIRST_INDEX ;
                               FSIFS        : IN SECOND_INDEX ;
                               FSILS        : IN SECOND_INDEX ;
                               FFLEN        : IN NATURAL ;
                               FSLEN        : IN NATURAL ;
                               FFIRT        : IN FIRST_INDEX ;
                               FSIRT        : IN SECOND_INDEX ;
                               SECOND       : IN UNCONSTRAINED_ARRAY ;
                               SFIFS        : IN FIRST_INDEX ;
                               SFILS        : IN FIRST_INDEX ;
                               SSIFS        : IN SECOND_INDEX ;
                               SSILS        : IN SECOND_INDEX ;
                               SFLEN        : IN NATURAL ;
                               SSLEN        : IN NATURAL ;
                               SFIRT        : IN FIRST_INDEX ;
                               SSIRT        : IN SECOND_INDEX ;
                               REMARKS      : IN STRING) IS

     BEGIN -- TEST_PROCEDURE

          IF (FIRST'FIRST /= FFIFS) OR
             (FIRST'FIRST (1) /= FFIFS) OR
             (FIRST'FIRST (2) /= FSIFS) OR
             (SECOND'FIRST /= SFIFS) OR
             (SECOND'FIRST (1) /= SFIFS) OR
             (SECOND'FIRST (2) /= SSIFS) THEN
               REPORT.FAILED ("PROBLEMS WITH 'FIRST. " & REMARKS) ;
          END IF ;

          IF (FIRST'LAST /= FFILS) OR
             (FIRST'LAST (1) /= FFILS) OR
             (FIRST'LAST (2) /= FSILS) OR
             (SECOND'LAST /= SFILS) OR
             (SECOND'LAST (1) /= SFILS) OR
             (SECOND'LAST (2) /= SSILS) THEN
               REPORT.FAILED ("PROBLEMS WITH 'LAST. " & REMARKS) ;
          END IF ;

          IF (FIRST'LENGTH /= FFLEN) OR
             (FIRST'LENGTH (1) /= FFLEN) OR
             (FIRST'LENGTH (2) /= FSLEN) OR
             (SECOND'LENGTH /= SFLEN) OR
             (SECOND'LENGTH (1) /= SFLEN) OR
             (SECOND'LENGTH (2) /= SSLEN) THEN
               REPORT.FAILED ("PROBLEMS WITH 'LENGTH. " & REMARKS) ;
          END IF ;

          IF (FFIRT NOT IN FIRST'RANGE (1)) OR
             (FFIRT NOT IN FIRST'RANGE) OR
             (SFIRT NOT IN SECOND'RANGE (1)) OR
             (SFIRT NOT IN SECOND'RANGE) OR
             (FSIRT NOT IN FIRST'RANGE (2)) OR
             (SSIRT NOT IN SECOND'RANGE (2)) THEN
               REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUE. " &
                              REMARKS) ;
          END IF ;

     END TEST_PROCEDURE ;

     PROCEDURE CTEST_PROCEDURE (FIRST        : IN CONSTRAINED_ARRAY ;
                                FFIRT        : IN FIRST_INDEX ;
                                FSIRT        : IN SECOND_INDEX ;
                                SECOND       : IN CONSTRAINED_ARRAY ;
                                SFIRT        : IN FIRST_INDEX ;
                                SSIRT        : IN SECOND_INDEX ;
                                REMARKS      : IN STRING) IS

     BEGIN -- CTEST_PROCEDURE

          IF (FIRST'FIRST /= FIRST_INDEX'FIRST) OR
             (FIRST'FIRST (1) /= FIRST_INDEX'FIRST) OR
             (FIRST'FIRST (2) /= SECOND_INDEX'FIRST) OR
             (SECOND'FIRST /= FIRST_INDEX'FIRST) OR
             (SECOND'FIRST (1) /= FIRST_INDEX'FIRST) OR
             (SECOND'FIRST (2) /= SECOND_INDEX'FIRST) THEN
               REPORT.FAILED ("PROBLEMS WITH 'FIRST. " & REMARKS) ;
          END IF ;

          IF (FIRST'LAST /= FIRST_INDEX'LAST) OR
             (FIRST'LAST (1) /= FIRST_INDEX'LAST) OR
             (FIRST'LAST (2) /= SECOND_INDEX'LAST) OR
             (SECOND'LAST /= FIRST_INDEX'LAST) OR
             (SECOND'LAST (1) /= FIRST_INDEX'LAST) OR
             (SECOND'LAST (2) /= SECOND_INDEX'LAST) THEN
               REPORT.FAILED ("PROBLEMS WITH 'LAST. " & REMARKS) ;
          END IF ;

          IF (FIRST'LENGTH /=
              FIRST_INDEX'POS (FIRST_INDEX'LAST)
              - FIRST_INDEX'POS (FIRST_INDEX'FIRST) + 1) OR
             (FIRST'LENGTH (1) /= 
              FIRST_INDEX'POS (FIRST_INDEX'LAST)
              - FIRST_INDEX'POS (FIRST_INDEX'FIRST) + 1) OR
             (FIRST'LENGTH (2) /=
              SECOND_INDEX'POS (SECOND_INDEX'LAST)
              - SECOND_INDEX'POS (SECOND_INDEX'FIRST) + 1) OR
             (SECOND'LENGTH /= 
              FIRST_INDEX'POS (FIRST_INDEX'LAST)
              - FIRST_INDEX'POS (FIRST_INDEX'FIRST) + 1) OR
             (SECOND'LENGTH (1) /=
              FIRST_INDEX'POS (FIRST_INDEX'LAST)
              - FIRST_INDEX'POS (FIRST_INDEX'FIRST) + 1) OR
             (SECOND'LENGTH (2) /=
              SECOND_INDEX'POS (SECOND_INDEX'LAST)
              - SECOND_INDEX'POS (SECOND_INDEX'FIRST) + 1) THEN
               REPORT.FAILED ("PROBLEMS WITH 'LENGTH. " & REMARKS) ;
          END IF ;

          IF (FFIRT NOT IN FIRST'RANGE (1)) OR
             (FFIRT NOT IN FIRST'RANGE) OR
             (SFIRT NOT IN SECOND'RANGE (1)) OR
             (SFIRT NOT IN SECOND'RANGE) OR
             (FSIRT NOT IN FIRST'RANGE (2)) OR
             (SSIRT NOT IN SECOND'RANGE (2)) THEN
                REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUE. " &
                               REMARKS) ;
          END IF ;

          IF CONSTRAINED_ARRAY'SIZE <= 0 THEN
               REPORT.FAILED ("PROBLEMS WITH THE 'SIZE ATTRIBUTE. " &
                              REMARKS) ;
          END IF ;

          IF FIRST'ADDRESS = SECOND'ADDRESS THEN
               REPORT.FAILED ("PROBLEMS WITH THE 'ADDRESS ATTRIBUTE. " &
                              REMARKS) ;
          END IF ;

     END CTEST_PROCEDURE ;

     PROCEDURE FIRST_TEST_PROCEDURE IS NEW TEST_PROCEDURE 
               (FIRST_INDEX            => SHORT_RANGE,
                SECOND_INDEX           => MEDIUM_RANGE,
                UNCONSTRAINED_ARRAY    => FIRST_TEMPLATE) ;

     PROCEDURE NEW_CTEST_PROCEDURE IS NEW CTEST_PROCEDURE 
               (FIRST_INDEX           => SHORT_RANGE,
                SECOND_INDEX          => MEDIUM_RANGE,
                COMPONENT_TYPE        => DATE,
                CONSTRAINED_ARRAY     => SECOND_TEMPLATE) ;

     PROCEDURE NP IS NEW P (SUBINT, DATE, TODAY, ARRA, A1, 
                            ARRA, A2, ARRB, A3, ARRC, A4, ARRD,
                            A5, ARRE, A6, ARRE, A6);

BEGIN  -- CC1224A

     REPORT.TEST ("CC1224A", "FOR ARRAY TYPES WITH A NONLIMITED " &
                  "COMPONENT TYPE (OF A FORMAL AND NONFORMAL GENERIC " &
                  "TYPE), CHECK THAT THE FOLLOWING OPERATIONS " &
                  "ARE IMPLICITY DECLARED AND ARE, THEREFORE, " &
                  "AVAILABLE WITHIN THE GENERIC -- UNIT: " &
                  "ASSIGNMENT, THE OPERATION ASSOCIATED WITH " &
                  "AGGREGATE NOTATION, MEMBERSHIP TESTS, THE " &
                  "OPERATION ASSOCIATED WITH INDEXED " &
                  "COMPONENTS, QUALIFICATION, EXPLICIT " &
                  "CONVERSION, 'SIZE, 'ADDRESS, 'FIRST, " &
                  "'FIRST (N), 'LAST, 'LAST (N), 'RANGE, " &
                  "'RANGE (N), 'LENGTH, 'LENGTH (N)" ) ;

     NP ;

     FIRST_TEST_PROCEDURE (FIRST        => FIRST_ARRAY,
                           FFIFS        => -10,
                           FFILS        => 10,
                           FSIFS        => 6,
                           FSILS        => 10,
                           FFLEN        => 21,
                           FSLEN        => 5,
                           FFIRT        => 0,
                           FSIRT        => 8,
                           SECOND       => SECOND_ARRAY,
                           SFIFS        => 0,
                           SFILS        => 7,
                           SSIFS        => 1,
                           SSILS        => 15,
                           SFLEN        => 8,
                           SSLEN        => 15,
                           SFIRT        => 5,
                           SSIRT        => 13,
                           REMARKS      => "FIRST_TEST_PROCEDURE") ;

     NEW_CTEST_PROCEDURE (FIRST         => THIRD_ARRAY,
                          FFIRT         => -5,
                          FSIRT         => 11,
                          SECOND        => FOURTH_ARRAY,
                          SFIRT         => 0,
                          SSIRT         => 14,
                          REMARKS       => "NEW_CTEST_PROCEDURE") ;

     REPORT.RESULT ;

END CC1224A;