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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cb/] [cb20a02.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- CB20A02.A
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
--
26
-- OBJECTIVE:
27
--      Check that the name and pertinent information about a user defined
28
--      exception are available to an enclosing program unit even when the
29
--      enclosing unit has no visibility into the scope where the exception
30
--      is declared and raised.
31
--
32
-- TEST DESCRIPTION:
33
--      Declare a subprogram nested within the test subprogram.  The enclosing
34
--      subprogram does not have visibility into the nested subprogram.
35
--      Declare and raise an exception in the nested subprogram, and allow
36
--      the exception to propagate to the enclosing scope.  Use the function
37
--      Exception_Name in the enclosing subprogram to produce exception
38
--      specific information when the exception is handled in an others
39
--      handler.
40
--
41
-- TEST FILES:
42
--
43
--      This test depends on the following foundation code file:
44
--         FB20A00.A
45
--
46
--
47
-- CHANGE HISTORY:
48
--      06 Dec 94   SAIC    ACVC 2.0
49
--
50
--!
51
 
52
with FB20A00;             -- Package containing Function Find
53
with Ada.Exceptions;
54
with Report;
55
 
56
procedure CB20A02 is
57
 
58
   Seed_Number   : Integer;
59
   Random_Number : Integer := 0;
60
 
61
     --=================================================================--
62
 
63
   function Random_Number_Generator (Seed : Integer) return Integer is
64
 
65
      Result : Integer := 0;
66
 
67
      HighSeedError,
68
      Mid_Seed_Error,
69
      L_o_w_S_e_e_d_E_r_r_o_r : exception;
70
 
71
   begin  -- Random_Number_Generator
72
 
73
 
74
      if (Report.Ident_Int (Seed)    > 1000) then
75
         raise HighSeedError;
76
      elsif (Report.Ident_Int (Seed) >  100) then
77
         raise Mid_Seed_Error;
78
      elsif (Report.Ident_Int (Seed) >   10) then
79
         raise L_o_w_S_e_e_d_E_r_r_o_r;
80
      else
81
         Seed_Number := ((Seed_Number * 417) + 231) mod 53;
82
         Result := Seed_Number / 52;
83
      end if;
84
 
85
      return Result;
86
 
87
   end Random_Number_Generator;
88
 
89
     --=================================================================--
90
 
91
begin
92
 
93
   Report.Test ("CB20A02", "Check that the name "                        &
94
                           "of a user defined exception is available "   &
95
                           "to an enclosing program unit even when the " &
96
                           "enclosing unit has no visibility into the "  &
97
                           "scope where the exception is declared and "  &
98
                           "raised" );
99
 
100
   High_Seed:
101
   begin
102
      -- This seed value will result in the raising of a HighSeedError
103
      -- exception.
104
      Seed_Number   := 1001;
105
      Random_Number := Random_Number_Generator (Seed_Number);
106
      Report.Failed ("Exception not raised in High_Seed block");
107
   exception
108
      when Error : others =>
109
         if not FB20A00.Find (Ada.Exceptions.Exception_Name (Error),
110
                              "HighSeedError")
111
         then
112
            Report.Failed ("Expected HighSeedError, but found " &
113
                            Ada.Exceptions.Exception_Name (Error));
114
         end if;
115
   end High_Seed;
116
 
117
 
118
   Mid_Seed:
119
   begin
120
      -- This seed value will generate a Mid_Seed_Error exception.
121
      Seed_Number   := 101;
122
      Random_Number := Random_Number_Generator (Seed_Number);
123
      Report.Failed ("Exception not raised in Mid_Seed block");
124
   exception
125
      when Error : others =>
126
         if not FB20A00.Find (Ada.Exceptions.Exception_Name (Error),
127
                              "Mid_Seed_Error")
128
         then
129
            Report.Failed ("Expected Mid_Seed_Error, but found " &
130
                            Ada.Exceptions.Exception_Name (Error));
131
         end if;
132
   end Mid_Seed;
133
 
134
 
135
   Low_Seed:
136
   begin
137
      -- This seed value will result in the raising of a
138
      -- L_o_w_S_e_e_d_E_r_r_o_r exception.
139
      Seed_Number   := 11;
140
      Random_Number := Random_Number_Generator (Seed_Number);
141
      Report.Failed ("Exception not raised in Low_Seed block");
142
   exception
143
      when Error : others =>
144
         if not FB20A00.Find (Ada.Exceptions.Exception_Name (Error),
145
                              "L_o_w_S_e_e_d_E_r_r_o_r")
146
         then
147
            Report.Failed ("Expected L_o_w_S_e_e_d_E_r_r_o_r but found " &
148
                            Ada.Exceptions.Exception_Name (Error));
149
         end if;
150
   end Low_Seed;
151
 
152
 
153
   Report.Result;
154
 
155
end CB20A02;

powered by: WebSVN 2.1.0

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