Skip to content

Commit 85a3f0a

Browse files
peterdellpeterdell
committed
Extend Tests for FLOAT16/REAL
1 parent b15e684 commit 85a3f0a

File tree

4 files changed

+198
-94
lines changed

4 files changed

+198
-94
lines changed

‎src/.gitignore‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
*.bak
22
*.exe
3-
*.exe
3+
*.xex
44
*.tmp
55
*.log
66
*.lps

‎src/Test-MP.pas‎

Lines changed: 63 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -1,28 +1,70 @@
11
program test;
2-
uses Crt;
32

3+
uses
4+
Crt;
45

5-
procedure Assert(b: Boolean; s: String);
6-
begin
7-
if (b) then
8-
begin
9-
Write('OK: ');
10-
end
11-
else
12-
begin
13-
Write('ERROR:');
14-
end;
15-
Writeln(s);
16-
end;
17-
18-
var i: Integer;
6+
procedure Assert(b: Boolean; s: String); overload;
7+
begin
8+
if (b) then
9+
begin
10+
Write('OK: ');
11+
end
12+
else
13+
begin
14+
Write('ERROR: ');
15+
end;
16+
Writeln(s);
17+
end;
18+
19+
procedure AssertEquals(actual: String; expected: String); overload;
20+
begin
21+
if (actual = expected) then
22+
begin
23+
Writeln('OK: Got ''', actual, ''' = ''', expected, '''.');
24+
end
25+
else
26+
begin
27+
Writeln('ERROR: Got ''', actual, ''' but expected ''', expected, '''.');
28+
end;
29+
end;
30+
31+
procedure TestExpressions;
32+
var
33+
i: Integer;
34+
begin
35+
i := 1;
36+
Writeln('i:=1 equals ', i);
37+
Inc(i);
38+
Writeln('Inc(i) equals ', i);
39+
Assert(i = 2, 'I=2');
40+
Assert(1 + 1 = 2, '1+1=2');
41+
end;
42+
43+
procedure TestFloats;
44+
const
45+
FLOAT16_CONST: Float16 = 0.288675135; { SQRT(3) / 6 }
46+
FLOAT16_CONST_STRING: String = '0.2890';
47+
48+
REAL_CONST: Real = 0.288675135; { SQRT(3) / 6 }
49+
REAL_CONST_STRING: String = '0.2890';
50+
51+
SINGLE_CONST: Single = 0.288675135; { SQRT(3) / 6 }
52+
SINGLE_CONST_STRING: String = '0.2890';
53+
54+
begin
55+
AssertEquals(FloatToStr(FLOAT16_CONST), FLOAT16_CONST_STRING);
56+
AssertEquals(FloatToStr(REAL_CONST), REAL_CONST_STRING);
57+
AssertEquals(FloatToStr(SINGLE_CONST), SINGLE_CONST_STRING);
58+
end;
59+
60+
var
61+
i: Integer;
62+
var
63+
s, msg: String;
1964
begin
20-
i:=1;
21-
Writeln(i);
22-
Inc(i);
23-
Writeln(i);
24-
Assert(i=2, 'I=2');
25-
Assert(1+1=2, '1+1=2');
65+
TestExpressions;
66+
TestFloats;
67+
2668
Writeln('Test completed. Press any key');
2769
repeat
2870
until KeyPressed;

‎src/TestLanguage.lpi‎

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -44,8 +44,20 @@
4444
<Parsing>
4545
<SyntaxOptions>
4646
<SyntaxMode Value="Delphi"/>
47+
<IncludeAssertionCode Value="True"/>
4748
</SyntaxOptions>
4849
</Parsing>
50+
<CodeGeneration>
51+
<Checks>
52+
<RangeChecks Value="True"/>
53+
<OverflowChecks Value="True"/>
54+
<StackChecks Value="True"/>
55+
</Checks>
56+
<VerifyObjMethodCallValidity Value="True"/>
57+
<Optimizations>
58+
<OptimizationLevel Value="0"/>
59+
</Optimizations>
60+
</CodeGeneration>
4961
<Linking>
5062
<Debugging>
5163
<DebugInfoType Value="dsDwarf2Set"/>

‎src/TestLanguage.lpr‎

Lines changed: 122 additions & 72 deletions
Original file line numberDiff line numberDiff line change
@@ -1,84 +1,134 @@
11
program TestLanguage;
22

3-
uses SysUtils;
3+
{$ASSERTIONS ON}
44

5-
type ITextFile = interface
6-
end;
5+
uses
6+
Crt,
7+
SysUtils;
78

8-
type TTextFile = class(TInterfacedObject, ITextFile)
9-
public
10-
constructor Create;
11-
end;
9+
type
10+
ITextFile = interface
11+
end;
1212

13-
type TFileSystem = class
13+
type
14+
TTextFile = class(TInterfacedObject, ITextFile)
1415
public
15-
class function CreateTextFile: ITextFile; static;
16-
end;
17-
18-
19-
//
20-
// TTextFile
21-
//
22-
constructor TTextFile.Create;
23-
begin
24-
Inherited;
25-
end;
26-
27-
class function TFileSystem.CreateTextFile:ITextFile;
28-
29-
begin
30-
Result:=TTextFile.Create;
31-
end;
32-
33-
34-
procedure TestTextFile;
35-
var textFile: ITextFile;
36-
begin
37-
textFile:=TFileSystem.CreateTextFile;
38-
// Interfaced objects are implicitly reference counted and freed.
39-
end;
40-
41-
// https://en.wikipedia.org/wiki/Single-precision_floating-point_format
42-
procedure TestRound(fl : Single);
43-
var i : LongInt; // 32 bit
44-
var j : LongInt; // 32 bit
45-
begin
46-
i:=Round(fl*256); // Round Next Even
47-
j:=LongInt(fl);
16+
constructor Create;
17+
end;
4818

49-
Writeln(fl,' i=',i:11 ,' ',IntToHex(i,8),' j=',j:11,' ',IntToHex(j,8));
50-
end;
51-
52-
53-
procedure TestRoundAll();
54-
begin
55-
56-
TestRound(1);
57-
TestRound(2);
58-
TestRound(4);
59-
TestRound(8);
60-
61-
TestRound(-1);
62-
TestRound(-2);
63-
TestRound(-4);
64-
TestRound(-8);
65-
66-
TestRound(0.1);
67-
TestRound(0.5);
68-
TestRound(1.5);
69-
TestRound(1.9);
70-
71-
TestRound(-0.1);
72-
TestRound(-0.5);
73-
TestRound(-1.1);
74-
TestRound(-1.5);
75-
TestRound(-1.9);
76-
77-
end;
19+
type
20+
TFileSystem = class
21+
public
22+
class function CreateTextFile: ITextFile; static;
23+
end;
24+
25+
26+
27+
// TTextFile
28+
29+
constructor TTextFile.Create;
30+
begin
31+
inherited;
32+
end;
33+
34+
class function TFileSystem.CreateTextFile: ITextFile;
35+
36+
begin
37+
Result := TTextFile.Create;
38+
end;
39+
40+
41+
procedure TestTextFile;
42+
var
43+
textFile: ITextFile;
44+
begin
45+
textFile := TFileSystem.CreateTextFile;
46+
// Interfaced objects are implicitly reference counted and freed.
47+
end;
48+
49+
// https://en.wikipedia.org/wiki/Single-precision_floating-point_format
50+
procedure TestRound(fl: Single);
51+
var
52+
i: Longint; // 32 bit
53+
var
54+
j: Longint; // 32 bit
55+
begin
56+
i := Round(fl * 256); // Round Next Even
57+
j := Longint(fl);
58+
59+
Writeln(fl, ' i=', i: 11, ' ', IntToHex(i, 8), ' j=', j: 11, ' ', IntToHex(j, 8));
60+
end;
61+
62+
63+
procedure AssertEquals(actualValue: Longint; expectedValue: Longint; message: String); overload;
64+
begin
65+
if actualValue <> expectedValue then
66+
begin
67+
WriteLn('ERROR: Actual value ' + IntToStr(actualValue) + ' is different from expected value ' +
68+
IntToStr(expectedValue) + '. ' + message);
69+
end;
70+
end;
71+
72+
procedure AssertEquals(actualValue: String; expectedValue: String; message: String = ''); overload;
73+
begin
74+
if actualValue <> expectedValue then
75+
begin
76+
WriteLn('ERROR: Actual value ' + actualValue + ' is different from expected value ' +
77+
expectedValue + '. ' + message);
78+
end;
79+
end;
80+
81+
procedure TestRoundAll();
82+
begin
83+
84+
TestRound(1);
85+
TestRound(2);
86+
TestRound(4);
87+
TestRound(8);
88+
89+
TestRound(-1);
90+
TestRound(-2);
91+
TestRound(-4);
92+
TestRound(-8);
93+
94+
TestRound(0.1);
95+
TestRound(0.5);
96+
TestRound(1.5);
97+
TestRound(1.9);
98+
99+
TestRound(-0.1);
100+
TestRound(-0.5);
101+
TestRound(-1.1);
102+
TestRound(-1.5);
103+
TestRound(-1.9);
104+
105+
end;
106+
107+
procedure TestFloats;
108+
109+
const
110+
// Float16 does not exist in standard FPC / Delphi.
111+
// See https://github.com/tebe6502/16bit-half-float-in-Pascal
112+
// FLOAT16_CONST: Float16 = 0.288675135; { SQRT(3) / 6 }
113+
// FLOAT16_CONST_STRING: String = '0.2890';
114+
115+
REAL_CONST: Real = 0.288675135; { SQRT(3) / 6 }
116+
REAL_CONST_STRING: String = '0,288675135';
117+
118+
SINGLE_CONST: Single = 0.288675135; { SQRT(3) / 6 }
119+
SINGLE_CONST_STRING: String = '0,2886751294';
120+
121+
begin
122+
// AssertEquals(FloatToStr(FLOAT16_CONST), FLOAT16_CONST_STRING);
123+
AssertEquals(FloatToStr(REAL_CONST), REAL_CONST_STRING);
124+
AssertEquals(FloatToStr(SINGLE_CONST), SINGLE_CONST_STRING);
125+
end;
78126

79127
begin
80128
TestRoundAll;
129+
TestFloats;
81130
TestTextFile;
131+
WriteLn('Press any key to continue.');
132+
repeat
133+
until KeyPressed;
82134
end.
83-
84-

0 commit comments

Comments
 (0)