c36204d.ada

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

        
        IF (FA2 /= FIRST_INDEX'LAST) OR
           (FA4 /= SECOND_INDEX'LAST) OR
           (SA2 /= FIRST_INDEX'LAST) OR
           (SA4 /= SECOND_INDEX'LAST) OR
           (SA6 /= THIRD_INDEX'LAST) THEN
            REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LAST " &
                           "- PROCEDURE") ;
        END IF ;
        
        IF (FAL1 /= FIRST_INDEX_LENGTH) OR
           (FAL2 /= SECOND_INDEX_LENGTH) OR
           (SAL1 /= FIRST_INDEX_LENGTH) OR
           (SAL2 /= SECOND_INDEX_LENGTH) OR
           (SAL3 /= THIRD_INDEX_LENGTH) THEN
            REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LENGTH " &
                           "- PROCEDURE") ;
        END IF ;
        
        FOR OUTER_INDEX IN FIRST_ARRAY'RANGE (1) LOOP
            FOR INNER_INDEX IN FIRST_ARRAY'RANGE (2) LOOP
                FIRST_ARRAY (OUTER_INDEX, INNER_INDEX) :=
                    SECOND_DEFAULT_VALUE ;
            END LOOP ;
        END LOOP ;
        
        IF FIRST_ARRAY /= THIRD_ARRAY THEN
            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
                           "FOR 2-DIMENSIONAL ARRAY. - PROCEDURE") ;
        END IF ;
        
        FOR OUTER_INDEX IN SECOND_ARRAY'RANGE (1) LOOP
            FOR MIDDLE_INDEX IN SECOND_ARRAY'RANGE (2) LOOP
                FOR INNER_INDEX IN SECOND_ARRAY'RANGE (3) LOOP
                    SECOND_ARRAY (OUTER_INDEX, MIDDLE_INDEX, INNER_INDEX)
                        := FOURTH_DEFAULT_VALUE ;
                END LOOP ;
            END LOOP ;
        END LOOP ;
        
        IF SECOND_ARRAY /= FOURTH_ARRAY THEN
            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
                           "FOR 3-DIMENSIONAL ARRAY. - PROCEDURE") ;
        END IF ;
        
        IF (FIRST_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (1)) OR
           (FIRST_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (1)) OR
           (SECOND_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (2)) OR
           (SECOND_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (2)) OR
           (THIRD_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (3)) THEN
            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
                           "- PROCEDURE") ;
        END IF ;
        
        IF (MATRIX_SIZE = 0) OR (CUBE_SIZE = 0) THEN
            REPORT.FAILED ("INCORRECT HANDLING OF THE 'SIZE ATTRIBUTE. " &
                           "- PROCEDURE") ;
        END IF ;
        
        IF (FAA = TAA) OR (SAA = FRAA) OR (FAA = SAA) OR (FAA = FRAA)
           OR (SAA = TAA) OR (TAA = FRAA) THEN
            REPORT.FAILED ("INCORRECT HANDLING OF THE 'ADDRESS ATTRIBUTE. " &
                           "- PROCEDURE") ;
        END IF ;
        
    END PROC_ARRAY_ATT_TEST ;

    GENERIC
    
        TYPE FIRST_INDEX IS (<>) ;
        FIRST_INDEX_LENGTH : IN NATURAL ;
        FIRST_TEST_VALUE : IN FIRST_INDEX ;
        TYPE SECOND_INDEX IS (<>) ;
        SECOND_INDEX_LENGTH : IN NATURAL ;
        SECOND_TEST_VALUE : IN SECOND_INDEX ;
        TYPE THIRD_INDEX IS (<>) ;
        THIRD_INDEX_LENGTH : IN NATURAL ;
        THIRD_TEST_VALUE : IN THIRD_INDEX ;
        TYPE FIRST_COMPONENT_TYPE IS PRIVATE ;
        FIRST_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
        SECOND_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ;
        TYPE SECOND_COMPONENT_TYPE IS PRIVATE ;
        THIRD_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
        FOURTH_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ;
        
    FUNCTION FUNC_ARRAY_ATT_TEST RETURN BOOLEAN ;
    
    FUNCTION FUNC_ARRAY_ATT_TEST RETURN BOOLEAN IS
    
        TYPE MATRIX IS ARRAY (FIRST_INDEX, SECOND_INDEX)
            OF FIRST_COMPONENT_TYPE ;
            
        TYPE CUBE IS ARRAY (FIRST_INDEX, SECOND_INDEX, THIRD_INDEX)
            OF SECOND_COMPONENT_TYPE ;
            
        FIRST_ARRAY : MATRIX := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
                                    FIRST_DEFAULT_VALUE)) ;
        
        SECOND_ARRAY : CUBE := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
                               (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
                               (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
                                       THIRD_DEFAULT_VALUE))) ;
                                    
        THIRD_ARRAY : CONSTANT MATRIX 
                             := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
                                (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
                                    SECOND_DEFAULT_VALUE)) ;
                                        
        FOURTH_ARRAY : CONSTANT CUBE 
                            := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST =>
                               (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST =>
                               (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST =>
                                       FOURTH_DEFAULT_VALUE))) ;
                                    
        FA1 : FIRST_INDEX := FIRST_ARRAY'FIRST (1) ;
        FA2 : FIRST_INDEX := FIRST_ARRAY'LAST (1) ;
        FA3 : SECOND_INDEX := FIRST_ARRAY'FIRST (2) ;
        FA4 : SECOND_INDEX := FIRST_ARRAY'LAST (2) ;
        
        SA1 : FIRST_INDEX := SECOND_ARRAY'FIRST (1) ;
        SA2 : FIRST_INDEX := SECOND_ARRAY'LAST (1) ;
        SA3 : SECOND_INDEX := SECOND_ARRAY'FIRST (2) ;
        SA4 : SECOND_INDEX := SECOND_ARRAY'LAST (2) ;
        SA5 : THIRD_INDEX := SECOND_ARRAY'FIRST (3) ;
        SA6 : THIRD_INDEX := SECOND_ARRAY'LAST (3) ;
        
        FAL1 : NATURAL := FIRST_ARRAY'LENGTH (1) ;
        FAL2 : NATURAL := FIRST_ARRAY'LENGTH (2) ;
        
        SAL1 : NATURAL := SECOND_ARRAY'LENGTH (1) ;
        SAL2 : NATURAL := SECOND_ARRAY'LENGTH (2) ;
        SAL3 : NATURAL := SECOND_ARRAY'LENGTH (3) ;
        
        MATRIX_SIZE : NATURAL := MATRIX'SIZE ;
        CUBE_SIZE    : NATURAL := CUBE'SIZE ;
        
        FAA : SYSTEM.ADDRESS := FIRST_ARRAY'ADDRESS ;
        SAA : SYSTEM.ADDRESS := SECOND_ARRAY'ADDRESS ;
        TAA : SYSTEM.ADDRESS := THIRD_ARRAY'ADDRESS ;
        FRAA : SYSTEM.ADDRESS := FOURTH_ARRAY'ADDRESS ;
             
     BEGIN  -- FUNC_ARRAY_ATT_TEST

        IF (FA1 /= FIRST_INDEX'FIRST) OR
           (FA3 /= SECOND_INDEX'FIRST) OR
           (SA1 /= FIRST_INDEX'FIRST) OR
           (SA3 /= SECOND_INDEX'FIRST) OR
           (SA5 /= THIRD_INDEX'FIRST) THEN
            REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'FIRST " &
                           "- FUNCTION") ;
        END IF ;
        
        IF (FA2 /= FIRST_INDEX'LAST) OR
           (FA4 /= SECOND_INDEX'LAST) OR
           (SA2 /= FIRST_INDEX'LAST) OR
           (SA4 /= SECOND_INDEX'LAST) OR
           (SA6 /= THIRD_INDEX'LAST) THEN
            REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LAST " &
                           "- FUNCTION") ;
        END IF ;
        
        IF (FAL1 /= FIRST_INDEX_LENGTH) OR
           (FAL2 /= SECOND_INDEX_LENGTH) OR
           (SAL1 /= FIRST_INDEX_LENGTH) OR
           (SAL2 /= SECOND_INDEX_LENGTH) OR
           (SAL3 /= THIRD_INDEX_LENGTH) THEN
            REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LENGTH " &
                           "- FUNCTION") ;
        END IF ;
        
        FOR OUTER_INDEX IN FIRST_ARRAY'RANGE (1) LOOP
            FOR INNER_INDEX IN FIRST_ARRAY'RANGE (2) LOOP
                FIRST_ARRAY (OUTER_INDEX, INNER_INDEX) :=
                    SECOND_DEFAULT_VALUE ;
            END LOOP ;
        END LOOP ;
        
        IF FIRST_ARRAY /= THIRD_ARRAY THEN
            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
                           "FOR 2-DIMENSIONAL ARRAY. - FUNCTION") ;
        END IF ;
        
        FOR OUTER_INDEX IN SECOND_ARRAY'RANGE (1) LOOP
            FOR MIDDLE_INDEX IN SECOND_ARRAY'RANGE (2) LOOP
                FOR INNER_INDEX IN SECOND_ARRAY'RANGE (3) LOOP
                    SECOND_ARRAY (OUTER_INDEX, MIDDLE_INDEX, INNER_INDEX)
                        := FOURTH_DEFAULT_VALUE ;
                END LOOP ;
            END LOOP ;
        END LOOP ;
        
        IF SECOND_ARRAY /= FOURTH_ARRAY THEN
            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
                           "FOR 3-DIMENSIONAL ARRAY. - FUNCTION") ;
        END IF ;
        
        IF (FIRST_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (1)) OR
           (FIRST_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (1)) OR
           (SECOND_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (2)) OR
           (SECOND_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (2)) OR
           (THIRD_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (3)) THEN
            REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " &
                           "- FUNCTION") ;
        END IF ;
        
        IF (MATRIX_SIZE = 0) OR (CUBE_SIZE = 0) THEN
            REPORT.FAILED ("INCORRECT HANDLING OF THE 'SIZE ATTRIBUTE. " &
                           "- FUNCTION") ;
        END IF ;
        
        IF (FAA = TAA) OR (SAA = FRAA) OR (FAA = SAA) OR (FAA = FRAA)
           OR (SAA = TAA) OR (TAA = FRAA) THEN
            REPORT.FAILED ("INCORRECT HANDLING OF THE 'ADDRESS ATTRIBUTE. " &
                           "- FUNCTION") ;
        END IF ;
        
        RETURN TRUE ;
        
    END FUNC_ARRAY_ATT_TEST ;


BEGIN -- C36204D

    REPORT.TEST ("C36204D", "ARRAY ATTRIBUTES RETURN CORRECT " &
                  "VALUES WITHIN GENERIC PROGRAM UNITS.") ;
     
    LOCAL_BLOCK:
    
    DECLARE
    
        DUMMY : BOOLEAN := FALSE ;
    
        PACKAGE NEW_ARRAY_ATTRIBUTE_TEST IS NEW ARRAY_ATTRIBUTE_TEST (
            FIRST_INDEX             => SHORT_RANGE,
            FIRST_INDEX_LENGTH      => SHORT_LENGTH,
            FIRST_TEST_VALUE        => -7,
            SECOND_INDEX            => MONTH_TYPE,
            SECOND_INDEX_LENGTH     => 12,
            SECOND_TEST_VALUE       => AUG,
            THIRD_INDEX             => BOOLEAN,
            THIRD_INDEX_LENGTH      => 2,
            THIRD_TEST_VALUE        => FALSE,
            FIRST_COMPONENT_TYPE    => MONTH_TYPE,
            FIRST_DEFAULT_VALUE     => JAN,
            SECOND_DEFAULT_VALUE    => DEC,
            SECOND_COMPONENT_TYPE   => DATE,
            THIRD_DEFAULT_VALUE     => TODAY,
            FOURTH_DEFAULT_VALUE    => FIRST_DATE) ;
        
        PROCEDURE NEW_PROC_ARRAY_ATT_TEST IS NEW PROC_ARRAY_ATT_TEST (
            FIRST_INDEX             => MONTH_TYPE,
            FIRST_INDEX_LENGTH      => 12,
            FIRST_TEST_VALUE        => AUG,
            SECOND_INDEX            => SHORT_RANGE,
            SECOND_INDEX_LENGTH     => SHORT_LENGTH,
            SECOND_TEST_VALUE       => -7,
            THIRD_INDEX             => BOOLEAN,
            THIRD_INDEX_LENGTH      => 2,
            THIRD_TEST_VALUE        => FALSE,
            FIRST_COMPONENT_TYPE    => DATE,
            FIRST_DEFAULT_VALUE     => TODAY,
            SECOND_DEFAULT_VALUE    => FIRST_DATE,
            SECOND_COMPONENT_TYPE   => MONTH_TYPE,
            THIRD_DEFAULT_VALUE     => JAN,
            FOURTH_DEFAULT_VALUE    => DEC) ;

        FUNCTION NEW_FUNC_ARRAY_ATT_TEST IS NEW FUNC_ARRAY_ATT_TEST (
            FIRST_INDEX             => DAY_TYPE,
            FIRST_INDEX_LENGTH      => 31,
            FIRST_TEST_VALUE        => 25,
            SECOND_INDEX            => SHORT_RANGE,
            SECOND_INDEX_LENGTH     => SHORT_LENGTH,
            SECOND_TEST_VALUE       => -7,
            THIRD_INDEX             => MID_YEAR,
            THIRD_INDEX_LENGTH      => 4,
            THIRD_TEST_VALUE        => JUL,
            FIRST_COMPONENT_TYPE    => DATE,
            FIRST_DEFAULT_VALUE     => TODAY,
            SECOND_DEFAULT_VALUE    => FIRST_DATE,
            SECOND_COMPONENT_TYPE   => MONTH_TYPE,
            THIRD_DEFAULT_VALUE     => JAN,
            FOURTH_DEFAULT_VALUE    => DEC) ;

    BEGIN  -- LOCAL_BLOCK
    
        NEW_PROC_ARRAY_ATT_TEST ;
        
        DUMMY := NEW_FUNC_ARRAY_ATT_TEST ;
        IF NOT DUMMY THEN
            REPORT.FAILED ("WRONG VALUE RETURNED BY FUNCTION.") ;
        END IF ;
        
    END LOCAL_BLOCK ;
     
    REPORT.RESULT ;
     
END C36204D ;