cc3019c2.ada

来自「linux下编程用 编译软件」· ADA 代码 · 共 458 行 · 第 1/2 页

             /= TODAY) OR
        (NEW_NESTED_GENERICS.ELEMENT_OF (
                THIS_NGT_OBJECT => SECOND_NNG)
             /= FIRST_DATE) THEN
             REPORT.FAILED ("PROBLEMS WITH EXTRACTING ELEMENTS IN " &
                            "OUTERMOST GENERIC") ;
     END IF ;

     IF (NEW_NESTED_GENERICS.NUMBER_OF (THIS_NGT_OBJECT => FIRST_NNG)
             /= 1) OR
        (NEW_NESTED_GENERICS.NUMBER_OF (THIS_NGT_OBJECT => SECOND_NNG)
             /= 2) THEN
             REPORT.FAILED ("PROBLEMS WITH EXTRACTING NUMBERS IN " &
                             "OUTERMOST GENERIC") ;
     END IF ;

     NEW_NESTED_GENERICS.COPY (SOURCE        => FIRST_NNG,
                               DESTINATION    => SECOND_NNG) ;

     IF FIRST_NNG /= SECOND_NNG THEN
          REPORT.FAILED ("PROBLEMS WITH COPYING OR TESTING EQUALITY " &
                         "IN OUTERMOST GENERIC") ;
     END IF ;

-- CHECK THE FIRST NESTED GENERIC (GENERIC_TASK)

     FIRST_GENERIC_TASK.STORE  (ITEM => MYSELF) ;
     SECOND_GENERIC_TASK.STORE (ITEM => FRIEND) ;

     FIRST_GENERIC_TASK.GET  (ITEM => FIRST_PERSON) ;
     SECOND_GENERIC_TASK.GET (ITEM => SECOND_PERSON) ;

     IF (FIRST_PERSON /= MYSELF) OR (SECOND_PERSON /= FRIEND) THEN
          REPORT.FAILED ("PROBLEMS WITH NESTED TASK GENERIC") ;
     END IF ;

-- CHECK THE SECOND NESTED GENERIC (STACK_CLASS)

     PERSON_STACK.CLEAR (THIS_STACK => FIRST_PERSON_STACK) ;
     IF PERSON_STACK.NUMBER_OF_ELEMENTS
        (ON_THIS_STACK => FIRST_PERSON_STACK) /= 0 THEN
          REPORT.FAILED (
               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 1") ;
     END IF ;

     PERSON_STACK.PUSH (THIS_ELEMENT     => MYSELF,
                            ON_TO_THIS_STACK => FIRST_PERSON_STACK) ;
     IF PERSON_STACK.NUMBER_OF_ELEMENTS
        (ON_THIS_STACK => FIRST_PERSON_STACK) /= 1 THEN
          REPORT.FAILED (
               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 2") ;
     END IF ;

     PERSON_STACK.PUSH (THIS_ELEMENT     => FRIEND,
                            ON_TO_THIS_STACK => FIRST_PERSON_STACK) ;
     IF PERSON_STACK.NUMBER_OF_ELEMENTS
        (ON_THIS_STACK => FIRST_PERSON_STACK) /= 2 THEN
          REPORT.FAILED (
               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 3") ;
     END IF ;

     PERSON_STACK.PUSH (THIS_ELEMENT     => FATHER,
                            ON_TO_THIS_STACK => FIRST_PERSON_STACK) ;
     IF PERSON_STACK.NUMBER_OF_ELEMENTS
        (ON_THIS_STACK => FIRST_PERSON_STACK) /= 3 THEN
          REPORT.FAILED (
               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 4") ;
     END IF ;

     PERSON_STACK.POP (THIS_ELEMENT   => FIRST_PERSON,
                           OFF_THIS_STACK => FIRST_PERSON_STACK) ;
     IF PERSON_STACK.NUMBER_OF_ELEMENTS
        (ON_THIS_STACK => FIRST_PERSON_STACK) /= 2 THEN
          REPORT.FAILED (
               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 5") ;
     END IF ;

     IF FIRST_PERSON /= FATHER THEN
          REPORT.FAILED (
               "IMPROPER VALUE REMOVED FROM STACK - 1") ;
     END IF ;

     PERSON_STACK.CLEAR (THIS_STACK => SECOND_PERSON_STACK) ;
     IF PERSON_STACK.NUMBER_OF_ELEMENTS
        (ON_THIS_STACK => SECOND_PERSON_STACK) /= 0 THEN
          REPORT.FAILED (
               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 6") ;
     END IF ;

     PERSON_STACK.COPY (THIS_STACK    => FIRST_PERSON_STACK,
                            TO_THIS_STACK => SECOND_PERSON_STACK) ;

     IF FIRST_PERSON_STACK /= SECOND_PERSON_STACK THEN
          REPORT.FAILED (
               "PROBLEMS WITH COPY OR TEST FOR EQUALITY (STACK)") ;
     END IF ;

     PERSON_STACK.POP (THIS_ELEMENT   => FIRST_PERSON,
                       OFF_THIS_STACK => SECOND_PERSON_STACK) ;
     PERSON_STACK.PUSH (THIS_ELEMENT     => DAUGHTER,
                        ON_TO_THIS_STACK => SECOND_PERSON_STACK) ;
     IF FIRST_PERSON_STACK = SECOND_PERSON_STACK THEN
          REPORT.FAILED (
               "PROBLEMS WITH POP OR TEST FOR EQUALITY (STACK)") ;
     END IF ;

     UNDERFLOW_EXCEPTION_TEST:

     BEGIN  -- UNDERFLOW_EXCEPTION_TEST

          PERSON_STACK.CLEAR (THIS_STACK => THIRD_PERSON_STACK) ;
          PERSON_STACK.POP (THIS_ELEMENT    => FIRST_PERSON,
                            OFF_THIS_STACK  => THIRD_PERSON_STACK) ;
          REPORT.FAILED ("UNDERFLOW EXCEPTION NOT RAISED") ;

     EXCEPTION

          WHEN PERSON_STACK.UNDERFLOW => NULL ;  -- CORRECT EXCEPTION
                                                 -- RAISED
          WHEN OTHERS =>
               REPORT.FAILED ("INCORRECT EXCEPTION RAISED IN " &
                              "UNDERFLOW EXCEPTION TEST") ;

     END UNDERFLOW_EXCEPTION_TEST ;

     OVERFLOW_EXCEPTION_TEST:

     BEGIN  -- OVERFLOW_EXCEPTION_TEST

          PERSON_STACK.CLEAR (THIS_STACK => THIRD_PERSON_STACK) ;
          FOR INDEX IN 1 .. 10 LOOP
               PERSON_STACK.PUSH (
                    THIS_ELEMENT     => MYSELF,
                    ON_TO_THIS_STACK => THIRD_PERSON_STACK) ;
          END LOOP ;

          PERSON_STACK.PUSH (THIS_ELEMENT     => MYSELF,
                             ON_TO_THIS_STACK => THIRD_PERSON_STACK) ;
          REPORT.FAILED ("OVERFLOW EXCEPTION NOT RAISED") ;

     EXCEPTION

          WHEN PERSON_STACK.OVERFLOW => NULL ;  -- CORRECT EXCEPTION
                                                -- RAISED
          WHEN OTHERS =>
               REPORT.FAILED ("INCORRECT EXCEPTION RAISED IN " &
                              "OVERFLOW EXCEPTION TEST") ;

     END OVERFLOW_EXCEPTION_TEST ;

     LOCAL_BLOCK:

     DECLARE

          TYPE PERSON_TABLE IS ARRAY (POSITIVE RANGE 1 .. 10) OF PERSON;

          FIRST_PERSON_TABLE : PERSON_TABLE ;

          TABLE_INDEX : POSITIVE := 1 ;

          PROCEDURE GATHER_PEOPLE (THIS_PERSON : IN  PERSON ;
                                   CONTINUE    : OUT BOOLEAN) ;

          PROCEDURE SHOW_PEOPLE (THIS_PERSON  : IN  PERSON ;
                                 CONTINUE     : OUT BOOLEAN) ;

          PROCEDURE GATHER_PERSON_ITERATE IS NEW
               PERSON_STACK.ITERATE (PROCESS => GATHER_PEOPLE) ;

          PROCEDURE SHOW_PERSON_ITERATE IS NEW
               PERSON_STACK.ITERATE (PROCESS => SHOW_PEOPLE) ;

          PROCEDURE GATHER_PEOPLE (THIS_PERSON : IN  PERSON ;
                                   CONTINUE    : OUT BOOLEAN) IS
          BEGIN  -- GATHER_PEOPLE

               FIRST_PERSON_TABLE (TABLE_INDEX) := THIS_PERSON ;
               TABLE_INDEX := TABLE_INDEX + 1 ;

               CONTINUE := TRUE ;

          END GATHER_PEOPLE ;

          PROCEDURE SHOW_PEOPLE (THIS_PERSON  : IN  PERSON ;
                                 CONTINUE     : OUT BOOLEAN) IS

          BEGIN  -- SHOW_PEOPLE

               REPORT.COMMENT ("THE BIRTH MONTH IS " &
                    MONTH_TYPE'IMAGE (THIS_PERSON.BIRTH_DATE.MONTH)) ;
               REPORT.COMMENT ("THE BIRTH DAY IS " &
                    DAY_TYPE'IMAGE (THIS_PERSON.BIRTH_DATE.DAY)) ;
               REPORT.COMMENT ("THE BIRTH YEAR IS " &
                    YEAR_TYPE'IMAGE (THIS_PERSON.BIRTH_DATE.YEAR)) ;
               REPORT.COMMENT ("THE GENDER IS " &
                    SEX'IMAGE (THIS_PERSON.GENDER)) ;
               REPORT.COMMENT ("THE NAME IS " & THIS_PERSON.NAME) ;

               CONTINUE := TRUE ;

          END SHOW_PEOPLE ;

     BEGIN  -- LOCAL_BLOCK

          REPORT.COMMENT ("CONTENTS OF THE FIRST STACK") ;
          SHOW_PERSON_ITERATE (OVER_THIS_STACK => FIRST_PERSON_STACK) ;

          REPORT.COMMENT ("CONTENTS OF THE SECOND STACK") ;
          SHOW_PERSON_ITERATE (OVER_THIS_STACK => SECOND_PERSON_STACK) ;

          GATHER_PERSON_ITERATE (OVER_THIS_STACK => FIRST_PERSON_STACK);
          IF (FIRST_PERSON_TABLE (1) /= MYSELF) OR
             (FIRST_PERSON_TABLE (2) /= FRIEND) THEN
               REPORT.FAILED ("PROBLEMS WITH ITERATION - 1") ;
          END IF ;

          TABLE_INDEX := 1 ;
          GATHER_PERSON_ITERATE(OVER_THIS_STACK => SECOND_PERSON_STACK);
          IF (FIRST_PERSON_TABLE (1) /= MYSELF) OR
             (FIRST_PERSON_TABLE (2) /= DAUGHTER) THEN
               REPORT.FAILED ("PROBLEMS WITH ITERATION - 2") ;
          END IF ;

     END LOCAL_BLOCK ;

     REPORT.RESULT ;

END CC3019C2M ;