← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcsrc/tests/test/cg/tshlshr.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/tests/test/cg/tshlshr.pp
 
1
{***********************************************************}
 
2
{ CODE GENERATOR TEST SUITE                                *}
 
3
{***********************************************************}
 
4
{ NODE TESTED : secondshlshr()                             *}
 
5
{***********************************************************}
 
6
{ PRE-REQUISITES: secondload()                              }
 
7
{                 secondassign()                            }
 
8
{                 secondtypeconv()                          }
 
9
{                 secondinline() with strings only!         }
 
10
{                 secondadd() comparison                    }
 
11
{                 secondifn()                               }
 
12
{***********************************************************}
 
13
{ DEFINES  :  FPC if target is Free Pascal compiler         }
 
14
{***********************************************************}
 
15
{ REMARKS: None                                             }
 
16
{***********************************************************}
 
17
Program tshlshr;
 
18
 
 
19
{----------------------------------------------------}
 
20
{ Cases to test:                                     }
 
21
{   RIGHT NODE (shift count value)                   }
 
22
{     - LOC_CREGISTER                                }
 
23
{     - LOC_REFERENCE / LOC_MEM                      }
 
24
{     - LOC_REGISTER                                 }
 
25
{     - numeric constant                             }
 
26
{   LEFT NODE (value to shift)                       }
 
27
{     - LOC_CREGISTER                                }
 
28
{     - LOC_REFERENCE / LOC_MEM                      }
 
29
{     - LOC_REGISTER                                 }
 
30
{----------------------------------------------------}
 
31
procedure test(value, required: {$ifndef fpc}longint{$else fpc}int64{$endif fpc});
 
32
begin
 
33
  if value <> required then
 
34
    begin
 
35
      writeln('Got ',value,' instead of ',required);
 
36
      halt(1);
 
37
    end
 
38
  else
 
39
    writeln('Passed!');
 
40
end;
 
41
 
 
42
type
 
43
tint64record = packed record
 
44
{$ifdef ENDIAN_BIG}
 
45
   highval : longint;
 
46
   lowval  : longint;
 
47
{$else}
 
48
   lowval  : longint;
 
49
   highval : longint;
 
50
{$endif}
 
51
end;
 
52
 
 
53
 
 
54
var
 
55
 longres :  longint;
 
56
 longcnt : longint;
 
57
 bytecnt : shortint;
 
58
 byteres : shortint;
 
59
{$IFDEF FPC}
 
60
 int64res : int64;
 
61
 int64cnt : int64;
 
62
 int64rec : tint64record;
 
63
{$ENDIF}
 
64
Begin
 
65
   WriteLn('------------------------------ LONGINT --------------------------------');
 
66
   { left : LOC_REFERENCE     }
 
67
   { right : numeric constant }
 
68
   WriteLn('(left) : LOC_REFERENCE; (right) : ordinal constant');
 
69
   longres:=1;
 
70
   longres := longres shl 15;
 
71
   Write('(SHL) Value should be 32768...');
 
72
   test(longres, 32768);
 
73
 
 
74
   longres:=-1;
 
75
   longres := longres shl 15;
 
76
   Write('(SHL) Value should be -32768...');
 
77
   test(longres, -32768);
 
78
 
 
79
   longres:=1;
 
80
   longres := longres shl 33;
 
81
   Write('(SHL) Value should be 2...');
 
82
   test(longres, 2);
 
83
 
 
84
   longres:=$8000;
 
85
   longres := longres shr 15;
 
86
   Write('(SHR) Value should be 1...');
 
87
   test(longres, 1);
 
88
 
 
89
   longres:=-1;
 
90
   longres := longres shr 15;
 
91
   Write('(SHR) Value should be 131071...');
 
92
   test(longres, 131071);
 
93
 
 
94
   longres:=$FFFF;
 
95
   longres := longres shr 33;
 
96
   Write('(SHR) Value should be 32767...');
 
97
   test(longres, 32767);
 
98
 
 
99
   { left : LOC_REFERENCE }
 
100
   { right : LOC_REFERENCE }
 
101
   WriteLn('(left) : LOC_REFERENCE; (right) : LOC_REFERENCE');
 
102
 
 
103
{
 
104
   longres := 1;
 
105
   longcnt := -2;
 
106
   longres:=longres shl longcnt ;
 
107
   Write('(SHL) Value should be 1073741824...');
 
108
   test(longres, 1073741824);
 
109
}
 
110
 
 
111
   longres:=1;
 
112
   longcnt:=15;
 
113
   longres := longres shl longcnt;
 
114
   Write('(SHL) Value should be 32768...');
 
115
   test(longres, 32768);
 
116
 
 
117
   longres:=-1;
 
118
   longcnt := 15;
 
119
   longres := longres shl longcnt;
 
120
   Write('(SHL) Value should be -32768...');
 
121
   test(longres, -32768);
 
122
 
 
123
{
 
124
   longres := 1;
 
125
   longcnt := -2;
 
126
   longres:=longres shr longcnt ;
 
127
   Write('(SHR) Value should be 0...');
 
128
   test(longres, 0);
 
129
}
 
130
 
 
131
   longres:=32768;
 
132
   longcnt:=15;
 
133
   longres := longres shr longcnt;
 
134
   Write('(SHR) Value should be 1...');
 
135
   test(longres, 1);
 
136
 
 
137
   longres:=-1;
 
138
   longcnt := 15;
 
139
   longres := longres shl longcnt;
 
140
   Write('(SHR) Value should be -32768...');
 
141
   test(longres, -32768);
 
142
 
 
143
   { left : LOC_REFERENCE }
 
144
   { right : LOC_REGISRER }
 
145
{
 
146
   WriteLn('(left) : LOC_REFERENCE; (right) : LOC_REGISTER');
 
147
   longres := 1;
 
148
   bytecnt := -2;
 
149
   longres:=longres shl bytecnt ;
 
150
   Write('(SHL) Value should be 1073741824...');
 
151
   test(longres, 1073741824);
 
152
}
 
153
 
 
154
   longres:=1;
 
155
   bytecnt:=15;
 
156
   longres := longres shl bytecnt;
 
157
   Write('(SHL) Value should be 32768...');
 
158
   test(longres, 32768);
 
159
 
 
160
   longres:=-1;
 
161
   bytecnt := 15;
 
162
   longres := longres shl bytecnt;
 
163
   Write('(SHL) Value should be -32768...');
 
164
   test(longres, -32768);
 
165
 
 
166
{
 
167
   longres := 1;
 
168
   bytecnt := -2;
 
169
   longres:=longres shr bytecnt ;
 
170
   Write('(SHR) Value should be 0...');
 
171
   test(longres, 0);
 
172
}
 
173
 
 
174
   longres:=32768;
 
175
   bytecnt:=15;
 
176
   longres := longres shr bytecnt;
 
177
   Write('(SHR) Value should be 1...');
 
178
   test(longres, 1);
 
179
 
 
180
   longres:=-1;
 
181
   bytecnt := 15;
 
182
   longres := longres shr bytecnt;
 
183
   Write('(SHR) Value should be 131071...');
 
184
   test(longres, 131071);
 
185
 
 
186
   WriteLn('(left) : LOC_REGISTER; (right) : LOC_REGISTER');
 
187
   byteres := 1;
 
188
   bytecnt := 2;
 
189
   byteres := byteres shl bytecnt;
 
190
   Write('(SHL) Value should be 4...');
 
191
   test(byteres, 4);
 
192
 
 
193
 
 
194
   byteres := 4;
 
195
   bytecnt := 2;
 
196
   byteres := byteres shr bytecnt;
 
197
   Write('(SHR) Value should be 1...');
 
198
   test(byteres, 1);
 
199
 
 
200
{$IFDEF FPC}
 
201
   WriteLn('------------------------------  INT64  --------------------------------');
 
202
   { left : LOC_REFERENCE     }
 
203
   { right : numeric constant }
 
204
   WriteLn('(left) : LOC_REFERENCE; (right) : ordinal constant');
 
205
   int64res:=1;
 
206
   int64res := int64res shl 15;
 
207
   Write('(SHL) Value should be 32768...');
 
208
   test(int64res, 32768);
 
209
 
 
210
   int64res:=-1;
 
211
   int64res := int64res shl 15;
 
212
   Write('(SHL) Value should be -32768...');
 
213
   test(int64res, -32768);
 
214
 
 
215
 
 
216
   int64res:=1;
 
217
   int64res := int64res shl 65;
 
218
   Write('(SHL) Value should be 2...');
 
219
   test(int64res, 2);
 
220
 
 
221
   int64res:=$8000;
 
222
   int64res := int64res shr 15;
 
223
   Write('(SHR) Value should be 1...');
 
224
   test(int64res, 1);
 
225
 
 
226
   int64res:=$FFFF;
 
227
   int64res := int64res shr 65;
 
228
   Write('(SHR) Value should be 32767...');
 
229
   test(int64res, 32767);
 
230
 
 
231
   { left : LOC_REFERENCE }
 
232
   { right : LOC_REFERENCE }
 
233
{
 
234
   WriteLn('(left) : LOC_REFERENCE; (right) : LOC_REFERENCE');
 
235
   int64res := 1;
 
236
   int64cnt := -2;
 
237
   int64res:=int64res shl int64cnt ;
 
238
   Write('(SHL) Value should be 1073741824...');
 
239
   test(int64res, 1073741824);
 
240
}
 
241
 
 
242
   int64res:=1;
 
243
   int64cnt:=15;
 
244
   int64res := int64res shl int64cnt;
 
245
   Write('(SHL) Value should be 32768...');
 
246
   test(int64res, 32768);
 
247
 
 
248
 
 
249
   int64res:=-1;
 
250
   int64cnt := 15;
 
251
   int64res := int64res shl int64cnt;
 
252
   Write('(SHL) Value should be -32768...');
 
253
   test(int64res, -32768);
 
254
 
 
255
   int64res := 1;
 
256
   int64cnt := 33;
 
257
   int64res := int64res shl int64cnt;
 
258
   Write('(SHL) Value should be 2 in high longint (85899345)...');
 
259
   move(int64res,int64rec, sizeof(int64));
 
260
   test(int64rec.highval, 2);
 
261
{   test(int64res, 8589934592);}
 
262
 
 
263
 
 
264
{
 
265
   int64res := 1;
 
266
   int64cnt := -2;
 
267
   int64res:=int64res shr int64cnt ;
 
268
   Write('(SHR) Value should be 0...');
 
269
   test(int64res and $FFFFFFFF, 0);
 
270
}
 
271
   int64res:=32768;
 
272
   int64cnt:=15;
 
273
   int64res := int64res shr int64cnt;
 
274
   Write('(SHR) Value should be 1...');
 
275
   test(int64res, 1);
 
276
 
 
277
   int64res:=-1;
 
278
   int64cnt := 15;
 
279
   int64res := int64res shl int64cnt;
 
280
   Write('(SHR) Value should be -32768...');
 
281
   test(int64res, -32768);
 
282
 
 
283
   { left : LOC_REFERENCE }
 
284
   { right : LOC_REGISRER }
 
285
{
 
286
  WriteLn('(left) : LOC_REFERENCE; (right) : LOC_REGISTER');
 
287
   int64res := 1;
 
288
   bytecnt := -2;
 
289
   int64res:=int64res shl bytecnt ;
 
290
   Write('(SHL) Value should be 1073741824...');
 
291
   test(int64res, 1073741824);
 
292
}
 
293
 
 
294
   int64res:=1;
 
295
   bytecnt:=15;
 
296
   int64res := int64res shl bytecnt;
 
297
   Write('(SHL) Value should be 32768...');
 
298
   test(int64res, 32768);
 
299
 
 
300
 
 
301
   int64res:=-1;
 
302
   bytecnt := 15;
 
303
   int64res := int64res shl bytecnt;
 
304
   Write('(SHL) Value should be -32768...');
 
305
   test(int64res, -32768);
 
306
 
 
307
{
 
308
   int64res := 1;
 
309
   bytecnt := -2;
 
310
   int64res:=int64res shr bytecnt ;
 
311
   Write('(SHR) Value should be 0...');
 
312
   test(int64res and $FFFFFFFF, 0);
 
313
}
 
314
 
 
315
   int64res:=32768;
 
316
   bytecnt:=15;
 
317
   int64res := int64res shr bytecnt;
 
318
   Write('(SHR) Value should be 1...');
 
319
   test(int64res, 1);
 
320
 
 
321
   int64res := 1;
 
322
   bytecnt := 33;
 
323
   int64res := int64res shl bytecnt;
 
324
   Write('(SHL) Value should be 2 in high longint (85899345)...');
 
325
   move(int64res,int64rec, sizeof(int64));
 
326
   test(int64rec.highval, 2);
 
327
 
 
328
{   int64res:=-1;
 
329
   bytecnt := 15;
 
330
   int64res := int64res shr bytecnt;
 
331
   WriteLn('(SHR) Value should be 131071...',int64res);}
 
332
 
 
333
{$ENDIF}
 
334
end.