1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2009-2016. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20-module(group_require_2_SUITE).
21
22-compile(export_all).
23
24-include_lib("common_test/include/ct.hrl").
25
26
27%%%-----------------------------------------------------------------
28%%% CONFIG FUNCS
29%%%-----------------------------------------------------------------
30
31init_per_group(G, Config) ->
32    GrProps = proplists:get_value(tc_group_properties, Config),
33    _GrProps1 = proplists:delete(name, GrProps),
34    Info = case catch group(G) of {'EXIT',_} -> []; I -> I end,
35    ct:comment(io_lib:format("init( ~w ): ~p", [G, Info])),
36    if Info /= [] -> verify_cfg(G); true -> ok end,
37    Config.
38
39end_per_group(G, Config) ->
40    GrProps = proplists:get_value(tc_group_properties, Config),
41    _GrProps1 = proplists:delete(name, GrProps),
42    Info = case catch group(G) of {'EXIT',_} -> []; I -> I end,
43    ct:comment(io_lib:format("end( ~w )", [G])),
44    if Info /= [] -> verify_cfg(G); true -> ok end,
45    ok.
46
47init_per_testcase(t101, Config) ->
48    Config;
49init_per_testcase(t111, Config) ->
50    Config;
51init_per_testcase(TestCase, Config) ->
52    GrProps = proplists:get_value(tc_group_properties, Config),
53    GrProps1 = if GrProps == undefined  -> []; true -> GrProps end,
54    verify_cfg(proplists:get_value(name, GrProps1)),
55    if TestCase == t72 -> verify_cfg(TestCase); true -> ok end,
56    Info = case catch apply(?MODULE,TestCase,[]) of
57	       {'EXIT',_} -> [];
58	       I -> I
59	   end,
60    ct:comment(io_lib:format("init( ~w ): ~p", [TestCase, Info])),
61    Config.
62
63end_per_testcase(t101, Config) ->
64    ok;
65end_per_testcase(t111, Config) ->
66    ok;
67end_per_testcase(TestCase, Config) ->
68    GrProps = proplists:get_value(tc_group_properties, Config),
69    GrProps1 = if GrProps == undefined  -> []; true -> GrProps end,
70    verify_cfg(proplists:get_value(name, GrProps1)),
71    if TestCase == t72 -> verify_cfg(TestCase); true -> ok end,
72    ok.
73
74verify_cfg(undefined) ->
75    ok;
76verify_cfg(Name) ->
77    Key = list_to_atom(atom_to_list(Name) ++ "_cfg"),
78    Alias = list_to_atom(atom_to_list(Name) ++ "_cfg_alias"),
79    Val = list_to_atom(atom_to_list(Name) ++ "_cfg_val"),
80    ct:pal("Reading ~p & ~p. Expecting ~p.", [Key,Alias,Val]),
81    Val = ct:get_config(Key),
82    Val = ct:get_config(Alias),
83    suite_cfg_val = ct:get_config(suite_cfg),
84    suite_cfg_val = ct:get_config(suite_cfg_alias).
85
86
87
88%%%------------------------------------------------------------------
89%%% TEST DECLARATIONS
90%%%------------------------------------------------------------------
91
92groups() ->
93    [{g1,[],[t11]},
94     {g2,[],[t21]},
95     {g3,[],[t31]},
96     {g4,[],[t41]},
97
98     {g5,[],[{group,g6},t51,{group,g7}]},
99
100       {g6,[],[t61]},
101       {g7,[],[t71,t72]},
102
103     {g8,[],[t81]},
104     {g9,[],[t91]},
105     {g10,[],[t101]},
106     {g11,[],[t111]}
107    ].
108
109
110all() ->
111    [t1,
112     {group,g1},
113     {group,g2},
114     {group,g3},
115     {group,g4},
116     {group,g5},
117     {group,g8},
118     {group,g9},
119     {group,g10},
120     {group,g11}
121    ].
122
123%%%-----------------------------------------------------------------
124%%% INFO FUNCS
125%%%-----------------------------------------------------------------
126
127suite() -> [{require,suite_cfg},
128	    {require,suite_cfg_alias,suite_cfg},
129	    {require,common1},
130	    {default_config,suite_cfg,suite_cfg_val},
131	    {default_config,common1,common1_val}].
132
133group(g1) -> [{require,g1_cfg},
134	      {require,g1_cfg_alias,g1_cfg},
135	      {default_config,g1_cfg,g1_cfg_val}];
136
137group(g2) -> [{require,g2_cfg},
138	      {require,g2_cfg_alias,g2_cfg},
139	      {require,common1},
140	      {require,common2},
141	      {default_config,g2_cfg,g2_cfg_val},
142	      {default_config,common1,common1_val},
143	      {default_config,common2,common2_val}];
144
145group(g3) -> [{require,g3_cfg},
146	      {require,g3_cfg_alias,g3_cfg},
147	      {require,common2},
148	      {require,common2_alias,common2},
149	      {default_config,g3_cfg,g3_cfg_val},
150	      {default_config,common2,common2_val}];
151
152group(g4) -> [{require,g4_cfg},
153	      {require,g4_cfg_alias,g4_cfg},
154	      {require,common2_alias,common3},
155	      {default_config,g4_cfg,g4_cfg_val}];
156
157group(g5) -> [{require,g5_cfg},
158	      {require,g5_cfg_alias,g5_cfg},
159	      {default_config,g5_cfg,g5_cfg_val}];
160
161group(g6) -> [{require,g6_cfg},
162	      {require,g6_cfg_alias,g6_cfg},
163	      {default_config,g6_cfg,g6_cfg_val}];
164
165group(g7) -> [{require,g7_cfg},
166	      {require,g7_cfg_alias,g7_cfg},
167	      {default_config,g7_cfg,g7_cfg_val}];
168
169group(g8) -> [{require,non_existing}];
170
171group(g9) -> [{require,g9_cfg},
172	      {require,g9_cfg_alias,g9_cfg},
173	      {default_config,g9_cfg,g9_cfg_val}];
174
175group(G) when G /= g11 -> [].
176
177t72() -> [{require,t72_cfg},
178	  {require,t72_cfg_alias,t72_cfg},
179	  {default_config,t72_cfg,t72_cfg_val}].
180
181t91() -> [{require,non_existing}].
182
183
184%%%------------------------------------------------------------------
185%%% TEST CASES
186%%%------------------------------------------------------------------
187
188t1(_) ->
189    suite_cfg_val = ct:get_config(suite_cfg).
190
191t11(_) ->
192    suite_cfg_val = ct:get_config(suite_cfg),
193    suite_cfg_val = ct:get_config(suite_cfg_alias),
194    g1_cfg_val = ct:get_config(g1_cfg),
195    g1_cfg_val = ct:get_config(g1_cfg_alias).
196
197t21(_) ->
198    suite_cfg_val = ct:get_config(suite_cfg),
199    g2_cfg_val = ct:get_config(g2_cfg),
200    g2_cfg_val = ct:get_config(g2_cfg_alias),
201    common1_val = ct:get_config(common1),
202    common2_val = ct:get_config(common2).
203
204t31(_) ->
205    suite_cfg_val = ct:get_config(suite_cfg),
206    g3_cfg_val = ct:get_config(g3_cfg),
207    g3_cfg_val = ct:get_config(g3_cfg_alias),
208    common2_val = ct:get_config(common2),
209    common2_val = ct:get_config(common2_alias).
210
211t41(_) ->
212    exit(should_be_skipped).
213
214t51(_) ->
215    suite_cfg_val = ct:get_config(suite_cfg),
216    g5_cfg_val = ct:get_config(g5_cfg),
217    g5_cfg_val = ct:get_config(g5_cfg_alias).
218
219t61(_) ->
220    suite_cfg_val = ct:get_config(suite_cfg),
221    g5_cfg_val = ct:get_config(g5_cfg),
222    g5_cfg_val = ct:get_config(g5_cfg_alias),
223    g6_cfg_val = ct:get_config(g6_cfg),
224    g6_cfg_val = ct:get_config(g6_cfg_alias).
225
226t71(_) ->
227    suite_cfg_val = ct:get_config(suite_cfg),
228    g5_cfg_val = ct:get_config(g5_cfg),
229    g5_cfg_val = ct:get_config(g5_cfg_alias),
230    g7_cfg_val = ct:get_config(g7_cfg),
231    g7_cfg_val = ct:get_config(g7_cfg_alias).
232
233t72(_) ->
234    suite_cfg_val = ct:get_config(suite_cfg),
235    g5_cfg_val = ct:get_config(g5_cfg),
236    g5_cfg_val = ct:get_config(g5_cfg_alias),
237    g7_cfg_val = ct:get_config(g7_cfg),
238    g7_cfg_val = ct:get_config(g7_cfg_alias),
239    t72_cfg_val = ct:get_config(t72_cfg).
240
241t81(_) ->
242    exit(should_be_skipped).
243
244t91(_) ->
245    exit(should_be_skipped).
246
247t101(_) ->
248    suite_cfg_val = ct:get_config(suite_cfg).
249
250t111(_) ->
251    suite_cfg_val = ct:get_config(suite_cfg).
252
253
254