Merge remote-tracking branch 'origin/master' into YaSp
[scilab.git] / scilab / modules / development_tools / macros / testexamples.sci
1 // Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
2 // Copyright (C) 2005-2008 - INRIA - Serge STEER <serge.steer@inria.fr>
3 //
4 // This file must be used under the terms of the CeCILL.
5 // This source file is licensed as described in the file COPYING, which
6 // you should have received as part of this distribution.  The terms
7 // are also available at
8 // http://www.cecill.info/licences/Licence_CeCILL_V2.1-en.txt
9
10 function r=load_ref(name)
11     if exists(name)==0 then r=%f;return,end
12     v=evstr(name)
13     if type(v) == 9 then   v = ghdl2tree(v);end,
14     if type(v) == 128 then v=128,end //lu handle
15     load(%U,name+"_ref");
16     if exists(name+"_ref")==0 then
17         disp(msprintf(gettext("No variable %s_ref in reference file"),name))
18         r=%t
19         return
20     end
21     execstr("r=%CMP(v,"+name+"_ref);")
22 endfunction
23
24 function r=load_ref_nocheck(name)
25
26     if exists(name)==0 then r=%f;return,end
27     v=evstr(name)
28     if type(v) == 9 then   v = ghdl2tree(v);end,
29     if type(v) == 128 then v=128,end //lu handle
30     load(%U,name+"_ref");
31     if exists(name+"_ref")==0 then
32         disp(msprintf(gettext("No variable %s_ref in reference file"),name))
33         r=%t
34         return
35     end
36     r=%f
37
38 endfunction
39
40
41
42 function reinit_for_test()
43
44     //reinitialize some Scilab state to be able to reproduce the same tests
45     sdf();sda()
46     xdel(winsid())
47     grand("setgen","clcg4");grand("setall",11111111,22222222,33333333,44444444);
48     grand("setgen","kiss");grand("setsd",362436069,521288629,123456789,380116160);
49     grand("setgen","clcg2");grand("setsd",1234567890,123456789);
50     grand("setgen","urand");grand("setsd",0);
51     grand("setgen","fsultra");grand("setsd",1234567,7654321);
52     grand("setgen","mt");grand("setsd",5489);
53     rand("seed",0);
54     format("v",10);
55     clearglobal()
56
57 endfunction
58
59
60
61 function r=xdel_run(w,opt)
62
63     //Author : Serge Steer, april 2005, Copyright INRIA
64     //
65     //Compare the graphic windows to be cleared with the reference given in a Scilab  binary file.
66     // This function must mirror the  xdel_build one.
67
68     r=%f
69     if winsid()==[] then return,end
70     cur=xget("window")
71     //
72     if argn(2)==1 then
73         ids_=[]
74         for k=1:size(w,"*")
75             xset("window",w(k))
76             if get("figure_style")=="new" then ids_=[ids_,w(k)],end
77         end
78         load(%U,"ids_ref")
79         if or(ids_ref<>ids_) then r=%t,return,end
80         for k=ids_ref
81             %wins_=ghdl2tree(scf(k));
82             load(%U,"%wins_ref");
83             if %CMP(%wins_, %wins_ref) then r=%t,return,end
84         end
85         xdel(w)
86     else
87         if get("figure_style")=="old" then return,end
88         ids_=xget("window")
89         load(%U,"ids_ref")
90         if or(ids_ref<>ids_) then r=%t,return,end
91         %wins_=ghdl2tree(gcf());
92         load(%U,"%wins_ref");
93         if %CMP(%wins_,%wins_ref) then r=%t,return,end
94         xdel()
95     end
96     if or(winsid()==cur) then xset("window",cur),end
97
98 endfunction
99
100
101
102 function r=clf_run(w,opt)
103
104     //Author : Serge Steer, april 2005, Copyright INRIA
105     //
106     //Compare the graphic windows to be cleared with the reference given in  a Scilab  binary file.
107     // This function must mirror the  clf_build one.
108
109     r=%f
110     if winsid()==[] then return,end
111     cur=xget("window")
112     rhs=argn(2)
113     if rhs==1&type(w)==10 then opt=w;rhs=0,end
114     if winsid()==[] then return,end
115     //
116     if rhs==1 then
117         ids_=[]
118         if type(w)==9 then
119             H=w;w=[]
120             for h=H,w=[w,h.figure_id],end
121         end
122         for k=1:size(w,"*")
123             xset("window",w(k))
124             if get("figure_style")=="new" then ids_=[ids_,w(k)],end
125         end
126         load(%U,"ids_ref")
127         if or(ids_ref<>ids_) then r=%t,return,end
128         for k=ids_ref
129             %wins_=ghdl2tree(scf(k));
130             load(%U,"%wins_ref");
131             if %CMP(%wins_, %wins_ref) then r=%t,return,end
132         end
133         if rhs==1 then clf(w),else clf(w,opt),end
134     else
135         if get("figure_style")=="old" then return,end
136         ids_=xget("window")
137         load(%U,"ids_ref")
138         if or(ids_ref<>ids_) then r=%t,return,end
139         %wins_=ghdl2tree(gcf());
140         load(%U,"%wins_ref");
141         if %CMP(%wins_,%wins_ref) then r=%t,return,end
142         clf()
143     end
144     if or(winsid()==cur) then xset("window",cur),end
145
146 endfunction
147
148
149
150 function r=xbasc_run(w)
151
152     //Author : Serge Steer, april 2005, Copyright INRIA
153     //
154     //Compare the graphic windows to be cleared with the reference given in  a Scilab  binary file.
155     // This function must mirror the  xbasc_build one.
156     r=%f
157     if winsid()==[] then return,end
158     cur=xget("window")
159     //
160     if argn(2)==1 then
161         ids_=[]
162         for k=1:size(w,"*")
163             xset("window",w(k))
164             if get("figure_style")=="new" then ids_=[ids_,w(k)],end
165         end
166         load(%U,"ids_ref")
167         if or(ids_ref<>ids_) then r=%t,return,end
168         for k=ids_ref
169             %wins_=ghdl2tree(scf(k));
170             load(%U,"%wins_ref");
171             %wins_ref.figure_position=%wins_.figure_position
172             if %CMP(%wins_, %wins_ref) then r=%t,return,end
173         end
174
175         clf(w)
176     else
177         if get("figure_style")=="old" then return,end
178         ids_=xget("window");
179         load(%U,"ids_ref")
180         if or(ids_ref<>ids_) then r=%t,return,end
181         %wins_=ghdl2tree(gcf());
182         load(%U,"%wins_ref");
183         %wins_ref.figure_position=%wins_.figure_position
184         if %CMP(%wins_, %wins_ref) then r=%t,return,end
185         clf()
186     end
187     if or(winsid()==cur) then xset("window",cur),end
188
189 endfunction
190
191
192
193 function r=%CMP(%A,%B)
194
195     //Author : Serge Steer, april 2005, Copyright INRIA
196     //
197     // this function compares two variables, floating points data are
198     // compared using a relative tolerance
199
200     r=%f
201     tol=0.00001
202     if type(%A)<>type(%B) then r=%t,return,end
203     select type(%A)
204     case 1 then //float
205         if or(size(%A)<>size(%B)) then  r=%t,return,end
206         %ka=~isnan(%A);%kb=~isnan(%B);
207         if or(%ka<>%kb)  then  r=%t,return,end
208         if isreal(%A)<>isreal(%A)  then  r=%t,return,end
209         if or(clean(%A(%ka)-%B(%kb))<>0) then  r=%t,return,end
210     case 2 then //polynomial
211         if or(size(%A)<>size(%B)) then  r=%t,return,end
212         if or(degree(%A)<>degree(%B)) then r=%t,return,end
213         if or(clean(%A-%B)<>0) then  r=%t,return,end
214     case 4 then //boolean
215         if or(size(%A)<>size(%B)) then  r=%t,return,end
216         if or(%A<>%B) then  r=%t,return,end
217     case 5 then //sparse
218         if or(size(%A)<>size(%B)) then  r=%t,return,end
219         [ija,%A]=spget(%A);[ijb,%B]=spget(%B);
220         if or(ija<>ijb) then  r=%t,return,end
221         %ka=~isnan(%A);%kb=~isnan(%B);
222         if or(%ka<>%kb)  then  r=%t,return,end
223         if or(clean(%A(%ka)-%B(%kb))<>0) then  r=%t,return,end
224     case 6 then //boolean sparse
225         if or(size(%A)<>size(%B)) then  r=%t,return,end
226         if or(%A<>%B) then  r=%t,return,end
227     case 8 then //int
228         if or(inttype(%A)<>inttype(%B)) then  r=%t,return,end
229         if or(size(%A)<>size(%B)) then  r=%t,return,end
230         if or(%A<>%B) then  r=%t,return,end
231     case 9 then //handle
232         if or(size(%A)<>size(%B)) then  r=%t,return,end
233         //    if or(%A<>%B) then  r=%t,return,end
234     case 10 then //string
235         if or(size(%A)<>size(%B)) then  r=%t,return,end
236         if or(%A<>%B) then  r=%t,return,end
237     case 13 then //compiled function
238         if %A<>%B then  r=%t,return,end
239     case 14 then //library
240         if or(gsort(string(%A))<>gsort(string(%B))) then  r=%t,return,end
241     case 15 then //list
242         if or(lstsize(%A)<>lstsize(%B)) then  r=%t,return,end
243         if or(definedfields(%A)<>definedfields(%B)) then r=%t,return,end
244         for k = definedfields(%A)
245             if %CMP(%A(k),%B(k)) then r=%t,return,end
246         end
247     case 16 then //tlist
248         if or(lstsize(%A)<>lstsize(%B)) then  r=%t,return,end
249         if or(definedfields(%A)<>definedfields(%B)) then r=%t,return,end
250         if typeof(%A)=="rational" then
251             if or(clean(%A-%B)<>0) then r=%t,end
252             return
253         end
254         for k = definedfields(%A)
255             if %CMP(%A(k),%B(k)) then r=%t,return,end
256         end
257     case 17 then //mlist
258         if or(lstsize(%A)<>lstsize(%B)) then  r=%t,return,end
259         if or(definedfields(%A)<>definedfields(%B)) then r=%t,return,end
260         for k = definedfields(%A)
261             if %CMP(getfield(k,%A),getfield(k,%B)) then r=%t,return,end
262         end
263     case 130 then
264         if %A<>%B then  r=%t,return,end
265     else
266         r=%f
267     end
268 endfunction