1() = evalfile ("inc.sl");
2
3testing_feature ("qualifiers");
4
5private define simple_test_function ()
6{
7   variable q = __qualifiers ();
8   return q.qualifier;
9}
10
11if (3 != simple_test_function (;qualifier=3))
12  failed ("Simple qualifier test");
13
14public define qualifier_function ()
15{
16   variable q = __qualifiers ();
17   loop (3) q = __qualifiers ();
18
19   return _NARGS, q;
20}
21
22public variable Arg_List, Qual_Struct, Func_Ref, Struct;
23private define call_qualifier_function (f, args, q)
24{
25   Arg_List = args;
26   Qual_Struct = q;
27
28   loop (10) () = __qualifiers (;foo="bar");
29   variable args_expr
30     = strjoin (array_map (String_Type, &sprintf,
31			   "Arg_List[%d]", [0:length(args)-1]), ",");
32   variable fields = get_struct_field_names (q);
33   variable q_expr
34     = strjoin (array_map (String_Type, &sprintf,
35			   "%s=Qual_Struct.%s", fields, fields), ",");
36
37   variable expr = sprintf ("%s (%s ; %s);", f, args_expr, q_expr);
38   return eval (expr);
39}
40
41private define test_qualifiers (args, q)
42{
43   variable n = length (args), n1, q1;
44
45   Func_Ref = &qualifier_function;
46   Struct = struct { method = &qualifier_function };
47
48   variable fs = ["qualifier_function", "(@Func_Ref)", "Struct.method"];
49   variable ns = [n, n, n+1];
50
51   variable f, i;
52   _for i (0, 2, 1)
53     {
54	f = fs[i]; n = ns[i];
55	(n1, q1) = call_qualifier_function (f, args, q);
56	if (n != n1)
57	  failed ("Expecting _NARGS to be %d, found %d  -- f = %s", n, n1, f);
58	if (not _eqs (q, q1))
59	  failed ("Qualifiers to do match the expected values -- f = %s", f);
60     }
61}
62
63test_qualifiers ({1, 2, 3}, struct {a=1, b=3, c="foo"});
64test_qualifiers ({1, 2, test_qualifiers ({1,2}, struct{c=&cos})},
65		 struct {a=1, b=3, c="foo"}
66		 ; foo=1, bar=length ([1:10];baz=3));
67
68private define test_qualifiers ()
69{
70   variable q = __qualifiers ();
71   variable n, q1;
72
73   (n, q1) = qualifier_function (1,, ;; q);
74   if (n != 3)
75     failed ("function call did not handle implicit NULL arguments");
76   if (not _eqs (q, q1))
77     failed (";; form of qualifiers");
78}
79
80test_qualifiers ();
81test_qualifiers (;);
82test_qualifiers (;;);
83test_qualifiers (;;struct {foo=7});
84
85private define fun2 (x, y)
86{
87   return qualifier ("x", x), qualifier ("y", y);
88}
89
90private define fun1 (x, y)
91{
92   return fun2 (x, y;; __qualifiers ());
93}
94
95private define test_qualifier ()
96{
97   variable x, y, x0, y0, x1, y1;
98
99   x0 = 1; y0 = 2; x1 = "one"; y1 = "two";
100
101   (x, y) = fun1 (x0, y0; x=x1, y=y1);
102   if ((x != x1) || (y != y1))
103     failed ("qualifier intrinsic 1");
104
105   (x, y) = fun1 (x0, y0; y=y1);
106   if ((x != x0) || (y != y1))
107     failed ("qualifier intrinsic 2");
108
109   (x, y) = fun1 (x0, y0; x = x1);
110   if ((x != x1) || (y != y0))
111     failed ("qualifier intrinsic 3");
112}
113test_qualifier ();
114
115private define test_qualifier_exists (name, exists)
116{
117   if (exists != qualifier_exists (name))
118     failed ("qualifier_exists (%s) != %d", name, exists);
119}
120test_qualifier_exists ("foo", 0);
121test_qualifier_exists ("foo", 1; goo, foo=7);
122test_qualifier_exists ("goo", 1; goo, foo=7);
123test_qualifier_exists ("foo", 1; goo, foo);
124test_qualifier_exists ("boo", 0; goo, foo);
125test_qualifier_exists ("foo", 0; food=7);
126test_qualifier_exists ("foo", 0;; struct{food=7});
127test_qualifier_exists ("foo", 1;; struct{food=7, foo});
128
129private variable Funcs = Assoc_Type[];
130Funcs["f"] = &test_qualifier_exists;
131
132private define passthru ();
133private define test_qualifier_passing (name, exists)
134{
135   (@Funcs["f"])(name, exists;; __qualifiers);
136   (@Funcs["f"])(passthru(name, exists);; __qualifiers);
137   (@Funcs["f"])(name, exists;; passthru(__qualifiers));
138   (@passthru(Funcs["f"]))(name, exists;; __qualifiers);
139}
140
141test_qualifier_passing ("foo", 0);
142test_qualifier_passing ("foo", 1; goo, foo=7);
143test_qualifier_passing ("goo", 1; goo, foo=7);
144test_qualifier_passing ("foo", 1; goo, foo);
145test_qualifier_passing ("boo", 0; goo, foo);
146test_qualifier_passing ("foo", 0; food=7);
147test_qualifier_passing ("foo", 0;; struct{food=7});
148test_qualifier_passing ("foo", 1;; struct{food=7, foo});
149
150private define fun2 (x, y)
151{
152   return qualifier ("x", x), qualifier ("y", y);
153}
154
155private define fun1 (x, y)
156{
157   if (_NARGS != 2)
158     failed ("_NARGS=%d instead of 2 in fun1", _NARGS);
159   return fun2 (x, y;; __qualifiers ());
160}
161
162private define qualifiers_as_func (x,y,z)
163{
164   if (_NARGS != 3)
165     failed ("_NARGS=%d instead of 3 in qualifiers_as_func", _NARGS);
166
167   return __qualifiers ();
168}
169
170private define test_mixed_qualifiers ()
171{
172   variable x, y, x0, y0, x1, y1;
173   x0 = 1, y0 = 2; x1 = "one", y1="two";
174
175   (x,y) = fun1 (x0, y0; @qualifiers_as_func(1,2,3));
176   if ((x0 != x)||(y0!=y))
177     failed ("mixed qualifiers NULL");
178
179   (x,y) = fun1 (x0, y0; @qualifiers_as_func(1,2,3;x=x1));
180   if ((x != x1)||(y0!=y))
181     failed ("mixed qualifiers ;x=x1");
182
183   (x,y) = fun1 (x0, y0; x=x0, @qualifiers_as_func(1,2,3 ;x=x1));
184   if ((x != x1)||(y0!=y))
185     failed ("mixed qualifiers ;x=x0,x=x1");
186   (x,y) = fun1 (x0, y0; y=y0, @qualifiers_as_func(1,2,3;x=x1), x=x0);
187   if ((x != x0)||(y0!=y))
188     failed ("mixed qualifiers ;x=x1,x=x0");
189   (x,y) = fun1 (x0, y0; @qualifiers_as_func(1,2,3;x=x1,y=y1), x=y1);
190   if ((x != y1)||(y1!=y))
191     failed ("mixed qualifiers ;x=x1,y=y0,x=y1");
192}
193test_mixed_qualifiers ();
194
195private define fun1_method (obj)
196{
197   if (_NARGS != 1)
198     {
199	failed ("_NARGS=%d instead of 1 in fun1_method", _NARGS);
200     }
201
202   return fun1 (obj.x, obj.y ;; __qualifiers);
203}
204
205private define new_object ()
206{
207   return struct
208     {
209	method=&fun1_method,
210	x=qualifier("x"),
211	y=qualifier("y"),
212     };
213}
214
215private define test_qualifiers_in_methods ()
216{
217   variable x0 = 1, y0 = 2, x, y;
218   variable obj = new_object (;x=x0, y=y0);
219   (x,y) = obj.method ();
220   if ((x != x0) || (y != y0))
221     failed ("passing object qualifiers");
222
223   x0 = 3; y0 = 4;
224   (x,y) = obj.method (;x=3,y=4);
225   if ((x != x0) || (y != y0))
226     failed ("obj.method qualifiers");
227
228   x0 = 5; y0 = 6;
229   (x,y) = new_object (;x=x0,y=y0).method ();
230   if ((x != x0) || (y != y0))
231     failed ("new_object.method default qualifiers");
232
233   x0 = 7; y0 = 8;
234   (x,y) = new_object (;x=x0).method (;y=y0);
235   if ((x != x0) || (y != y0))
236     failed ("new_object.method default and specified qualifiers");
237}
238test_qualifiers_in_methods ();
239
240#iffalse
241% tests pre2.3.0-54
242private define test_empty_qualifiers (qval, defval)
243{
244   variable q;
245
246   q = qualifier ("foo");
247   if (q != qval)
248     failed ("test_empty_qualifiers 1");
249
250   q = qualifier ("foo", defval);
251   if (qval == NULL)
252     {
253	if (q != defval)
254	  {
255	     failed ("test_empty_qualifiers 2");
256	  }
257     }
258   else if (q != qval)
259     failed ("test_empty_qualifiers 3");
260}
261test_empty_qualifiers (2100, 3100; foo=2100);
262test_empty_qualifiers (2100, 3100; foo=2100, bar="x");
263test_empty_qualifiers (2100, 3100; bar="x", foo=2100);
264test_empty_qualifiers (1, 3100; foo);
265test_empty_qualifiers (1, 3100; foo,);
266test_empty_qualifiers (1, 3100; bar,foo,);
267test_empty_qualifiers (1, 3100; foo, bar="x");
268test_empty_qualifiers (NULL, 3100);
269#endif
270
271private define check_intrinsic_qualifier (func, qval, defval)
272{
273   variable val;
274
275   if (qval == NULL)
276     {
277	val = (@func)("foo", defval);
278	if (val != defval)
279	  failed ("%S(%S,%S) returned %S instead of %S",
280		  func, "foo", defval, val, defval);
281
282	% The integer 1 will get assigned to a qualifier without
283	% a value.  So, do not use this with strings
284	if (func == &check_intrin_string_qualifier)
285	  return;
286#iffalse
287	% pre2.3.0-54 semantics
288	val = (@func)("foo", defval; foo);
289	if (val != 1)
290	  failed ("%S(%S,%S; foo) returned %S instead of %S",
291		  func, "foo", defval, val, defval);
292#endif
293	return;
294     }
295   val = (@func)("foo", defval; foo=qval);
296   if (val != qval)
297     failed ("%S(%S,%S ;%S=%S) returned %S instead of %S",
298	     func, "foo", defval, "foo", qval, val, qval);
299}
300
301private define test_intrinsic_qualifiers ()
302{
303   check_intrinsic_qualifier (&check_intrin_int_qualifier, 2718, 3141);
304   check_intrinsic_qualifier (&check_intrin_int_qualifier, NULL, 3141);
305   check_intrinsic_qualifier (&check_intrin_int_qualifier, 2718h, 3141);
306
307   check_intrinsic_qualifier (&check_intrin_long_qualifier, NULL, 3141L);
308   check_intrinsic_qualifier (&check_intrin_long_qualifier, 2718, 3141L);
309   check_intrinsic_qualifier (&check_intrin_long_qualifier, 2718h, 3141L);
310
311   check_intrinsic_qualifier (&check_intrin_double_qualifier, NULL, 3.141);
312   check_intrinsic_qualifier (&check_intrin_double_qualifier, 2.718, 3.141);
313   check_intrinsic_qualifier (&check_intrin_double_qualifier, 2718, 3.141);
314
315   check_intrinsic_qualifier (&check_intrin_string_qualifier, NULL, "3.141");
316   check_intrinsic_qualifier (&check_intrin_string_qualifier, "2.718", "3.141");
317   check_intrinsic_qualifier (&check_intrin_string_qualifier, "2718"B, "3.141");
318}
319test_intrinsic_qualifiers ();
320
321print ("Ok\n");
322
323exit (0);
324
325