← Back to branch summary

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

« back to all changes in this revision

Viewing changes to fpcsrc/tests/test/cg/tcalval3.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/tcalval3.pp
 
1
{****************************************************************}
 
2
{  CODE GENERATOR TEST PROGRAM                                   }
 
3
{  By Carl Eric Codere                                           }
 
4
{****************************************************************}
 
5
{ NODE TESTED : secondcallparan()                                }
 
6
{****************************************************************}
 
7
{ PRE-REQUISITES: secondload()                                   }
 
8
{                 secondassign()                                 }
 
9
{                 secondtypeconv()                               }
 
10
{                 secondtryexcept()                              }
 
11
{                 secondcalln()                                  }
 
12
{                 secondadd()                                    }
 
13
{****************************************************************}
 
14
{ DEFINES:                                                       }
 
15
{            FPC     = Target is FreePascal compiler             }
 
16
{****************************************************************}
 
17
{ REMARKS: This tests a subset of the secondcalln() node         }
 
18
{          (value parameters with pascal calling convention)     }
 
19
{****************************************************************}
 
20
program tcalval3;
 
21
 
 
22
{$ifdef fpc}
 
23
{$mode objfpc}
 
24
{$INLINE ON}
 
25
{$endif}
 
26
{$R+}
 
27
{$P-}
 
28
 
 
29
{$ifdef VER70}
 
30
  {$define tp}
 
31
{$endif}
 
32
 
 
33
 
 
34
 { REAL should map to single or double }
 
35
 { so it is not checked, since single  }
 
36
 { double nodes are checked.           }
 
37
 
 
38
 { assumes that enumdef is the same as orddef (same storage format) }
 
39
 
 
40
 const
 
41
{ should be defined depending on CPU target }
 
42
{$ifdef fpc}
 
43
  {$ifdef cpu68k}
 
44
    BIG_INDEX = 8000;
 
45
    SMALL_INDEX  = 13;
 
46
  {$else}
 
47
    BIG_INDEX = 33000;
 
48
    SMALL_INDEX = 13;     { value should not be aligned! }
 
49
  {$endif}
 
50
{$else}
 
51
  BIG_INDEX = 33000;
 
52
  SMALL_INDEX = 13;     { value should not be aligned! }
 
53
{$endif}
 
54
  RESULT_U8BIT = $55;
 
55
  RESULT_U16BIT = $500F;
 
56
  RESULT_S32BIT = $500F0000;
 
57
  RESULT_S64BIT = $500F0000;
 
58
  RESULT_S32REAL = 1777.12;
 
59
  RESULT_S64REAL = 3444.24;
 
60
  RESULT_BOOL8BIT = 1;
 
61
  RESULT_BOOL16BIT = 1;
 
62
  RESULT_BOOL32BIT = 1;
 
63
  RESULT_PCHAR = 'Hello world';
 
64
  RESULT_BIGSTRING = 'Hello world';
 
65
  RESULT_SMALLSTRING = 'H';
 
66
  RESULT_CHAR = 'I';
 
67
  RESULT_BOOLEAN = TRUE;
 
68
 
 
69
type
 
70
{$ifndef tp}
 
71
  tclass1 = class
 
72
  end;
 
73
{$else}
 
74
  shortstring = string;
 
75
{$endif}
 
76
 
 
77
  tprocedure = procedure;
 
78
 
 
79
  tsmallrecord =
 
80
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
 
81
  packed
 
82
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
 
83
  record
 
84
    b: byte;
 
85
    w: word;
 
86
  end;
 
87
 
 
88
  tlargerecord = packed record
 
89
    b: array[1..BIG_INDEX] of byte;
 
90
  end;
 
91
 
 
92
  tsmallarray = packed array[1..SMALL_INDEX] of byte;
 
93
 
 
94
  tsmallsetenum =
 
95
  (A_A,A_B,A_C,A_D);
 
96
 
 
97
  tsmallset = set of tsmallsetenum;
 
98
  tlargeset = set of char;
 
99
 
 
100
  tsmallstring = string[2];
 
101
 
 
102
 
 
103
 
 
104
 
 
105
 
 
106
var
 
107
 global_u8bit : byte;
 
108
 global_u16bit : word;
 
109
 global_s32bit : longint;
 
110
 global_s32real : single;
 
111
 global_s64real : double;
 
112
 global_ptr : pchar;
 
113
 global_proc : tprocedure;
 
114
 global_bigstring : shortstring;
 
115
 global_boolean : boolean;
 
116
 global_char : char;
 
117
{$ifndef tp}
 
118
 global_class : tclass1;
 
119
 global_s64bit : int64;
 
120
 value_s64bit : int64;
 
121
 value_class : tclass1;
 
122
{$endif}
 
123
 value_u8bit : byte;
 
124
 value_u16bit : word;
 
125
 value_s32bit : longint;
 
126
 value_s32real : single;
 
127
 value_s64real  : double;
 
128
 value_proc : tprocedure;
 
129
 value_ptr : pchar;
 
130
 value_smallrec : tsmallrecord;
 
131
 value_largerec : tlargerecord;
 
132
 value_smallset : tsmallset;
 
133
 value_smallstring : tsmallstring;
 
134
 value_bigstring   : shortstring;
 
135
 value_largeset : tlargeset;
 
136
 value_smallarray : tsmallarray;
 
137
 value_boolean : boolean;
 
138
 value_char : char;
 
139
 
 
140
    procedure fail;
 
141
    begin
 
142
      WriteLn('Failure.');
 
143
      halt(1);
 
144
    end;
 
145
 
 
146
 
 
147
    procedure clear_globals;
 
148
     begin
 
149
      global_u8bit := 0;
 
150
      global_u16bit := 0;
 
151
      global_s32bit := 0;
 
152
      global_s32real := 0.0;
 
153
      global_s64real := 0.0;
 
154
      global_ptr := nil;
 
155
      global_proc := nil;
 
156
      global_bigstring := '';
 
157
      global_boolean := false;
 
158
      global_char := #0;
 
159
{$ifndef tp}
 
160
      global_s64bit := 0;
 
161
      global_class := nil;
 
162
{$endif}
 
163
     end;
 
164
 
 
165
 
 
166
    procedure clear_values;
 
167
     begin
 
168
      value_u8bit := 0;
 
169
      value_u16bit := 0;
 
170
      value_s32bit := 0;
 
171
      value_s32real := 0.0;
 
172
      value_s64real  := 0.0;
 
173
      value_proc := nil;
 
174
      value_ptr := nil;
 
175
      fillchar(value_smallrec, sizeof(value_smallrec), #0);
 
176
      fillchar(value_largerec, sizeof(value_largerec), #0);
 
177
      value_smallset := [];
 
178
      value_smallstring := '';
 
179
      value_bigstring   := '';
 
180
      value_largeset := [];
 
181
      fillchar(value_smallarray, sizeof(value_smallarray), #0);
 
182
      value_boolean := false;
 
183
      value_char:=#0;
 
184
{$ifndef tp}
 
185
      value_s64bit := 0;
 
186
      value_class := nil;
 
187
{$endif}
 
188
     end;
 
189
 
 
190
 
 
191
  procedure testprocedure;
 
192
   begin
 
193
   end;
 
194
 
 
195
   function getu8bit : byte;
 
196
    begin
 
197
      getu8bit:=RESULT_U8BIT;
 
198
    end;
 
199
 
 
200
   function getu16bit: word;
 
201
     begin
 
202
       getu16bit:=RESULT_U16BIT;
 
203
     end;
 
204
 
 
205
   function gets32bit: longint;
 
206
    begin
 
207
      gets32bit:=RESULT_S32BIT;
 
208
    end;
 
209
 
 
210
   function gets64bit: int64;
 
211
    begin
 
212
      gets64bit:=RESULT_S64BIT;
 
213
    end;
 
214
 
 
215
 
 
216
   function gets32real: single;
 
217
    begin
 
218
      gets32real:=RESULT_S32REAL;
 
219
    end;
 
220
 
 
221
   function gets64real: double;
 
222
    begin
 
223
      gets64real:=RESULT_S64REAL;
 
224
    end;
 
225
 
 
226
{ ***************************************************************** }
 
227
{                        VALUE PARAMETERS                           }
 
228
{ ***************************************************************** }
 
229
 
 
230
  procedure proc_value_u8bit(v: byte);pascal;
 
231
   begin
 
232
     global_u8bit := v;
 
233
   end;
 
234
 
 
235
 
 
236
  procedure proc_value_u16bit(v: word);pascal;
 
237
   begin
 
238
     global_u16bit := v;
 
239
   end;
 
240
 
 
241
 
 
242
  procedure proc_value_s32bit(v : longint);pascal;
 
243
   begin
 
244
     global_s32bit := v;
 
245
   end;
 
246
 
 
247
 
 
248
 
 
249
 
 
250
  procedure proc_value_bool8bit(v: boolean);pascal;
 
251
   begin
 
252
     { boolean should be 8-bit always! }
 
253
     if sizeof(boolean) <> 1 then RunError(255);
 
254
     global_u8bit := byte(v);
 
255
   end;
 
256
 
 
257
 
 
258
  procedure proc_value_bool16bit(v: wordbool);pascal;
 
259
   begin
 
260
     global_u16bit := word(v);
 
261
   end;
 
262
 
 
263
 
 
264
  procedure proc_value_bool32bit(v : longbool);pascal;
 
265
   begin
 
266
     global_s32bit := longint(v);
 
267
   end;
 
268
 
 
269
 
 
270
  procedure proc_value_s32real(v : single);pascal;
 
271
   begin
 
272
     global_s32real := v;
 
273
   end;
 
274
 
 
275
  procedure proc_value_s64real(v: double);pascal;
 
276
   begin
 
277
     global_s64real:= v;
 
278
   end;
 
279
 
 
280
 
 
281
  procedure proc_value_pointerdef(p : pchar);pascal;
 
282
   begin
 
283
     global_ptr:=p;
 
284
   end;
 
285
 
 
286
 
 
287
  procedure proc_value_procvardef(p : tprocedure);pascal;
 
288
   begin
 
289
     global_proc:=p;
 
290
   end;
 
291
 
 
292
 
 
293
 
 
294
 
 
295
  procedure proc_value_smallrecord(smallrec : tsmallrecord);pascal;
 
296
   begin
 
297
     if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then
 
298
       global_u8bit := RESULT_U8BIT;
 
299
   end;
 
300
 
 
301
 
 
302
  procedure proc_value_largerecord(largerec : tlargerecord);pascal;
 
303
   begin
 
304
     if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then
 
305
       global_u8bit := RESULT_U8BIT;
 
306
   end;
 
307
 
 
308
  procedure proc_value_smallset(smallset : tsmallset);pascal;
 
309
   begin
 
310
     if A_D in smallset then
 
311
       global_u8bit := RESULT_U8BIT;
 
312
   end;
 
313
 
 
314
 
 
315
  procedure proc_value_largeset(largeset : tlargeset);pascal;
 
316
   begin
 
317
     if 'I' in largeset then
 
318
       global_u8bit := RESULT_U8BIT;
 
319
   end;
 
320
 
 
321
  procedure proc_value_smallstring(s:tsmallstring);pascal;
 
322
   begin
 
323
     if s = RESULT_SMALLSTRING then
 
324
       global_u8bit := RESULT_u8BIT;
 
325
   end;
 
326
 
 
327
 
 
328
  procedure proc_value_bigstring(s:shortstring);pascal;
 
329
   begin
 
330
     if s = RESULT_BIGSTRING then
 
331
       global_u8bit := RESULT_u8BIT;
 
332
   end;
 
333
 
 
334
 
 
335
  procedure proc_value_smallarray(arr : tsmallarray);pascal;
 
336
  begin
 
337
    if arr[SMALL_INDEX] = RESULT_U8BIT then
 
338
      global_u8bit := RESULT_U8BIT;
 
339
  end;
 
340
 
 
341
  procedure proc_value_smallarray_open(arr : array of byte);pascal;
 
342
  begin
 
343
    { form 0 to N-1 indexes in open arrays }
 
344
    if arr[SMALL_INDEX-1] = RESULT_U8BIT then
 
345
      global_u8bit := RESULT_U8BIT;
 
346
  end;
 
347
 
 
348
{$ifndef tp}
 
349
  procedure proc_value_classrefdef(obj : tclass1);pascal;
 
350
   begin
 
351
     global_class:=obj;
 
352
   end;
 
353
 
 
354
 
 
355
  procedure proc_value_smallarray_const_1(arr : array of const);pascal;
 
356
  var
 
357
   i: integer;
 
358
  begin
 
359
    for i:=0 to high(arr) do
 
360
     begin
 
361
       case arr[i].vtype of
 
362
        vtInteger : global_u8bit := arr[i].vinteger and $ff;
 
363
        vtBoolean : global_boolean := arr[i].vboolean;
 
364
        vtChar : global_char := arr[i].vchar;
 
365
        vtExtended : global_s64real := arr[i].VExtended^;
 
366
        vtString :  global_bigstring := arr[i].VString^;
 
367
        vtPointer : ;
 
368
        vtPChar : global_ptr := arr[i].VPchar;
 
369
        vtObject : ;
 
370
{        vtClass : global_class := (arr[i].VClass) as tclass1;}
 
371
        vtAnsiString : ;
 
372
        vtInt64 :  global_s64bit := arr[i].vInt64^;
 
373
        else
 
374
          RunError(255);
 
375
       end;
 
376
     end; {endfor}
 
377
  end;
 
378
 
 
379
 
 
380
  procedure proc_value_smallarray_const_2(arr : array of const);pascal;
 
381
  var
 
382
   i: integer;
 
383
  begin
 
384
     if high(arr)<0 then
 
385
       global_u8bit := RESULT_U8BIT;
 
386
  end;
 
387
 
 
388
  procedure proc_value_s64bit(v: int64);pascal;
 
389
   begin
 
390
     global_s64bit:= v;
 
391
   end;
 
392
{$endif}
 
393
 
 
394
 {********************************* MIXED PARAMETERS *************************}
 
395
 
 
396
  procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);pascal;
 
397
   begin
 
398
     global_u8bit := v;
 
399
     value_u8bit := b2;
 
400
   end;
 
401
 
 
402
 
 
403
  procedure proc_value_u16bit_mixed(b1: byte; v: word; b2: byte);pascal;
 
404
   begin
 
405
     global_u16bit := v;
 
406
     value_u8bit := b2;
 
407
   end;
 
408
 
 
409
 
 
410
  procedure proc_value_s32bit_mixed(b1 : byte; v : longint; b2: byte);pascal;
 
411
   begin
 
412
     global_s32bit := v;
 
413
     value_u8bit := b2;
 
414
   end;
 
415
 
 
416
 
 
417
 
 
418
 
 
419
  procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);pascal;
 
420
   begin
 
421
     { boolean should be 8-bit always! }
 
422
     if sizeof(boolean) <> 1 then RunError(255);
 
423
     global_u8bit := byte(v);
 
424
     value_u8bit := b2;
 
425
   end;
 
426
 
 
427
 
 
428
  procedure proc_value_bool16bit_mixed(b1 : byte; v: wordbool; b2: byte);pascal;
 
429
   begin
 
430
     global_u16bit := word(v);
 
431
     value_u8bit := b2;
 
432
   end;
 
433
 
 
434
 
 
435
  procedure proc_value_bool32bit_mixed(b1 : byte; v : longbool; b2: byte);pascal;
 
436
   begin
 
437
     global_s32bit := longint(v);
 
438
     value_u8bit := b2;
 
439
   end;
 
440
 
 
441
 
 
442
  procedure proc_value_s32real_mixed(b1: byte; v : single; b2: byte);pascal;
 
443
   begin
 
444
     global_s32real := v;
 
445
     value_u8bit := b2;
 
446
   end;
 
447
 
 
448
  procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);pascal;
 
449
   begin
 
450
     global_s64real:= v;
 
451
     value_u8bit := b2;
 
452
   end;
 
453
 
 
454
 
 
455
  procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);pascal;
 
456
   begin
 
457
     global_ptr:=p;
 
458
     value_u8bit := b2;
 
459
   end;
 
460
 
 
461
 
 
462
  procedure proc_value_procvardef_mixed(b1: byte; p : tprocedure; b2: byte);pascal;
 
463
   begin
 
464
     global_proc:=p;
 
465
     value_u8bit := b2;
 
466
   end;
 
467
 
 
468
 
 
469
 
 
470
 
 
471
  procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);pascal;
 
472
   begin
 
473
     if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then
 
474
       global_u8bit := RESULT_U8BIT;
 
475
     value_u8bit := b2;
 
476
   end;
 
477
 
 
478
 
 
479
  procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);pascal;
 
480
   begin
 
481
     if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then
 
482
       global_u8bit := RESULT_U8BIT;
 
483
     value_u8bit := b2;
 
484
   end;
 
485
 
 
486
  procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);pascal;
 
487
   begin
 
488
     if A_D in smallset then
 
489
       global_u8bit := RESULT_U8BIT;
 
490
     value_u8bit := b2;
 
491
   end;
 
492
 
 
493
 
 
494
  procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);pascal;
 
495
   begin
 
496
     if 'I' in largeset then
 
497
       global_u8bit := RESULT_U8BIT;
 
498
     value_u8bit := b2;
 
499
   end;
 
500
 
 
501
  procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);pascal;
 
502
   begin
 
503
     if s = RESULT_SMALLSTRING then
 
504
       global_u8bit := RESULT_u8BIT;
 
505
     value_u8bit := b2;
 
506
   end;
 
507
 
 
508
 
 
509
  procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);pascal;
 
510
   begin
 
511
     if s = RESULT_BIGSTRING then
 
512
       global_u8bit := RESULT_u8BIT;
 
513
     value_u8bit := b2;
 
514
   end;
 
515
 
 
516
 
 
517
  procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);pascal;
 
518
  begin
 
519
    if arr[SMALL_INDEX] = RESULT_U8BIT then
 
520
      global_u8bit := RESULT_U8BIT;
 
521
     value_u8bit := b2;
 
522
  end;
 
523
 
 
524
  procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);pascal;
 
525
  begin
 
526
    { form 0 to N-1 indexes in open arrays }
 
527
    if arr[SMALL_INDEX-1] = RESULT_U8BIT then
 
528
      global_u8bit := RESULT_U8BIT;
 
529
     value_u8bit := b2;
 
530
  end;
 
531
 
 
532
{$ifndef tp}
 
533
  procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);pascal;
 
534
   begin
 
535
     global_class:=obj;
 
536
     value_u8bit := b2;
 
537
   end;
 
538
 
 
539
 
 
540
  procedure proc_value_s64bit_mixed(b1 : byte; v: int64; b2: byte);pascal;
 
541
   begin
 
542
     global_s64bit:= v;
 
543
     value_u8bit := b2;
 
544
   end;
 
545
 
 
546
 
 
547
  procedure proc_value_smallarray_const_1_mixed(b1: byte; arr : array of const; b2: byte);pascal;
 
548
  var
 
549
   i: integer;
 
550
  begin
 
551
    for i:=0 to high(arr) do
 
552
     begin
 
553
       case arr[i].vtype of
 
554
        vtInteger : global_u8bit := arr[i].vinteger and $ff;
 
555
        vtBoolean : global_boolean := arr[i].vboolean;
 
556
        vtChar : global_char := arr[i].vchar;
 
557
        vtExtended : global_s64real := arr[i].VExtended^;
 
558
        vtString :  global_bigstring := arr[i].VString^;
 
559
        vtPointer : ;
 
560
        vtPChar : global_ptr := arr[i].VPchar;
 
561
        vtObject : ;
 
562
{        vtClass : global_class := (arr[i].VClass) as tclass1;}
 
563
        vtAnsiString : ;
 
564
        vtInt64 :  global_s64bit := arr[i].vInt64^;
 
565
        else
 
566
          RunError(255);
 
567
       end;
 
568
     end; {endfor}
 
569
     value_u8bit := b2;
 
570
  end;
 
571
 
 
572
 
 
573
  procedure proc_value_smallarray_const_2_mixed(b1: byte; arr : array of const; b2: byte);pascal;
 
574
  var
 
575
   i: integer;
 
576
  begin
 
577
     if high(arr)<0 then
 
578
       global_u8bit := RESULT_U8BIT;
 
579
     value_u8bit := b2;
 
580
  end;
 
581
{$endif}
 
582
 
 
583
 
 
584
 
 
585
var
 
586
 failed: boolean;
 
587
Begin
 
588
  {***************************** NORMAL TESTS *******************************}
 
589
  clear_globals;
 
590
  clear_values;
 
591
 
 
592
  failed:=false;
 
593
 
 
594
  { LOC_REGISTER }
 
595
  write('Value parameter test (src : LOC_REGISTER)...');
 
596
  proc_value_u8bit(getu8bit);
 
597
  if global_u8bit <> RESULT_U8BIT then
 
598
    failed:=true;
 
599
  proc_value_u16bit(getu16bit);
 
600
  if global_u16bit <> RESULT_U16BIT then
 
601
    failed:=true;
 
602
  proc_value_s32bit(gets32bit);
 
603
  if global_s32bit <> RESULT_S32BIT then
 
604
    failed:=true;
 
605
{$ifndef tp}
 
606
  proc_value_s64bit(gets64bit);
 
607
  if global_s64bit <> RESULT_S64BIT then
 
608
    failed:=true;
 
609
{$endif}
 
610
  if failed then
 
611
    fail
 
612
  else
 
613
    WriteLn('Passed!');
 
614
 
 
615
 
 
616
  { LOC_FPUREGISTER }
 
617
  clear_globals;
 
618
  clear_values;
 
619
  failed:=false;
 
620
  write('Value parameter test (src : LOC_FPUREGISTER)...');
 
621
  proc_value_s32real(gets32real);
 
622
  if trunc(global_s32real) <> trunc(RESULT_S32REAL) then
 
623
    failed:=true;
 
624
  proc_value_s64real(gets64real);
 
625
  if trunc(global_s64real) <> trunc(RESULT_S64REAL) then
 
626
    failed:=true;
 
627
  if failed then
 
628
    fail
 
629
  else
 
630
    WriteLn('Passed!');
 
631
 
 
632
 
 
633
  { LOC_MEM, LOC_REFERENCE orddef }
 
634
  clear_globals;
 
635
  clear_values;
 
636
  value_u8bit := RESULT_U8BIT;
 
637
  value_u16bit := RESULT_U16BIT;
 
638
  value_s32bit := RESULT_S32BIT;
 
639
{$ifndef tp}
 
640
  value_s64bit := RESULT_S64BIT;
 
641
{$endif}
 
642
  value_s32real := RESULT_S32REAL;
 
643
  value_s64real  := RESULT_S64REAL;
 
644
 
 
645
  failed:=false;
 
646
 
 
647
  { LOC_REFERENCE }
 
648
  write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...');
 
649
  proc_value_u8bit(value_u8bit);
 
650
  if global_u8bit <> RESULT_U8BIT then
 
651
    failed:=true;
 
652
  proc_value_u16bit(value_u16bit);
 
653
  if global_u16bit <> RESULT_U16BIT then
 
654
    failed:=true;
 
655
  proc_value_s32bit(value_s32bit);
 
656
  if global_s32bit <> RESULT_S32BIT then
 
657
    failed:=true;
 
658
{$ifndef tp}
 
659
  proc_value_s64bit(value_s64bit);
 
660
  if global_s64bit <> RESULT_S64BIT then
 
661
    failed:=true;
 
662
{$endif}
 
663
  if failed then
 
664
    fail
 
665
  else
 
666
    WriteLn('Passed!');
 
667
 
 
668
 
 
669
  { LOC_REFERENCE }
 
670
  clear_globals;
 
671
  failed:=false;
 
672
  write('Value parameter test (src : LOC_REFERENCE (floatdef))...');
 
673
  proc_value_s32real(value_s32real);
 
674
  if trunc(global_s32real) <> trunc(RESULT_S32REAL) then
 
675
    failed:=true;
 
676
  proc_value_s64real(value_s64real);
 
677
  if trunc(global_s64real) <> trunc(RESULT_S64REAL) then
 
678
    failed:=true;
 
679
  if failed then
 
680
    fail
 
681
  else
 
682
    WriteLn('Passed!');
 
683
 
 
684
 
 
685
 
 
686
  write('Value parameter test (src : LOC_REFERENCE (pointer))...');
 
687
  clear_globals;
 
688
  clear_values;
 
689
  failed:=false;
 
690
  value_ptr := RESULT_PCHAR;
 
691
  proc_value_pointerdef(value_ptr);
 
692
  if global_ptr <> value_ptr then
 
693
    failed := true;
 
694
 
 
695
 
 
696
  value_proc := {$ifndef tp}@{$endif}testprocedure;
 
697
  proc_value_procvardef(value_proc);
 
698
  if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then
 
699
    failed := true;
 
700
 
 
701
{$ifndef tp}
 
702
  value_class := tclass1.create;
 
703
  proc_value_classrefdef(value_class);
 
704
  if value_class <> global_class then
 
705
    failed := true;
 
706
  value_class.destroy;
 
707
{$endif}
 
708
  if failed then
 
709
    fail
 
710
  else
 
711
    WriteLn('Passed!');
 
712
 
 
713
 
 
714
 
 
715
 
 
716
  { LOC_REFERENCE }
 
717
  clear_globals;
 
718
  clear_values;
 
719
  failed:=false;
 
720
  value_u8bit := 0;
 
721
  write('Value parameter test (src : LOC_FLAGS (orddef)))...');
 
722
  proc_value_bool8bit(value_u8bit = 0);
 
723
  if global_u8bit <> RESULT_BOOL8BIT then
 
724
    failed:=true;
 
725
{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x
 
726
  proc_value_bool16bit(value_s64bit < 0);
 
727
  if global_u16bit <> RESULT_BOOL16BIT then
 
728
    failed:=true;
 
729
  proc_value_bool32bit(bool1 and bool2);
 
730
  if global_s32bit <> RESULT_BOOL32BIT then
 
731
    failed:=true;*}
 
732
  if failed then
 
733
    fail
 
734
  else
 
735
    WriteLn('Passed!');
 
736
 
 
737
 
 
738
 
 
739
{$ifndef tp}
 
740
  clear_globals;
 
741
  clear_values;
 
742
  failed:=false;
 
743
  write('Value parameter test (src : LOC_JUMP (orddef)))...');
 
744
  proc_value_bool8bit(value_s64bit = 0);
 
745
  if global_u8bit <> RESULT_BOOL8BIT then
 
746
    failed:=true;
 
747
{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x
 
748
  proc_value_bool16bit(value_s64bit < 0);
 
749
  if global_u16bit <> RESULT_BOOL16BIT then
 
750
    failed:=true;
 
751
  proc_value_bool32bit(bool1 and bool2);
 
752
  if global_s32bit <> RESULT_BOOL32BIT then
 
753
    failed:=true;*}
 
754
  if failed then
 
755
    fail
 
756
  else
 
757
    WriteLn('Passed!');
 
758
{$endif}
 
759
 
 
760
  { arraydef,
 
761
    recorddef,
 
762
    objectdef,
 
763
    stringdef,
 
764
    setdef : all considered the same by code generator.
 
765
  }
 
766
  write('Value parameter test (src : LOC_REFERENCE (recorddef)))...');
 
767
  clear_globals;
 
768
  clear_values;
 
769
  failed := false;
 
770
 
 
771
  value_smallrec.b := RESULT_U8BIT;
 
772
  value_smallrec.w := RESULT_U16BIT;
 
773
  proc_value_smallrecord(value_smallrec);
 
774
  if global_u8bit <> RESULT_U8BIT then
 
775
    failed := true;
 
776
 
 
777
  clear_globals;
 
778
  clear_values;
 
779
  fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT);
 
780
  proc_value_largerecord(value_largerec);
 
781
  if global_u8bit <> RESULT_U8BIT then
 
782
    failed := true;
 
783
 
 
784
  if failed then
 
785
    fail
 
786
  else
 
787
    WriteLn('Passed!');
 
788
 
 
789
 
 
790
 
 
791
  write('Value parameter test (src : LOC_REFERENCE (setdef)))...');
 
792
  clear_globals;
 
793
  clear_values;
 
794
  failed := false;
 
795
 
 
796
  value_smallset := [A_A,A_D];
 
797
  proc_value_smallset(value_smallset);
 
798
  if global_u8bit <> RESULT_U8BIT then
 
799
    failed := true;
 
800
 
 
801
  clear_globals;
 
802
  clear_values;
 
803
  value_largeset := ['I'];
 
804
  proc_value_largeset(value_largeset);
 
805
  if global_u8bit <> RESULT_U8BIT then
 
806
    failed := true;
 
807
 
 
808
  if failed then
 
809
    fail
 
810
  else
 
811
    WriteLn('Passed!');
 
812
 
 
813
 
 
814
 
 
815
 
 
816
 
 
817
  write('Value parameter test (src : LOC_REFERENCE (stringdef)))...');
 
818
  clear_globals;
 
819
  clear_values;
 
820
  failed := false;
 
821
  value_smallstring := RESULT_SMALLSTRING;
 
822
 
 
823
  proc_value_smallstring(value_smallstring);
 
824
  if global_u8bit <> RESULT_U8BIT then
 
825
    failed := true;
 
826
 
 
827
  clear_globals;
 
828
  clear_values;
 
829
  value_bigstring := RESULT_BIGSTRING;
 
830
  proc_value_bigstring(value_bigstring);
 
831
  if global_u8bit <> RESULT_U8BIT then
 
832
    failed := true;
 
833
 
 
834
  if failed then
 
835
    fail
 
836
  else
 
837
    WriteLn('Passed!');
 
838
 
 
839
 
 
840
 
 
841
  { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!}
 
842
  { DON'T KNOW WHY/HOW TO TEST!!!!!                                   }
 
843
 
 
844
 
 
845
  write('Value parameter test (src : LOC_REFERENCE (arraydef)))...');
 
846
 
 
847
  clear_globals;
 
848
  clear_values;
 
849
  failed:=false;
 
850
 
 
851
  fillchar(value_smallarray,sizeof(value_smallarray),#0);
 
852
  value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
 
853
  proc_value_smallarray(value_smallarray);
 
854
  if global_u8bit <> RESULT_U8BIT then
 
855
    failed := true;
 
856
 
 
857
  clear_globals;
 
858
  clear_values;
 
859
 
 
860
  fillchar(value_smallarray,sizeof(value_smallarray),#0);
 
861
  value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
 
862
  proc_value_smallarray_open(value_smallarray);
 
863
  if global_u8bit <> RESULT_U8BIT then
 
864
    failed := true;
 
865
 
 
866
{$ifndef tp}
 
867
  clear_globals;
 
868
  clear_values;
 
869
 
 
870
  value_u8bit := RESULT_U8BIT;
 
871
  value_ptr := RESULT_PCHAR;
 
872
  value_s64bit := RESULT_S64BIT;
 
873
  value_smallstring := RESULT_SMALLSTRING;
 
874
  value_class := tclass1.create;
 
875
  value_boolean := RESULT_BOOLEAN;
 
876
  value_char := RESULT_CHAR;
 
877
  value_s64real:=RESULT_S64REAL;
 
878
  proc_value_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,
 
879
    value_boolean,value_class]);
 
880
 
 
881
  if global_u8bit <> RESULT_U8BIT then
 
882
    failed := true;
 
883
 
 
884
  if global_char <> RESULT_CHAR then
 
885
    failed := true;
 
886
  if global_boolean <> RESULT_BOOLEAN then
 
887
    failed:=true;
 
888
  if trunc(global_s64real) <> trunc(RESULT_S64REAL) then
 
889
     failed := true;
 
890
  if global_bigstring <> RESULT_SMALLSTRING then
 
891
     failed := true;
 
892
  if global_ptr <> value_ptr then
 
893
     failed := true;
 
894
{  if value_class <> global_class then
 
895
     failed := true;!!!!!!!!!!!!!!!!!!!!}
 
896
  if global_s64bit <> RESULT_S64BIT then
 
897
     failed := true;
 
898
  if assigned(value_class) then
 
899
    value_class.destroy;
 
900
 
 
901
  global_u8bit := 0;
 
902
  proc_value_smallarray_const_2([]);
 
903
  if global_u8bit <> RESULT_U8BIT then
 
904
    failed := true;
 
905
{$endif fpc}
 
906
 
 
907
  if failed then
 
908
    fail
 
909
  else
 
910
    WriteLn('Passed!');
 
911
 
 
912
  {***************************** MIXED  TESTS *******************************}
 
913
  clear_globals;
 
914
  clear_values;
 
915
 
 
916
  failed:=false;
 
917
 
 
918
  { LOC_REGISTER }
 
919
  write('Mixed value parameter test (src : LOC_REGISTER)...');
 
920
  proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT);
 
921
  if global_u8bit <> RESULT_U8BIT then
 
922
    failed:=true;
 
923
  if value_u8bit <> RESULT_U8BIT then
 
924
    failed := true;
 
925
  proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),getu16bit,RESULT_U8BIT);
 
926
  if global_u16bit <> RESULT_U16BIT then
 
927
    failed:=true;
 
928
  if value_u8bit <> RESULT_U8BIT then
 
929
    failed := true;
 
930
  proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),gets32bit, RESULT_U8BIT);
 
931
  if global_s32bit <> RESULT_S32BIT then
 
932
    failed:=true;
 
933
  if value_u8bit <> RESULT_U8BIT then
 
934
    failed := true;
 
935
{$ifndef tp}
 
936
  proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT);
 
937
  if global_s64bit <> RESULT_S64BIT then
 
938
    failed:=true;
 
939
{$endif}
 
940
  if value_u8bit <> RESULT_U8BIT then
 
941
    failed := true;
 
942
 
 
943
  if failed then
 
944
    fail
 
945
  else
 
946
    WriteLn('Passed!');
 
947
 
 
948
 
 
949
  { LOC_FPUREGISTER }
 
950
  clear_globals;
 
951
  clear_values;
 
952
  failed:=false;
 
953
  write('Mixed value parameter test (src : LOC_FPUREGISTER)...');
 
954
  proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), gets32real, RESULT_U8BIT);
 
955
  if value_u8bit <> RESULT_U8BIT then
 
956
    failed := true;
 
957
  if trunc(global_s32real) <> trunc(RESULT_S32REAL) then
 
958
    failed:=true;
 
959
  proc_value_s64real_mixed(byte(NOT RESULT_U8BIT),gets64real,RESULT_U8BIT);
 
960
  if value_u8bit <> RESULT_U8BIT then
 
961
    failed := true;
 
962
  if trunc(global_s64real) <> trunc(RESULT_S64REAL) then
 
963
    failed:=true;
 
964
  if failed then
 
965
    fail
 
966
  else
 
967
    WriteLn('Passed!');
 
968
 
 
969
 
 
970
  { LOC_MEM, LOC_REFERENCE orddef }
 
971
  clear_globals;
 
972
  clear_values;
 
973
  value_u8bit := RESULT_U8BIT;
 
974
  value_u16bit := RESULT_U16BIT;
 
975
  value_s32bit := RESULT_S32BIT;
 
976
{$ifndef tp}
 
977
  value_s64bit := RESULT_S64BIT;
 
978
{$endif}
 
979
  value_s32real := RESULT_S32REAL;
 
980
  value_s64real  := RESULT_S64REAL;
 
981
 
 
982
  failed:=false;
 
983
 
 
984
  { LOC_REFERENCE }
 
985
  write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...');
 
986
  proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT);
 
987
  if global_u8bit <> RESULT_U8BIT then
 
988
    failed:=true;
 
989
  if value_u8bit <> RESULT_U8BIT then
 
990
    failed := true;
 
991
  proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),value_u16bit, RESULT_U8BIT);
 
992
  if global_u16bit <> RESULT_U16BIT then
 
993
    failed:=true;
 
994
  if value_u8bit <> RESULT_U8BIT then
 
995
    failed := true;
 
996
  proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),value_s32bit, RESULT_U8BIT);
 
997
  if global_s32bit <> RESULT_S32BIT then
 
998
    failed:=true;
 
999
  if value_u8bit <> RESULT_U8BIT then
 
1000
    failed := true;
 
1001
{$ifndef tp}
 
1002
  proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT);
 
1003
  if global_s64bit <> RESULT_S64BIT then
 
1004
    failed:=true;
 
1005
{$endif}
 
1006
  if value_u8bit <> RESULT_U8BIT then
 
1007
    failed := true;
 
1008
 
 
1009
  if failed then
 
1010
    fail
 
1011
  else
 
1012
    WriteLn('Passed!');
 
1013
 
 
1014
 
 
1015
  { LOC_REFERENCE }
 
1016
  clear_globals;
 
1017
  failed:=false;
 
1018
  write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...');
 
1019
  proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), value_s32real, RESULT_U8BIT);
 
1020
  if trunc(global_s32real) <> trunc(RESULT_S32REAL) then
 
1021
    failed:=true;
 
1022
  if value_u8bit <> RESULT_U8BIT then
 
1023
    failed := true;
 
1024
  proc_value_s64real_mixed(byte(NOT RESULT_U8BIT), value_s64real, RESULT_U8BIT);
 
1025
  if trunc(global_s64real) <> trunc(RESULT_S64REAL) then
 
1026
    failed:=true;
 
1027
  if value_u8bit <> RESULT_U8BIT then
 
1028
    failed := true;
 
1029
 
 
1030
  if failed then
 
1031
    fail
 
1032
  else
 
1033
    WriteLn('Passed!');
 
1034
 
 
1035
 
 
1036
 
 
1037
  write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...');
 
1038
  clear_globals;
 
1039
  clear_values;
 
1040
  failed:=false;
 
1041
  value_ptr := RESULT_PCHAR;
 
1042
  proc_value_pointerdef_mixed(byte(NOT RESULT_U8BIT), value_ptr, RESULT_U8BIT);
 
1043
  if global_ptr <> value_ptr then
 
1044
    failed := true;
 
1045
  if value_u8bit <> RESULT_U8BIT then
 
1046
    failed := true;
 
1047
 
 
1048
 
 
1049
  value_proc := {$ifndef tp}@{$endif}testprocedure;
 
1050
  proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT);
 
1051
  if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then
 
1052
    failed := true;
 
1053
 
 
1054
{$ifndef tp}
 
1055
  value_class := tclass1.create;
 
1056
  proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT);
 
1057
  if value_class <> global_class then
 
1058
    failed := true;
 
1059
  if value_u8bit <> RESULT_U8BIT then
 
1060
    failed := true;
 
1061
  value_class.destroy;
 
1062
{$endif}
 
1063
  if failed then
 
1064
    fail
 
1065
  else
 
1066
    WriteLn('Passed!');
 
1067
 
 
1068
 
 
1069
 
 
1070
 
 
1071
  { LOC_REFERENCE }
 
1072
  clear_globals;
 
1073
  clear_values;
 
1074
  failed:=false;
 
1075
  value_u8bit := 0;
 
1076
  write('Mixed value parameter test (src : LOC_FLAGS (orddef)))...');
 
1077
  proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_u8bit = 0, RESULT_U8BIT);
 
1078
  if global_u8bit <> RESULT_BOOL8BIT then
 
1079
    failed:=true;
 
1080
  if value_u8bit <> RESULT_U8BIT then
 
1081
    failed := true;
 
1082
{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x
 
1083
  proc_value_bool16bit(value_s64bit < 0);
 
1084
  if global_u16bit <> RESULT_BOOL16BIT then
 
1085
    failed:=true;
 
1086
  proc_value_bool32bit(bool1 and bool2);
 
1087
  if global_s32bit <> RESULT_BOOL32BIT then
 
1088
    failed:=true;*}
 
1089
  if failed then
 
1090
    fail
 
1091
  else
 
1092
    WriteLn('Passed!');
 
1093
 
 
1094
 
 
1095
 
 
1096
{$ifndef tp}
 
1097
  clear_globals;
 
1098
  clear_values;
 
1099
  failed:=false;
 
1100
  write('Mixed value parameter test (src : LOC_JUMP (orddef)))...');
 
1101
  proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit = 0, RESULT_U8BIT);
 
1102
  if global_u8bit <> RESULT_BOOL8BIT then
 
1103
    failed:=true;
 
1104
  if value_u8bit <> RESULT_U8BIT then
 
1105
    failed := true;
 
1106
{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x
 
1107
  proc_value_bool16bit(value_s64bit < 0);
 
1108
  if global_u16bit <> RESULT_BOOL16BIT then
 
1109
    failed:=true;
 
1110
  proc_value_bool32bit(bool1 and bool2);
 
1111
  if global_s32bit <> RESULT_BOOL32BIT then
 
1112
    failed:=true;*}
 
1113
  if failed then
 
1114
    fail
 
1115
  else
 
1116
    WriteLn('Passed!');
 
1117
{$endif}
 
1118
 
 
1119
  { arraydef,
 
1120
    recorddef,
 
1121
    objectdef,
 
1122
    stringdef,
 
1123
    setdef : all considered the same by code generator.
 
1124
  }
 
1125
  write('Mixed value parameter test (src : LOC_REFERENCE (recorddef)))...');
 
1126
  clear_globals;
 
1127
  clear_values;
 
1128
  failed := false;
 
1129
 
 
1130
  value_smallrec.b := RESULT_U8BIT;
 
1131
  value_smallrec.w := RESULT_U16BIT;
 
1132
  proc_value_smallrecord_mixed(byte(NOT RESULT_U8BIT), value_smallrec, RESULT_U8BIT);
 
1133
  if global_u8bit <> RESULT_U8BIT then
 
1134
    failed := true;
 
1135
  if value_u8bit <> RESULT_U8BIT then
 
1136
    failed := true;
 
1137
 
 
1138
  clear_globals;
 
1139
  clear_values;
 
1140
  fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT);
 
1141
  proc_value_largerecord_mixed(byte(NOT RESULT_U8BIT), value_largerec, RESULT_U8BIT);
 
1142
  if global_u8bit <> RESULT_U8BIT then
 
1143
    failed := true;
 
1144
  if value_u8bit <> RESULT_U8BIT then
 
1145
    failed := true;
 
1146
 
 
1147
  if failed then
 
1148
    fail
 
1149
  else
 
1150
    WriteLn('Passed!');
 
1151
 
 
1152
 
 
1153
 
 
1154
  write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...');
 
1155
  clear_globals;
 
1156
  clear_values;
 
1157
  failed := false;
 
1158
 
 
1159
  value_smallset := [A_A,A_D];
 
1160
  proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT);
 
1161
  if global_u8bit <> RESULT_U8BIT then
 
1162
    failed := true;
 
1163
  if value_u8bit <> RESULT_U8BIT then
 
1164
    failed := true;
 
1165
 
 
1166
  clear_globals;
 
1167
  clear_values;
 
1168
  value_largeset := ['I'];
 
1169
  proc_value_largeset_mixed(byte(NOT RESULT_U8BIT), value_largeset, RESULT_U8BIT);
 
1170
  if global_u8bit <> RESULT_U8BIT then
 
1171
    failed := true;
 
1172
  if value_u8bit <> RESULT_U8BIT then
 
1173
    failed := true;
 
1174
 
 
1175
  if failed then
 
1176
    fail
 
1177
  else
 
1178
    WriteLn('Passed!');
 
1179
 
 
1180
 
 
1181
 
 
1182
 
 
1183
 
 
1184
  write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...');
 
1185
  clear_globals;
 
1186
  clear_values;
 
1187
  failed := false;
 
1188
  value_smallstring := RESULT_SMALLSTRING;
 
1189
 
 
1190
  proc_value_smallstring_mixed(byte(NOT RESULT_U8BIT), value_smallstring, RESULT_U8BIT);
 
1191
  if global_u8bit <> RESULT_U8BIT then
 
1192
    failed := true;
 
1193
  if value_u8bit <> RESULT_U8BIT then
 
1194
    failed := true;
 
1195
 
 
1196
  clear_globals;
 
1197
  clear_values;
 
1198
  value_bigstring := RESULT_BIGSTRING;
 
1199
  proc_value_bigstring_mixed(byte(NOT RESULT_U8BIT), value_bigstring, RESULT_U8BIT);
 
1200
  if global_u8bit <> RESULT_U8BIT then
 
1201
    failed := true;
 
1202
  if value_u8bit <> RESULT_U8BIT then
 
1203
    failed := true;
 
1204
 
 
1205
  if failed then
 
1206
    fail
 
1207
  else
 
1208
    WriteLn('Passed!');
 
1209
 
 
1210
 
 
1211
 
 
1212
  { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!}
 
1213
  { DON'T KNOW WHY/HOW TO TEST!!!!!                                   }
 
1214
 
 
1215
 
 
1216
  write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...');
 
1217
 
 
1218
  clear_globals;
 
1219
  clear_values;
 
1220
  failed:=false;
 
1221
 
 
1222
  fillchar(value_smallarray,sizeof(value_smallarray),#0);
 
1223
  value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
 
1224
  proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT);
 
1225
  if global_u8bit <> RESULT_U8BIT then
 
1226
    failed := true;
 
1227
  if value_u8bit <> RESULT_U8BIT then
 
1228
    failed := true;
 
1229
 
 
1230
  clear_globals;
 
1231
  clear_values;
 
1232
 
 
1233
  fillchar(value_smallarray,sizeof(value_smallarray),#0);
 
1234
  value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
 
1235
  proc_value_smallarray_open_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT);
 
1236
  if global_u8bit <> RESULT_U8BIT then
 
1237
    failed := true;
 
1238
  if value_u8bit <> RESULT_U8BIT then
 
1239
    failed := true;
 
1240
 
 
1241
{$ifndef tp}
 
1242
  clear_globals;
 
1243
  clear_values;
 
1244
 
 
1245
  value_u8bit := RESULT_U8BIT;
 
1246
  value_ptr := RESULT_PCHAR;
 
1247
  value_s64bit := RESULT_S64BIT;
 
1248
  value_smallstring := RESULT_SMALLSTRING;
 
1249
  value_class := tclass1.create;
 
1250
  value_boolean := RESULT_BOOLEAN;
 
1251
  value_char := RESULT_CHAR;
 
1252
  value_s64real:=RESULT_S64REAL;
 
1253
  proc_value_smallarray_const_1_mixed(byte(NOT RESULT_U8BIT), [value_u8bit,value_ptr,value_s64bit,value_char,
 
1254
   value_smallstring,value_s64real,value_boolean,value_class],
 
1255
     RESULT_U8BIT);
 
1256
  if value_u8bit <> RESULT_U8BIT then
 
1257
    failed := true;
 
1258
 
 
1259
  if global_u8bit <> RESULT_U8BIT then
 
1260
    failed := true;
 
1261
 
 
1262
  if global_char <> RESULT_CHAR then
 
1263
    failed := true;
 
1264
  if global_boolean <> RESULT_BOOLEAN then
 
1265
    failed:=true;
 
1266
  if trunc(global_s64real) <> trunc(RESULT_S64REAL) then
 
1267
     failed := true;
 
1268
  if global_bigstring <> RESULT_SMALLSTRING then
 
1269
     failed := true;
 
1270
  if global_ptr <> value_ptr then
 
1271
     failed := true;
 
1272
{  if value_class <> global_class then
 
1273
     failed := true;!!!!!!!!!!!!!!!!!!!!}
 
1274
  if global_s64bit <> RESULT_S64BIT then
 
1275
     failed := true;
 
1276
  if assigned(value_class) then
 
1277
    value_class.destroy;
 
1278
 
 
1279
  global_u8bit := 0;
 
1280
  proc_value_smallarray_const_2_mixed(byte(NOT RESULT_U8BIT), [], RESULT_U8BIT);
 
1281
  if global_u8bit <> RESULT_U8BIT then
 
1282
    failed := true;
 
1283
  if value_u8bit <> RESULT_U8BIT then
 
1284
    failed := true;
 
1285
{$endif}
 
1286
 
 
1287
  if failed then
 
1288
    fail
 
1289
  else
 
1290
    WriteLn('Passed!');
 
1291
 
 
1292
end.