blob: b23cf8cefc42fa42debeb0c15b451f99c477c931 (
plain)
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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
{****************************************************************}
{ CODE GENERATOR TEST PROGRAM }
{****************************************************************}
{ NODE TESTED : secondunaryminus() }
{****************************************************************}
{ PRE-REQUISITES: secondload() }
{ secondassign() }
{ secondtypeconv() }
{****************************************************************}
{ DEFINES: }
{ FPC = Target is FreePascal compiler }
{****************************************************************}
{ REMARKS: }
{ }
{ }
{ }
{****************************************************************}
Program tneg;
{----------------------------------------------------}
{ Cases to test: }
{ CURRENT NODE (result value) }
{ - LOC_REGISTER }
{ - LOC_FPU }
{ LEFT NODE (value to negate) }
{ - LOC_CREGISTER }
{ - LOC_REFERENCE / LOC_MEM }
{ - LOC_REGISTER }
{ - LOC_FPU }
{----------------------------------------------------}
procedure test(value, required: longint);
begin
if value <> required then
begin
writeln('Got ',value,' instead of ',required);
halt(1);
end
else
writeln('Passed!');
end;
procedure fail;
begin
writeln('Failure.');
halt(1);
end;
function getreal: real;
begin
getreal := 1.0;
end;
var
longval : longint;
realval : real;
byteval : longint;
{$IFDEF FPC}
int64val : int64;
{$ENDIF}
Begin
WriteLn('------------------------------ LONGINT --------------------------------');
{ CURRENT NODE: REGISTER }
{ LEFT NODE : REFERENCE }
longval := 1;
longval := - longval;
Write('Value should be -1...');
test(longval, -1);
{ CURRENT NODE : REGISTER }
{ LEFT NODE: REGISTER }
byteval := 2;
longval := - byteval;
Write('Value should be -2...');
test(longval, -2);
{ CURRENT NODE: LOC_FPU }
{ LEFT NODE : LOC_REFERENCE }
realval := -1.0;
realval := - realval;
Write('Value should 1.0...');
if realval - 1.0 = 0.0 then
WriteLn('Passed!')
else
Fail;
{ LEFT NODE : LOC_FPU }
{ CURRENT NODE : LOC_FPU }
realval := -1.0;
realval := -(getreal*(realval));
Write('Value should 1.0...');
if realval - 1.0 = 0.0 then
WriteLn('Passed!')
else
Fail;
{$IFDEF FPC}
WriteLn('------------------------------ INT64 --------------------------------');
{ CURRENT NODE: REGISTER }
{ LEFT NODE : REFERENCE }
int64val := 1;
int64val := - int64val;
Write('Value should be -1...');
{ the following test give range check errors }
{$R-}
test(int64val and $FFFFFFFF, -1);
{ CURRENT NODE : REGISTER }
{ LEFT NODE: REGISTER }
byteval := 2;
int64val := - byteval;
Write('Value should be -2...');
test(int64val and $FFFFFFFF, -2);
{$ENDIF}
end.
|