1;
2; AC 2017-12-14: one time again a bug report on problem on arrays
3; with one dim equal to unity.
4; In 0.9.7 Vanilla in structure, now in basic array.
5;
6; bug 1 reported after 0.9.7 delivery
7; bug 2 reported by Marteen R on Dec 13, 2017
8;
9; ------------------------
10;
11; Modifications history :
12; - 2017-12-14 : AC. initial version
13; - 2018-02-22 : AC : a test on self-promotion in L64 when needed is
14;   in "test_l64.pro"
15;
16; ------------------------
17; reported by Giloo in 2015-10-30
18; https://sourceforge.net/p/gnudatalanguage/bugs/675/
19;
20pro TEST_BUG_675, cumul_errors, verbose=verbose, $
21                  help=help, test=test, debug=debug
22;
23nb_errors=0
24;
25array1d=REPLICATE(0d,[9])
26array2d=REPLICATE(1d,[3,3])
27arraynotreally2d=REFORM(REPLICATE(1d,9),[9,1]); is equivalent to a 1-dim array
28;
29res=EXECUTE('array1d[0,0]=arraynotreally2d')
30if ~res then ERRORS_ADD, nb_errors, 'bad assigantion [0,0] not really 2D'
31;
32; this one should never work !
33;
34print, 'The following message is OK'
35res=EXECUTE('array1d[0,0]=array2d')
36if res then ERRORS_ADD, nb_errors, 'bad assigantion [0,0]'
37;
38res=EXECUTE('array1d[1,0,0]=array1d[1:8]')
39if ~res then ERRORS_ADD, nb_errors, 'bad assigantion [1,0,0]'
40
41res=EXECUTE('array1d[0]=arraynotreally2d')
42if ~res then ERRORS_ADD, nb_errors, 'bad assigantion [0]'
43;
44; -----------
45;
46BANNER_FOR_TESTSUITE, 'TEST_BUG_675', nb_errors, /status
47ERRORS_CUMUL, cumul_errors, nb_errors
48if KEYWORD_SET(test) then STOP
49;
50end
51;
52; ------------------------
53;
54pro TEST_SIZE_STRUCTURE, cumul_errors, verbose=verbose, $
55                         help=help, test=test, debug=debug
56;
57; note by AC: yes I have a snippet somewhere (;-;)
58BANNER_FOR_TESTSUITE, 'TEST_SIZE_STRUCTURE', $
59                      'missing code, please fix it !', /wide
60;
61end
62;
63; ------------------------
64; Reported by Maarten R. on Dec 13, 2017
65; A previous problem with other places for 1D was discovered
66; in the 0.9.7 (Vanilla) then solved in Debian .deb
67;
68function REMOVE_LAST_1D, input, verbose=verbose
69;
70while ((N_ELEMENTS(input) GT 1) AND (input[-1] EQ 1)) do begin
71   if KEYWORD_SET(verbose) then print, input
72   input=input[0:N_ELEMENTS(input)-2]
73endwhile
74;
75return, input
76;
77end
78;
79pro TEST_SIZE_HASH, cumul_errors, dims=dims, verbose=verbose, $
80                     help=help, test=test, debug=debug
81h = hash('a',1,'b',2,'c',3)
82count = h.count()
83nel = size(h, /N_elements)
84szchk = [1, nel, 11, nel]
85if (nel ne count) or ~array_equal(szchk, size(h)) then $
86    ERRORS_ADD, cumul_errors,' size(<hash>)  wrong'
87strucobj = size(h,/struct)
88if(strucobj.n_elements ne count ) then $
89    ERRORS_ADD, cumul_errors,' size(object array)  wrong'
90
91if keyword_set(test) then stop,' at end of test_size_hash'
92return
93end
94;
95pro TEST_SIZE_LIST, cumul_errors, dims=dims, verbose=verbose, $
96                     help=help, test=test, debug=debug
97h = list('a',1,'b',2,'c',3)
98count = h.count()
99nel = size(h, /N_elements)
100szchk = [1, nel, 11, nel]
101if (nel ne count) or ~array_equal(szchk, size(h)) then $
102    ERRORS_ADD, cumul_errors,' size(<list>)  wrong'
103strucobj = size(h,/struct)
104if(strucobj.n_elements ne count ) then $
105    ERRORS_ADD, cumul_errors,' size(object array)  wrong'
106
107if keyword_set(test) then stop,' at end of test_size_list'
108return
109end
110;
111pro TEST_SIZE_ARRAY, cumul_errors, dims=dims, verbose=verbose, $
112                     help=help, test=test, debug=debug
113;
114nb_errors=0
115;
116if ~KEYWORD_SET(dims) then dims=[1,2,3,4]
117;
118MESSAGE, /Continue, 'begin of test'
119print, 'Circulating (shift) on dims : ', dims
120;
121type=4 ; float. Should we iterate on the type ??
122;
123for ii=0, N_ELEMENTS(dims)-1 do begin
124   current_dims=SHIFT(dims, ii)
125   tab=MAKE_ARRAY(current_dims)
126   size_effective=SIZE(tab)
127   clean_dims=REMOVE_LAST_1D(current_dims)
128   size_expected=[N_ELEMENTS(clean_dims),clean_dims,type,PRODUCT(clean_dims,/pre)]
129   ;;
130   if ~ARRAY_EQUAL(size_effective,size_expected) then begin
131      ERRORS_ADD, nb_errors, 'bad SIZE for case :'+ii
132      print, 'current dims :', current_dims
133      print, 'correct (clean) dims :', clean_dims
134   endif
135   ;;
136   if KEYWORD_SET(verbose) then begin
137      print, 'Expected SIZE :', size_expected
138      print, 'computed SIZE :', size_effective
139
140   endif
141endfor
142;
143BANNER_FOR_TESTSUITE, 'TEST_SIZE_ARRAY', nb_errors, /status
144ERRORS_CUMUL, cumul_errors, nb_errors
145if KEYWORD_SET(test) then STOP
146;
147end
148;
149; ------------------------
150;
151pro TEST_SIZE, no_exit=no_exit, verbose=verbose, $
152               help=help, test=test, debug=debug
153;
154if KEYWORD_SET(help) then begin
155    print, 'pro TEST_SIZE, no_exit=no_exit, verbose=verbose, $'
156    print, '               help=help, test=test, debug=debug, $'
157    return
158endif
159;
160nb_errors=0
161;
162TEST_BUG_675, nb_errors, verbose=verbose
163;
164TEST_SIZE_STRUCTURE, nb_errors, verbose=verbose
165;
166TEST_SIZE_ARRAY, nb_errors, verbose=verbose
167TEST_SIZE_ARRAY, nb_errors, dims=[1,1,1,1,1], verbose=verbose
168TEST_SIZE_ARRAY, nb_errors, dims=[1,10,1,10,1], verbose=verbose
169;
170TEST_SIZE_HASH, nb_errors, verbose=verbose, $
171               help=help, test=test, debug=debug
172TEST_SIZE_LIST, nb_errors,  verbose=verbose, $
173               help=help, test=test, debug=debug
174; ----------------- final message ----------
175;
176BANNER_FOR_TESTSUITE, 'TEST_SIZE', nb_errors
177;
178if (nb_errors GT 0) AND ~KEYWORD_SET(no_exit) then EXIT, status=1
179;
180if KEYWORD_SET(test) then STOP
181;
182end
183