~ubuntu-branches/ubuntu/jaunty/adacontrol/jaunty

« back to all changes in this revision

Viewing changes to test/t_when_others_null.adb

  • Committer: Bazaar Package Importer
  • Author(s): Ludovic Brenta
  • Date: 2006-08-24 08:44:11 UTC
  • Revision ID: james.westby@ubuntu.com-20060824084411-1r15uio1h75lqgpx
Tags: upstream-1.4r20
ImportĀ upstreamĀ versionĀ 1.4r20

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
procedure T_when_others_null is
 
2
 
 
3
   type Atype is (a,b,c,d,e);
 
4
   type Btype is range 1 .. 10;
 
5
 
 
6
   VA : Atype := a;
 
7
   VB : Btype := 1;
 
8
 
 
9
   ----------------------------------Test Cases--------------------------------
 
10
   -- Nesting (N = no nesting, C = nested with case, E = nested with exception)
 
11
   -- with/without means with/without a "when others => null;"
 
12
   ----------------------------------------------------------------------------
 
13
   -- Type    N with     N without  C with     C without  E with     E without
 
14
   ----------------------------------------------------------------------------
 
15
   -- Case     1          3          5          7          9          11
 
16
   --
 
17
   -- Exce     2          4          6          8          10         12
 
18
   ----------------------------------------------------------------------------
 
19
 
 
20
   function X return Atype is
 
21
   begin
 
22
      return B;
 
23
   exception
 
24
      -- Test case 2
 
25
      when others =>
 
26
         null;
 
27
   end X;
 
28
 
 
29
   function Y return Atype is
 
30
   begin
 
31
      return B;
 
32
   exception
 
33
      when others =>
 
34
         case VB is
 
35
            when 1 =>
 
36
               null;
 
37
            when 2 =>
 
38
               begin
 
39
                  VB := VB+1;
 
40
               exception
 
41
                  -- Test case 10
 
42
                  when others =>
 
43
                     null;
 
44
               end;
 
45
            when 3 =>
 
46
               null;
 
47
            when others =>
 
48
               -- Test case 8
 
49
               VB := VB-1;
 
50
               null;
 
51
         end case;
 
52
   end Y;
 
53
 
 
54
begin
 
55
 
 
56
   case VA is
 
57
      when A =>
 
58
         case VB is
 
59
            when 1 =>
 
60
               null;
 
61
            when 2 =>
 
62
               null;
 
63
            when 3 =>
 
64
               null;
 
65
            when others =>
 
66
               -- Test case 7
 
67
               case X is
 
68
                  when A =>
 
69
                     null;
 
70
                  when B =>
 
71
                     null;
 
72
                  when C =>
 
73
                     null;
 
74
                  when others =>
 
75
                     -- Test case 5
 
76
                     null;
 
77
               end case;
 
78
         end case;
 
79
      when B =>
 
80
         begin
 
81
            VB := VB+1;
 
82
         exception
 
83
            when others =>
 
84
               case X is
 
85
                  when A =>
 
86
                     null;
 
87
                  when B =>
 
88
                     null;
 
89
                  when C =>
 
90
                     null;
 
91
                  when others =>
 
92
                     -- Test case 6
 
93
                     null;
 
94
               end case;
 
95
         end;
 
96
      when C =>
 
97
         null;
 
98
      when others =>
 
99
         -- Test case 1
 
100
         null;
 
101
   end case;
 
102
   case VB is
 
103
      when 1 =>
 
104
         null;
 
105
      when 2 =>
 
106
         begin
 
107
            VB := VB+1;
 
108
         exception
 
109
            when Constraint_Error =>
 
110
               null;
 
111
 
 
112
            -- Test case 9
 
113
            when others =>
 
114
               null;
 
115
               null;
 
116
         end;
 
117
      when 3 =>
 
118
         null;
 
119
      when others =>
 
120
         -- Test case 3
 
121
         VB := VB+1;
 
122
         null;
 
123
   end case;
 
124
   case X is
 
125
      when A =>
 
126
         null;
 
127
      when B =>
 
128
         begin
 
129
            VB := VB+1;
 
130
         exception
 
131
            -- Test case 11
 
132
            when others =>
 
133
               null;
 
134
               VB := VB-1;
 
135
         end;
 
136
      when C =>
 
137
         null;
 
138
      when others =>
 
139
         -- Test case 3
 
140
         VB := VB-1;
 
141
   end case;
 
142
 
 
143
exception
 
144
   when Constraint_Error =>
 
145
      begin
 
146
         VB := VB+1;
 
147
      exception
 
148
         when others =>
 
149
            -- Test case 12
 
150
            VB := VB-1;
 
151
            null;
 
152
      end;
 
153
 
 
154
   when others =>
 
155
      -- Test case 4
 
156
      null;
 
157
      VB := VB+1;
 
158
 
 
159
end T_when_others_null;