fpcsrc/tests/test/ttpara1.pp


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85

{ %VERSION=1.1 }

{$ifdef fpc}
  {$mode objfpc}
{$endif}

uses
   erroru;

type
   tr1 = record
      l1,l2 : cardinal;
   end;

procedure p1(out b : byte);

  begin
     b:=$aa;
  end;

procedure p2(out w : word);

  begin
     w:=$aaaa;
  end;

procedure p3(out d : cardinal);

  begin
     d:=$aaaaaaaa;
  end;

procedure p4(out r : tr1);

  begin
     r.l1:=$aaaaaaaa;
     r.l2:=$aaaaaaaa;
  end;

procedure p5(out a : ansistring);

  begin
     if a<>'' then
       do_error(1000);
     a:='Now it''s another ansistring';
  end;

var
   b : byte;
   w : word;
   d : cardinal;
   r1 : tr1;
   a : ansistring;


begin
   b:=$ff;
   w:=$ffff;
   d:=$ffffffff;
   a:='An ansistring';
   r1.l1:=$ffffffff;
   r1.l2:=$ffffffff;

   p1(b);
   if b<>$aa then
     do_error(1100);

   p2(w);
   if w<>$aaaa then
     do_error(1101);

   p3(d);
   if d<>$aaaaaaaa then
     do_error(1102);

   p4(r1);
   if r1.l1<>$aaaaaaaa then
     do_error(1103);
   if r1.l2<>$aaaaaaaa then
     do_error(1104);

   p5(a);
   if a<>'Now it''s another ansistring' then
     do_error(1105);
end.