2003-12-26 Guilhem Lavaux <guilhem@kaffe.org>
[official-gcc.git] / gcc / testsuite / ada / acats / tests / c5 / c55b07b.dep
blob17c0c6b0466590652899b1f0ceb4ec40f0d7158a
1 -- C55B07B.DEP
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.
16 --                                    DISCLAIMER
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 -- OBJECTIVE:
26 --     CHECK THAT LOOPS OVER RANGES OF TYPE SHORT_INTEGER
27 --     CAN BE WRITTEN.
29 -- APPLICABILITY CRITERIA:
30 --     THIS TEST IS APPLICABLE TO IMPLEMENTATIONS WHICH SUPPORT
31 --     THE TYPE SHORT_INTEGER.
33 --     IF THE TYPE SHORT_INTEGER IS NOT SUPPORTED, THEN THE
34 --     DECLARATION OF CHECK MUST BE REJECTED.
36 -- HISTORY:
37 --     RM  07/08/82  CREATED ORIGINAL TEST.
38 --     BCB 01/04/88  MODIFIED HEADER.
41 WITH REPORT; USE REPORT;
43 PROCEDURE C55B07B IS
45      CHECK : SHORT_INTEGER;                            -- N/A => ERROR.
47      TYPE  NEW_SHORT_INTEGER  IS  NEW SHORT_INTEGER ;
49      THE_COUNT : INTEGER := 777 ;   -- JUST A DUMMY...
51      SI_VAR   :           SHORT_INTEGER      :=  1 ;
52      SI_CON   :  CONSTANT SHORT_INTEGER      :=  1 ;
54      NSI_VAR  :           NEW_SHORT_INTEGER  :=  1 ;
55      NSI_CON  :  CONSTANT NEW_SHORT_INTEGER  :=  1 ;
57      SUBTYPE   SI_SEGMENT  IS  SHORT_INTEGER RANGE
58                                SHORT_INTEGER'LAST..SHORT_INTEGER'LAST ;
60      SUBTYPE  NSI_SEGMENT  IS  NEW_SHORT_INTEGER RANGE
61                                NEW_SHORT_INTEGER'FIRST..
62                                NEW_SHORT_INTEGER'FIRST ;
64      COUNT : INTEGER := 0;
66      PROCEDURE  BUMP ( DUMMY : INTEGER )  IS
67      BEGIN
68           COUNT := COUNT + 1;
69      END  BUMP;
71 BEGIN
73      TEST ( "C55B07B" , "LOOPS OVER RANGES OF TYPE  SHORT_INTEGER " );
75      FOR  I  IN  1..SI_CON  LOOP
76           BUMP(THE_COUNT) ;
77      END LOOP;
79      FOR  I  IN  NSI_VAR..1  LOOP
80           BUMP(THE_COUNT) ;
81      END LOOP;
83      FOR  I  IN  1..SHORT_INTEGER(1)  LOOP
84           BUMP(THE_COUNT) ;
85      END LOOP;
87      FOR  I  IN  1..NEW_SHORT_INTEGER(1)  LOOP
88           BUMP(THE_COUNT) ;
89      END LOOP;
91      FOR  I  IN  SI_SEGMENT  LOOP
92           BUMP(THE_COUNT) ;
93      END LOOP;
95      FOR  I  IN  REVERSE NSI_SEGMENT  LOOP
96           BUMP(THE_COUNT) ;
97      END LOOP;
99      FOR  I  IN  SHORT_INTEGER RANGE 1..1  LOOP
100           BUMP(THE_COUNT) ;
101      END LOOP;
103      FOR  I  IN  NEW_SHORT_INTEGER RANGE 1..1  LOOP
104           BUMP(THE_COUNT) ;
105      END LOOP;
107      FOR  I  IN  SHORT_INTEGER LOOP
108           BUMP(THE_COUNT) ;
109           EXIT WHEN  I = SHORT_INTEGER'FIRST + 1;
110      END LOOP;
112      FOR  I  IN  NEW_SHORT_INTEGER LOOP
113           BUMP(THE_COUNT) ;
114           EXIT WHEN  I = NEW_SHORT_INTEGER'FIRST + 1;
115      END LOOP;
118      IF  COUNT /= 12  THEN
119           FAILED ("WRONG LOOP COUNT");
120      END IF;
123      RESULT;
126 END  C55B07B ;