gcc/testsuite/ada/acats/tests/c5/c58006a.ada

   1 -- C58006A.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 -- CHECK THAT IF THE EVALUATION OF A RETURN STATEMENT'S EXPRESSION
  26 -- RAISES AN EXCEPTION, THE EXCEPTION CAN BE HANDLED WITHIN THE BODY OF
  27 -- THE FUNCTION.
  28
  29 -- RM 05/11/81
  30 -- SPS 10/26/82
  31 -- SPS 3/8/83
  32 -- JBG 9/13/83
  33
  34 WITH REPORT;
  35 PROCEDURE  C58006A  IS
  36
  37      USE  REPORT;
  38
  39 BEGIN
  40
  41      TEST( "C58006A" , "CHECK THAT EXCEPTION RAISED BY A RETURN" &
  42                        " STATEMENT CAN BE HANDLED LOCALLY" );
  43
  44
  45      DECLARE
  46           SUBTYPE I1 IS INTEGER RANGE -10..90;
  47           SUBTYPE I2 IS INTEGER RANGE 1..10;
  48
  49           FUNCTION  FN1( X : I1 )
  50                     RETURN  I2  IS
  51           BEGIN
  52                RETURN  0;
  53           EXCEPTION
  54                WHEN CONSTRAINT_ERROR =>
  55                     COMMENT ("EXCEPTION RAISED - F1");
  56                     RETURN 1;
  57                WHEN OTHERS =>
  58                     FAILED ("WRONG EXCEPTION RAISED - FN1");
  59           END  FN1;
  60
  61           FUNCTION  FN2( X : I1 )
  62                     RETURN  I2  IS
  63           BEGIN
  64                RETURN  X + IDENT_INT(0);
  65           EXCEPTION
  66                WHEN CONSTRAINT_ERROR =>
  67                     COMMENT ("EXCEPTION RAISED - F2");
  68                     RETURN 1;
  69                WHEN OTHERS =>
  70                     FAILED ("WRONG EXCEPTION RAISED - FN2");
  71           END  FN2;
  72
  73           FUNCTION  FN3( X : I1 )
  74                     RETURN  I2  IS
  75                HUNDRED : INTEGER RANGE -100..100 := IDENT_INT(100);
  76           BEGIN
  77                RETURN  HUNDRED;
  78           EXCEPTION
  79                WHEN CONSTRAINT_ERROR =>
  80                     COMMENT ("EXCEPTION RAISED - F3");
  81                     RETURN 1;
  82                WHEN OTHERS =>
  83                     FAILED ("WRONG EXCEPTION RAISED - FN3");
  84           END  FN3;
  85
  86      BEGIN
  87
  88           BEGIN
  89                IF FN1( 0 ) /= IDENT_INT(1) THEN
  90                     FAILED ("NO EXCEPTION RAISED - FN1( 0 )");
  91                END IF;
  92           EXCEPTION
  93                WHEN OTHERS =>
  94                     FAILED ("EXCEPTION PROPAGATED - FN1( 0 )");
  95           END;
  96
  97           BEGIN
  98                IF FN2( 0 ) /= IDENT_INT(1) THEN
  99                     FAILED ("NO EXCEPTION RAISED - FN2( 0 )");
 100                END IF;
 101           EXCEPTION
 102                WHEN OTHERS =>
 103                     FAILED ("EXCEPTION PROPAGATED - FN2( 0 )");
 104           END;
 105
 106           BEGIN
 107                IF FN2(11 ) /= IDENT_INT(1) THEN
 108                     FAILED ("NO EXCEPTION RAISED - FN2(11 )");
 109                END IF;
 110           EXCEPTION
 111                WHEN OTHERS =>
 112                     FAILED ("EXCEPTION PROPAGATED - FN2(11 )");
 113           END;
 114
 115           BEGIN
 116                IF FN3( 0 ) /= IDENT_INT(1) THEN
 117                     FAILED ("NO EXCEPTION RAISED - FN3( 0 )");
 118                END IF;
 119           EXCEPTION
 120                WHEN OTHERS =>
 121                     FAILED ("EXCEPTION PROPAGATED - FN3( 0 )");
 122           END;
 123
 124      END;
 125
 126      RESULT;
 127
 128 END C58006A;