← Back to branch summary

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

« back to all changes in this revision

Viewing changes to fpcsrc/tests/test/cg/tsubst.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/tsubst.pp
 
1
{****************************************************************}
 
2
{  CODE GENERATOR TEST PROGRAM                                   }
 
3
{****************************************************************}
 
4
{ NODE TESTED : secondsubscriptn(), partial secondload()         }
 
5
{****************************************************************}
 
6
{ PRE-REQUISITES: secondload()                                   }
 
7
{                 secondassign()                                 }
 
8
{****************************************************************}
 
9
{ DEFINES:   VERBOSE = Write test information to screen          }
 
10
{            FPC     = Target is FreePascal compiler             }
 
11
{****************************************************************}
 
12
{ REMARKS:                                                       }
 
13
{                                                                }
 
14
{                                                                }
 
15
{                                                                }
 
16
{****************************************************************}
 
17
Program tsubst1;
 
18
{$mode objfpc}
 
19
 
 
20
 
 
21
{$IFNDEF FPC}
 
22
type  smallint = integer;
 
23
{$ENDIF}
 
24
const
 
25
 { Should be equal to the maximum offset possible in indirect addressing
 
26
   mode with displacement. (CPU SPECIFIC) }
 
27
 
 
28
{$ifdef cpu68k}
 
29
 MAX_DISP = 32767;
 
30
{$else}
 
31
 MAX_DISP = 65535;
 
32
{$endif}
 
33
 
 
34
{ These different alignments are described in the PowerPC ABI
 
35
  supplement, they should represent most possible cases.
 
36
}
 
37
type
 
38
tlevel1rec = record
 
39
 c: byte;
 
40
end;
 
41
 
 
42
tlevel2rec = record
 
43
 c: byte;
 
44
 d: byte;
 
45
 s: word;
 
46
 n: longint;
 
47
end;
 
48
 
 
49
tlevel3rec = record
 
50
 c: byte;
 
51
 s: word;
 
52
end;
 
53
 
 
54
tlevel4rec = record
 
55
 c: byte;
 
56
 i : int64;
 
57
 s: word;
 
58
end;
 
59
 
 
60
tlevel5rec = record
 
61
 c: byte;
 
62
 s: word;
 
63
 j: longint;
 
64
end;
 
65
 
 
66
tlevel1rec_big = record
 
67
 fill : array[1..MAX_DISP] of byte;
 
68
 c: byte;
 
69
end;
 
70
 
 
71
tlevel2rec_big = record
 
72
 fill : array[1..MAX_DISP] of byte;
 
73
 c: byte;
 
74
 d: byte;
 
75
 s: word;
 
76
 n: longint;
 
77
end;
 
78
 
 
79
tlevel3rec_big = record
 
80
 fill : array[1..MAX_DISP] of byte;
 
81
 c: byte;
 
82
 s: word;
 
83
end;
 
84
 
 
85
tlevel4rec_big = record
 
86
 fill : array[1..MAX_DISP] of byte;
 
87
 c: byte;
 
88
 i : int64;
 
89
 s: word;
 
90
end;
 
91
 
 
92
tlevel5rec_big = record
 
93
 fill : array[1..MAX_DISP] of byte;
 
94
 c: byte;
 
95
 s: word;
 
96
 j: longint;
 
97
end;
 
98
 
 
99
{ packed record, for testing misaligned access }
 
100
tlevel1rec_packed = packed record
 
101
 c: byte;
 
102
end;
 
103
 
 
104
tlevel2rec_packed = packed record
 
105
 c: byte;
 
106
 d: byte;
 
107
 s: word;
 
108
 n: longint;
 
109
end;
 
110
 
 
111
tlevel3rec_packed = packed record
 
112
 c: byte;
 
113
 s: word;
 
114
end;
 
115
 
 
116
tlevel4rec_packed = packed record
 
117
 c: byte;
 
118
 i : int64;
 
119
 s: word;
 
120
end;
 
121
 
 
122
tlevel5rec_packed = packed record
 
123
 c: byte;
 
124
 s: word;
 
125
 j: longint;
 
126
end;
 
127
 
 
128
tclass1 = class
 
129
 fill : array[1..MAX_DISP] of byte;
 
130
 c: byte;
 
131
 s: word;
 
132
 j: longint;
 
133
end;
 
134
 
 
135
tclass2 = class
 
136
 c: byte;
 
137
 s: word;
 
138
 i: int64;
 
139
end;
 
140
 
 
141
 
 
142
 { test with global variables }
 
143
 const
 
144
  RESULT_U8BIT = $55;
 
145
  RESULT_U16BIT = $500F;
 
146
  RESULT_S32BIT = $500F0000;
 
147
  RESULT_S64BIT = $500F0000;
 
148
 
 
149
 
 
150
 
 
151
 
 
152
 
 
153
 level1rec : tlevel1rec =
 
154
 (
 
155
  c: RESULT_U8BIT
 
156
 );
 
157
 
 
158
 level2rec : tlevel2rec =
 
159
 (
 
160
   c: RESULT_U8BIT;
 
161
   d: RESULT_U8BIT;
 
162
   s: RESULT_U16BIT;
 
163
   n: RESULT_S32BIT;
 
164
 );
 
165
 
 
166
 level3rec : tlevel3rec =
 
167
 (
 
168
  c: RESULT_U8BIT;
 
169
  s: RESULT_U16BIT;
 
170
 
 
171
 );
 
172
 
 
173
 level4rec : tlevel4rec =
 
174
 (
 
175
  c: RESULT_U8BIT;
 
176
  i : RESULT_S64BIT;
 
177
  s : RESULT_U16BIT
 
178
 );
 
179
 
 
180
 level5rec : tlevel5rec =
 
181
 (
 
182
   c: RESULT_U8BIT;
 
183
   s: RESULT_U16BIT;
 
184
   j: RESULT_S32BIT;
 
185
 );
 
186
 
 
187
 level1rec_packed : tlevel1rec_packed =
 
188
 (
 
189
  c: RESULT_U8BIT
 
190
 );
 
191
 
 
192
 level2rec_packed : tlevel2rec_packed =
 
193
 (
 
194
   c: RESULT_U8BIT;
 
195
   d: RESULT_U8BIT;
 
196
   s: RESULT_U16BIT;
 
197
   n: RESULT_S32BIT;
 
198
 );
 
199
 
 
200
 level3rec_packed : tlevel3rec_packed =
 
201
 (
 
202
  c: RESULT_U8BIT;
 
203
  s: RESULT_U16BIT;
 
204
 );
 
205
 
 
206
 level4rec_packed : tlevel4rec_packed =
 
207
 (
 
208
  c: RESULT_U8BIT;
 
209
  i : RESULT_S64BIT;
 
210
  s : RESULT_U16BIT
 
211
 );
 
212
 
 
213
 level5rec_packed : tlevel5rec_packed =
 
214
 (
 
215
   c: RESULT_U8BIT;
 
216
   s: RESULT_U16BIT;
 
217
   j: RESULT_S32BIT;
 
218
 );
 
219
 
 
220
    procedure fail;
 
221
    begin
 
222
      WriteLn('Failure.');
 
223
      halt(1);
 
224
    end;
 
225
 
 
226
var
 
227
 c,d: byte;
 
228
 s: word;
 
229
 n,j: longint;
 
230
 i: int64;
 
231
 failed : boolean;
 
232
 class1 : tclass1;
 
233
 class2 : tclass2;
 
234
 
 
235
 procedure clear_globals;
 
236
  begin
 
237
    c:=0;
 
238
    d:=0;
 
239
    s:=0;
 
240
    n:=0;
 
241
    j:=0;
 
242
    i:=0;
 
243
    class1:=nil;
 
244
    class2:=nil
 
245
  end;
 
246
 
 
247
 
 
248
 function getclass : tclass1;
 
249
  begin
 
250
    getclass := class1;
 
251
  end;
 
252
 
 
253
 function getclass2: tclass2;
 
254
  begin
 
255
    getclass2 := class2;
 
256
  end;
 
257
 
 
258
{$ifndef cpu68k}
 
259
 procedure testlocal_big_1;
 
260
 var
 
261
   local1rec_big : tlevel1rec_big;
 
262
  begin
 
263
     clear_globals;
 
264
     local1rec_big.c := RESULT_U8BIT;
 
265
     c:= local1rec_big.c;
 
266
     if c <> RESULT_U8BIT then
 
267
       failed := true;
 
268
  end;
 
269
 
 
270
 
 
271
  procedure testlocal_big_2;
 
272
   var
 
273
    local2rec_big : tlevel2rec_big;
 
274
   begin
 
275
     clear_globals;
 
276
     { setup values - assign }
 
277
     local2rec_big.c := RESULT_U8BIT;
 
278
     local2rec_big.d := RESULT_U8BIT;
 
279
     local2rec_big.s := RESULT_U16BIT;
 
280
     local2rec_big.n := RESULT_S32BIT;
 
281
     { load values - load }
 
282
     c:= local2rec_big.c;
 
283
     if c <> RESULT_U8BIT then
 
284
       failed := true;
 
285
     d:= local2rec_big.d;
 
286
     if d <> RESULT_U8BIT then
 
287
       failed := true;
 
288
     s:= local2rec_big.s;
 
289
     if s <> RESULT_U16BIT then
 
290
       failed := true;
 
291
     n:= local2rec_big.n;
 
292
     if n <> RESULT_S32BIT then
 
293
       failed := true;
 
294
   end;
 
295
 
 
296
 
 
297
   procedure testlocal_big_3;
 
298
    var
 
299
     local3rec_big : tlevel3rec_big;
 
300
    begin
 
301
     clear_globals;
 
302
     { setup values - assign }
 
303
     local3rec_big.c := RESULT_U8BIT;
 
304
     local3rec_big.s := RESULT_U16BIT;
 
305
     c:= local3rec_big.c;
 
306
     if c <> RESULT_U8BIT then
 
307
       failed := true;
 
308
     s:= local3rec_big.s;
 
309
     if s <> RESULT_U16BIT then
 
310
       failed := true;
 
311
    end;
 
312
 
 
313
    procedure testlocal_big_4;
 
314
    var
 
315
     local4rec_big : tlevel4rec_big;
 
316
     begin
 
317
         clear_globals;
 
318
         { setup values - assign }
 
319
         local4rec_big.c := RESULT_U8BIT;
 
320
         local4rec_big.i := RESULT_S64BIT;
 
321
         local4rec_big.s := RESULT_U16BIT;
 
322
 
 
323
         c:= local4rec_big.c;
 
324
         if c <> RESULT_U8BIT then
 
325
           failed := true;
 
326
         i:= local4rec_big.i;
 
327
         if i <> RESULT_S64BIT then
 
328
           failed := true;
 
329
         s:= local4rec_big.s;
 
330
         if s <> RESULT_U16BIT then
 
331
           failed := true;
 
332
     end;
 
333
 
 
334
 
 
335
     procedure testlocal_big_5;
 
336
     var
 
337
      local5rec_big : tlevel5rec_big;
 
338
      begin
 
339
       clear_globals;
 
340
       { setup values - assign }
 
341
       local5rec_big.c := RESULT_U8BIT;
 
342
       local5rec_big.s := RESULT_U16BIT;
 
343
       local5rec_big.j := RESULT_S32BIT;
 
344
       c:= local5rec_big.c;
 
345
       if c <> RESULT_U8BIT then
 
346
        failed := true;
 
347
       s:= local5rec_big.s;
 
348
       if s <> RESULT_U16BIT then
 
349
        failed := true;
 
350
       j:= local5rec_big.j;
 
351
       if j <> RESULT_S32BIT then
 
352
        failed := true;
 
353
     end;
 
354
{$endif}
 
355
 
 
356
procedure testlocals;
 
357
var
 
358
 local1rec : tlevel1rec_packed;
 
359
 local2rec : tlevel2rec_packed;
 
360
 local3rec : tlevel3rec_packed;
 
361
 local4rec : tlevel4rec_packed;
 
362
 local5rec : tlevel5rec_packed;
 
363
begin
 
364
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
 
365
 { normal record access }
 
366
 Write('Non-Aligned simple local record access (secondvecn())...');
 
367
 failed := false;
 
368
 
 
369
 clear_globals;
 
370
 
 
371
 clear_globals;
 
372
 local1rec.c := RESULT_U8BIT;
 
373
 c:= local1rec.c;
 
374
 if c <> RESULT_U8BIT then
 
375
   failed := true;
 
376
 
 
377
 clear_globals;
 
378
 { setup values - assign }
 
379
 local2rec.c := RESULT_U8BIT;
 
380
 local2rec.d := RESULT_U8BIT;
 
381
 local2rec.s := RESULT_U16BIT;
 
382
 local2rec.n := RESULT_S32BIT;
 
383
 { load values - load }
 
384
 c:= local2rec.c;
 
385
 if c <> RESULT_U8BIT then
 
386
   failed := true;
 
387
 d:= local2rec.d;
 
388
 if d <> RESULT_U8BIT then
 
389
   failed := true;
 
390
 s:= local2rec.s;
 
391
 if s <> RESULT_U16BIT then
 
392
   failed := true;
 
393
 n:= local2rec.n;
 
394
 if n <> RESULT_S32BIT then
 
395
   failed := true;
 
396
 
 
397
 
 
398
 clear_globals;
 
399
 { setup values - assign }
 
400
 local3rec.c := RESULT_U8BIT;
 
401
 local3rec.s := RESULT_U16BIT;
 
402
 c:= local3rec.c;
 
403
 if c <> RESULT_U8BIT then
 
404
   failed := true;
 
405
 s:= local3rec.s;
 
406
 if s <> RESULT_U16BIT then
 
407
   failed := true;
 
408
 
 
409
 clear_globals;
 
410
 { setup values - assign }
 
411
 local4rec.c := RESULT_U8BIT;
 
412
 local4rec.i := RESULT_S64BIT;
 
413
 local4rec.s := RESULT_U16BIT;
 
414
 
 
415
 c:= local4rec.c;
 
416
 if c <> RESULT_U8BIT then
 
417
   failed := true;
 
418
 i:= local4rec.i;
 
419
 if i <> RESULT_S64BIT then
 
420
   failed := true;
 
421
 s:= local4rec.s;
 
422
 if s <> RESULT_U16BIT then
 
423
   failed := true;
 
424
 
 
425
 clear_globals;
 
426
 { setup values - assign }
 
427
 local5rec.c := RESULT_U8BIT;
 
428
 local5rec.s := RESULT_U16BIT;
 
429
 local5rec.j := RESULT_S32BIT;
 
430
 
 
431
 c:= local5rec.c;
 
432
 if c <> RESULT_U8BIT then
 
433
   failed := true;
 
434
 s:= local5rec.s;
 
435
 if s <> RESULT_U16BIT then
 
436
   failed := true;
 
437
 j:= local5rec.j;
 
438
 if j <> RESULT_S32BIT then
 
439
   failed := true;
 
440
 
 
441
 if failed then
 
442
   fail
 
443
 else
 
444
   WriteLN('Passed!');
 
445
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
 
446
end;
 
447
{---------------------------}
 
448
 
 
449
var
 
450
 level1rec_big : tlevel1rec_big;
 
451
 level2rec_big : tlevel2rec_big;
 
452
 level3rec_big : tlevel3rec_big;
 
453
 level4rec_big : tlevel4rec_big;
 
454
 level5rec_big : tlevel5rec_big;
 
455
begin
 
456
 { normal record access }
 
457
 Write('Aligned simple global record access (secondvecn())...');
 
458
 failed := false;
 
459
 
 
460
 clear_globals;
 
461
 c:= level1rec.c;
 
462
 if c <> RESULT_U8BIT then
 
463
   failed := true;
 
464
 
 
465
 clear_globals;
 
466
 c:= level2rec.c;
 
467
 if c <> RESULT_U8BIT then
 
468
   failed := true;
 
469
 d:= level2rec.d;
 
470
 if d <> RESULT_U8BIT then
 
471
   failed := true;
 
472
 s:= level2rec.s;
 
473
 if s <> RESULT_U16BIT then
 
474
   failed := true;
 
475
 n:= level2rec.n;
 
476
 if n <> RESULT_S32BIT then
 
477
   failed := true;
 
478
 
 
479
 
 
480
 clear_globals;
 
481
 c:= level3rec.c;
 
482
 if c <> RESULT_U8BIT then
 
483
   failed := true;
 
484
 s:= level3rec.s;
 
485
 if s <> RESULT_U16BIT then
 
486
   failed := true;
 
487
 
 
488
 
 
489
 clear_globals;
 
490
 c:= level4rec.c;
 
491
 if c <> RESULT_U8BIT then
 
492
   failed := true;
 
493
 i:= level4rec.i;
 
494
 if i <> RESULT_S64BIT then
 
495
   failed := true;
 
496
 s:= level4rec.s;
 
497
 if s <> RESULT_U16BIT then
 
498
   failed := true;
 
499
 
 
500
 clear_globals;
 
501
 c:= level5rec.c;
 
502
 if c <> RESULT_U8BIT then
 
503
   failed := true;
 
504
 s:= level5rec.s;
 
505
 if s <> RESULT_U16BIT then
 
506
   failed := true;
 
507
 j:= level5rec.j;
 
508
 if j <> RESULT_S32BIT then
 
509
   failed := true;
 
510
 
 
511
 if failed then
 
512
   fail
 
513
 else
 
514
   WriteLN('Passed!');
 
515
 
 
516
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
 
517
 Write('Non-Aligned simple global record access (secondvecn())...');
 
518
 
 
519
 clear_globals;
 
520
 c:= level1rec_packed.c;
 
521
 if c <> RESULT_U8BIT then
 
522
   failed := true;
 
523
 
 
524
 clear_globals;
 
525
 c:= level2rec_packed.c;
 
526
 if c <> RESULT_U8BIT then
 
527
   failed := true;
 
528
 d:= level2rec_packed.d;
 
529
 if d <> RESULT_U8BIT then
 
530
   failed := true;
 
531
 s:= level2rec_packed.s;
 
532
 if s <> RESULT_U16BIT then
 
533
   failed := true;
 
534
 n:= level2rec_packed.n;
 
535
 if n <> RESULT_S32BIT then
 
536
   failed := true;
 
537
 
 
538
 
 
539
 clear_globals;
 
540
 c:= level3rec_packed.c;
 
541
 if c <> RESULT_U8BIT then
 
542
   failed := true;
 
543
 s:= level3rec_packed.s;
 
544
 if s <> RESULT_U16BIT then
 
545
   failed := true;
 
546
 
 
547
 
 
548
 clear_globals;
 
549
 c:= level4rec_packed.c;
 
550
 if c <> RESULT_U8BIT then
 
551
   failed := true;
 
552
 i:= level4rec_packed.i;
 
553
 if i <> RESULT_S64BIT then
 
554
   failed := true;
 
555
 s:= level4rec_packed.s;
 
556
 if s <> RESULT_U16BIT then
 
557
   failed := true;
 
558
 
 
559
 clear_globals;
 
560
 c:= level5rec_packed.c;
 
561
 if c <> RESULT_U8BIT then
 
562
   failed := true;
 
563
 s:= level5rec_packed.s;
 
564
 if s <> RESULT_U16BIT then
 
565
   failed := true;
 
566
 j:= level5rec_packed.j;
 
567
 if j <> RESULT_S32BIT then
 
568
   failed := true;
 
569
 
 
570
 if failed then
 
571
   fail
 
572
 else
 
573
   WriteLN('Passed!');
 
574
 
 
575
 Write('Non-Aligned big global record access (secondvecn())...');
 
576
 
 
577
 clear_globals;
 
578
 level1rec_big.c := RESULT_U8BIT;
 
579
 c:= level1rec_big.c;
 
580
 if c <> RESULT_U8BIT then
 
581
   failed := true;
 
582
 
 
583
 clear_globals;
 
584
 { setup values - assign }
 
585
 level2rec_big.c := RESULT_U8BIT;
 
586
 level2rec_big.d := RESULT_U8BIT;
 
587
 level2rec_big.s := RESULT_U16BIT;
 
588
 level2rec_big.n := RESULT_S32BIT;
 
589
 { load values - load }
 
590
 c:= level2rec_big.c;
 
591
 if c <> RESULT_U8BIT then
 
592
   failed := true;
 
593
 d:= level2rec_big.d;
 
594
 if d <> RESULT_U8BIT then
 
595
   failed := true;
 
596
 s:= level2rec_big.s;
 
597
 if s <> RESULT_U16BIT then
 
598
   failed := true;
 
599
 n:= level2rec_big.n;
 
600
 if n <> RESULT_S32BIT then
 
601
   failed := true;
 
602
 
 
603
 
 
604
 clear_globals;
 
605
 { setup values - assign }
 
606
 level3rec_big.c := RESULT_U8BIT;
 
607
 level3rec_big.s := RESULT_U16BIT;
 
608
 c:= level3rec_big.c;
 
609
 if c <> RESULT_U8BIT then
 
610
   failed := true;
 
611
 s:= level3rec_big.s;
 
612
 if s <> RESULT_U16BIT then
 
613
   failed := true;
 
614
 
 
615
 clear_globals;
 
616
 { setup values - assign }
 
617
 level4rec_big.c := RESULT_U8BIT;
 
618
 level4rec_big.i := RESULT_S64BIT;
 
619
 level4rec_big.s := RESULT_U16BIT;
 
620
 
 
621
 c:= level4rec_big.c;
 
622
 if c <> RESULT_U8BIT then
 
623
   failed := true;
 
624
 i:= level4rec_big.i;
 
625
 if i <> RESULT_S64BIT then
 
626
   failed := true;
 
627
 s:= level4rec_big.s;
 
628
 if s <> RESULT_U16BIT then
 
629
   failed := true;
 
630
 
 
631
 clear_globals;
 
632
 { setup values - assign }
 
633
 level5rec_big.c := RESULT_U8BIT;
 
634
 level5rec_big.s := RESULT_U16BIT;
 
635
 level5rec_big.j := RESULT_S32BIT;
 
636
 
 
637
 c:= level5rec_big.c;
 
638
 if c <> RESULT_U8BIT then
 
639
   failed := true;
 
640
 s:= level5rec_big.s;
 
641
 if s <> RESULT_U16BIT then
 
642
   failed := true;
 
643
 j:= level5rec_big.j;
 
644
 if j <> RESULT_S32BIT then
 
645
   failed := true;
 
646
 
 
647
 if failed then
 
648
   fail
 
649
 else
 
650
   WriteLN('Passed!');
 
651
 
 
652
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
 
653
 
 
654
 testlocals;
 
655
 
 
656
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
 
657
{$ifndef cpu68k}
 
658
 Write('Non-Aligned big local record access (secondvecn())...');
 
659
 failed := false;
 
660
 
 
661
 testlocal_big_1;
 
662
 testlocal_big_2;
 
663
 testlocal_big_3;
 
664
 testlocal_big_4;
 
665
 testlocal_big_5;
 
666
 if failed then
 
667
   fail
 
668
 else
 
669
   WriteLN('Passed!');
 
670
{$endif}
 
671
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
 
672
 
 
673
 Write('Aligned class big field access (secondvecn())...');
 
674
 clear_globals;
 
675
 failed := false;
 
676
 
 
677
 
 
678
 { LOC_REFERENCE }
 
679
 class1:=tclass1.create;
 
680
 class1.c:= RESULT_U8BIT;
 
681
 class1.j:= RESULT_S32BIT;
 
682
 class1.s:= RESULT_U16BIT;
 
683
 c:=class1.c;
 
684
 if c <> RESULT_U8BIT then
 
685
   failed := true;
 
686
 j:=class1.j;
 
687
 if j <> RESULT_S32BIT then
 
688
   failed := true;
 
689
 s:=class1.s;
 
690
 if s <> RESULT_U16BIT then
 
691
   failed := true;
 
692
 
 
693
 class1.destroy;
 
694
 clear_globals;
 
695
 
 
696
 { LOC_REGISTER }
 
697
 class1:=tclass1.create;
 
698
 class1.c:= RESULT_U8BIT;
 
699
 class1.j:= RESULT_S32BIT;
 
700
 class1.s:= RESULT_U16BIT;
 
701
 c:=(getclass).c;
 
702
 if c <> RESULT_U8BIT then
 
703
   failed := true;
 
704
 j:=(getclass).j;
 
705
 if j <> RESULT_S32BIT then
 
706
   failed := true;
 
707
 s:=(getclass).s;
 
708
 if s <> RESULT_U16BIT then
 
709
   failed := true;
 
710
 
 
711
 class1.destroy;
 
712
 
 
713
 
 
714
 if failed then
 
715
   fail
 
716
 else
 
717
   WriteLN('Passed!');
 
718
 {----------------------------------------------------------------------------}
 
719
 Write('Aligned class simple field access (secondvecn())...');
 
720
 clear_globals;
 
721
 failed := false;
 
722
 
 
723
 
 
724
 { LOC_REFERENCE }
 
725
 class2:=tclass2.create;
 
726
 class2.c:= RESULT_U8BIT;
 
727
 class2.i:= RESULT_S64BIT;
 
728
 class2.s:= RESULT_U16BIT;
 
729
 c:=class2.c;
 
730
 if c <> RESULT_U8BIT then
 
731
   failed := true;
 
732
 i:=class2.i;
 
733
 if i <> RESULT_S64BIT then
 
734
   failed := true;
 
735
 s:=class2.s;
 
736
 if s <> RESULT_U16BIT then
 
737
   failed := true;
 
738
 
 
739
 class2.destroy;
 
740
 clear_globals;
 
741
 
 
742
 { LOC_REGISTER }
 
743
 class2:=tclass2.create;
 
744
 class2.c:= RESULT_U8BIT;
 
745
 class2.i:= RESULT_S64BIT;
 
746
 class2.s:= RESULT_U16BIT;
 
747
 c:=(getclass2).c;
 
748
 if c <> RESULT_U8BIT then
 
749
   failed := true;
 
750
 i:=(getclass2).i;
 
751
 if i <> RESULT_S64BIT then
 
752
   failed := true;
 
753
 s:=(getclass2).s;
 
754
 if s <> RESULT_U16BIT then
 
755
   failed := true;
 
756
 
 
757
 class2.destroy;
 
758
 
 
759
 
 
760
 if failed then
 
761
   fail
 
762
 else
 
763
   WriteLN('Passed!');
 
764
 
 
765
 
 
766
end.