OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cd/] [cd2a32g.ada] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- CD2A32G.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
-- OBJECTIVE:
26
--     CHECK THAT A SIZE SPECIFICATION FOR AN INTEGER
27
--     TYPE OF THE SMALLEST APPROPRIATE UNSIGNED SIZE CAN BE GIVEN:
28
--        IN THE VISIBLE OR PRIVATE PART OF A PACKAGE FOR A TYPE
29
--          DECLARED IN THE VISIBLE PART;
30
--        FOR A DERIVED INTEGER TYPE;
31
--        FOR A DERIVED PRIVATE TYPE WHOSE FULL DECLARATION IS AS
32
--          AN INTEGER TYPE;
33
--        FOR AN INTEGER TYPE GIVEN IN A GENERIC UNIT.
34
 
35
-- HISTORY:
36
--     JET 08/12/87  CREATED ORIGINAL TEST.
37
--     DHH 04/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
38
--                   SIZE CLAUSE VALUE TO 7, CHANGED OPERATOR ON 'SIZE
39
--                   CHECKS, AND ADDED CHECK FOR 'SIZE IN A GENERIC
40
--                   UNIT.
41
--     JRL 03/27/92  REMOVED TESTING OF NONOBJECTIVE TYPES.
42
 
43
WITH REPORT; USE REPORT;
44
PROCEDURE CD2A32G IS
45
 
46
     TYPE BASIC_INT IS RANGE 0 .. 126;
47
     SPECIFIED_SIZE : CONSTANT := 7;
48
 
49
     TYPE DERIVED_INT IS NEW BASIC_INT;
50
     FOR DERIVED_INT'SIZE USE SPECIFIED_SIZE;
51
 
52
     PACKAGE P IS
53
          TYPE INT_IN_P IS RANGE 0 .. 126;
54
          FOR INT_IN_P'SIZE USE SPECIFIED_SIZE;
55
          TYPE PRIVATE_INT IS PRIVATE;
56
          TYPE ALT_INT_IN_P IS RANGE 0 .. 126;
57
     PRIVATE
58
          TYPE PRIVATE_INT IS RANGE 0 .. 126;
59
          FOR ALT_INT_IN_P'SIZE USE SPECIFIED_SIZE;
60
     END P;
61
 
62
     USE P;
63
 
64
     TYPE DERIVED_PRIVATE_INT IS NEW PRIVATE_INT;
65
     FOR DERIVED_PRIVATE_INT'SIZE USE SPECIFIED_SIZE;
66
 
67
     MINIMUM_SIZE : INTEGER := IDENT_INT(SPECIFIED_SIZE);
68
 
69
     GENERIC
70
     PROCEDURE GENPROC;
71
 
72
     PROCEDURE GENPROC IS
73
          TYPE GEN_CHECK_INT IS RANGE 0 .. 126;
74
          FOR GEN_CHECK_INT'SIZE USE SPECIFIED_SIZE;
75
 
76
     BEGIN
77
 
78
          IF GEN_CHECK_INT'SIZE /= MINIMUM_SIZE THEN
79
               FAILED ("GEN_CHECK_INT'SIZE SHOULD NOT BE GREATER " &
80
                       "THAN" & INTEGER'IMAGE(MINIMUM_SIZE) &
81
                       ".  ACTUAL SIZE IS" &
82
                       INTEGER'IMAGE(GEN_CHECK_INT'SIZE));
83
          END IF;
84
     END GENPROC;
85
 
86
     PROCEDURE NEWPROC IS NEW GENPROC;
87
 
88
BEGIN
89
 
90
     TEST("CD2A32G", "CHECK THAT SIZE SPECIFICATIONS OF THE SMALLEST " &
91
                     "APPROPRIATE UNSIGNED SIZE CAN BE GIVEN " &
92
                     "IN THE VISIBLE OR PRIVATE PART OF PACKAGE FOR " &
93
                     "AN INTEGER TYPE DECLARED IN VISIBLE PART, " &
94
                     "FOR DERIVED INTEGER " &
95
                     "TYPES AND DERIVED PRIVATE TYPES WHOSE FULL " &
96
                     "DECLARATION IS AS AN INTEGER TYPE AND FOR AN " &
97
                     "INTEGER TYPE GIVEN IN A GENERIC UNIT");
98
 
99
     IF DERIVED_INT'SIZE /= MINIMUM_SIZE THEN
100
          FAILED ("DERIVED_INT'SIZE SHOULD NOT BE GREATER THAN" &
101
                  INTEGER'IMAGE(MINIMUM_SIZE) &
102
                  ".  ACTUAL SIZE IS" &
103
                  INTEGER'IMAGE(DERIVED_INT'SIZE));
104
     END IF;
105
 
106
     IF INT_IN_P'SIZE /= MINIMUM_SIZE THEN
107
          FAILED ("INT_IN_P'SIZE SHOULD NOT BE GREATER THAN" &
108
                  INTEGER'IMAGE(MINIMUM_SIZE) &
109
                  ".  ACTUAL SIZE IS" &
110
                  INTEGER'IMAGE(INT_IN_P'SIZE));
111
     END IF;
112
 
113
     IF ALT_INT_IN_P'SIZE /= MINIMUM_SIZE THEN
114
          FAILED ("ALT_INT_IN_P'SIZE SHOULD NOT BE GREATER THAN" &
115
                  INTEGER'IMAGE(MINIMUM_SIZE) &
116
                  ".  ACTUAL SIZE IS" &
117
                  INTEGER'IMAGE(ALT_INT_IN_P'SIZE));
118
     END IF;
119
 
120
     IF DERIVED_PRIVATE_INT'SIZE /= MINIMUM_SIZE THEN
121
          FAILED ("DERIVED_PRIVATE_INT'SIZE SHOULD NOT BE GREATER " &
122
                  "THAN" & INTEGER'IMAGE(MINIMUM_SIZE) &
123
                  ".  ACTUAL SIZE IS" &
124
                  INTEGER'IMAGE(DERIVED_PRIVATE_INT'SIZE));
125
     END IF;
126
 
127
     NEWPROC;
128
 
129
     RESULT;
130
 
131
END CD2A32G;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.