1 {$mode objfpc}
2 {$R-}
3
4 program TestProgram;
5 uses
6 {$ifdef go32v2}
7 dpmiexcp,
8 {$endif}
9 test1, Test2;
10
11
12 const A = 1234;
13 C = #1#2#3#4;
14 ConstBool1 = true;
15 ConstBool2 = boolean(5);
16 ConstChar = 'A';
17 ConstSet = ['A'..'Z'];
18 ConstSet2 = [15..254];
19 ConstFloat = 3.1415;
20
21 {$i empty.inc}
22
23 type
24 PObj = ^TObj;
25 TObj = object
26 constructor Init;
Funcnull27 function Func: boolean;
28 procedure Proc; virtual;
29 destructor Done; virtual;
30 private
31 Z: integer;
32 end;
33
34 TObj2 = object(TObj)
35 procedure Proc; virtual;
36 end;
37
38 TObj3 = object(TObj)
39 end;
40
41 TObj32 = object(TObj3)
42 end;
43
44 TObj4 = object(TObj)
45 end;
46
47 TClass = class
48 name : string;
49 constructor Create;
50 end;
51
52 TClass2 = class(TClass)
53 X : longint;
54 constructor Create;
55 end;
56
57 EnumTyp = (enum1,enum2,enum3);
58 ArrayTyp = array[1..10] of EnumTyp;
59 ProcTyp = function(A: word; var B: longint; const C: EnumTyp): real;
60 SetTyp = set of EnumTyp;
61
62 const
63 ConstOrd = enum1;
64
65 var Hello : word;
66 X: PRecord;
67 Bool: boolean;
68 T : TRecord;
69 Str20 : string[20];
70 Str255: string;
71 ArrayW: array[2..45] of word;
72 ArrayVar: ArrayTyp;
73 EnumVar: (enumElem1,enumElem2,enumElem3);
74 EnumVar2: EnumTyp;
75 FileVar: file;
76 FileVarR: file of TRecord;
77 FileVarW: file of word;
78 ProcVar: procedure;
79 ProcVarD: function(X: real): boolean;
80 ProcVarI: ProcTyp;
81 SetVarD: set of char;
82 SetVarI: SetTyp;
83 Float1: real;
84 Float2: double;
85 Float3: comp;
86 Float4: extended;
87 Pointer1: pointer;
88 Pointer2: PObj;
89 ClassVar1: TClass;
90 ClassVar2: TClass2;
91 Obj1: TObj;
92 Obj2: TObj2;
93 CharArray : Array[1..2000] of char;
94 ExtendedArray : Array[1..2000] of extended;
95 ExtendedPackedArray : packed Array[1..2000] of extended;
96 SingleArrayArray : Array[1..10,1..10] of single;
97
98 constructor TObj.Init;
99 begin
100 Z:=1;
101 end;
102
TObj.Funcnull103 function TObj.Func: boolean;
104 begin
105 Func:=true;
106 end;
107
108 procedure TObj.Proc;
109 begin
110 if Func=false then Halt;
111 end;
112
113 destructor TObj.Done;
114 begin
115 end;
116
117 procedure TObj2.Proc;
118 begin
119 Z:=4;
120 end;
121
122 constructor TClass.Create;
123 begin
124 Name:='TClass instance';
125 end;
126
127 constructor TClass2.Create;
128 begin
129 Name:='TClass2 instance';
130 X:=7;
131 end;
132
Func1null133 function Func1(x,z : word; var y : boolean; const r: TRecord): shortint;
134
135 var loc : string;
136
137 procedure test_local(c,f : longint);
138 var
139 int_loc : longint;
140 begin
141 Writeln('dummy for browser');
142 end;
143
144 procedure indirect_call;
145 var
146 loc : longint;
147 begin
148 loc:=1;
149 test_local(5,7);
150 end;
151 begin
152 loc:='This is a string';
153 if Hello=0 then X:=0 else X:=1;
154 test_local(0,2);
155 indirect_call;
156 Func1:=X;
157 end;
158
159 var i,j : longint;
160 Length : longint;
161
162 BEGIN
163 {$ifdef m68k}
164 asm
165 beq @L13
166 bhi @L13
167 blo @L13
168 dbeq d0,@L13
169 dbcs d0,@L13
170 // dblo d0,@L13
171 @L13:
172 end;
173 {$endif}
174 for i:=low(ExtendedArray) to high(ExtendedArray) do
175 ExtendedArray[i]:=i;
176 for i:=low(ExtendedPackedArray) to high(ExtendedPackedArray) do
177 ExtendedPackedArray[i]:=i;
178
179 for i:=1 to 10 do
180 for j:=1 to 10 do
181 SingleArrayArray[i,j]:=i*j;
182
183 ClassVar1:=TClass2.create;
184 Obj1.Init;
185 pointer2:=@Obj1;
186 Writeln('Obj1.Z=',Obj1.Z);
187 Obj1.done;
188 X:=nil;
189 // fg
190 for i:=1 to 2000 do
191 CharArray[i]:=chr(32+(i mod (255-32)));
192 writeln('Hello world!');
193 Writeln('ParamCount = ',ParamCount);
194 For i:=0 to paramcount do
195 writeln('Paramstr(',i,') = '+Paramstr(i));
196 writeln(IsOdd(3));
197 writeln(Func1(5,5,Bool,T));
198 new(X);
199 new(X^.next);
200 X^.next^.next:=X;
201 dispose(X);
202 { for i:=1 to 99 do
203 Writeln('Line ',i); }
204 if (TestOne<>1) or (TestOne(5)<>5) or (TestOne('6')<>6) then
205 begin
206 Writeln('Error while testing TestOne function overloads');
207 RunError(200);
208 end;
209 Halt(4);
210 END.
211