summaryrefslogtreecommitdiff
path: root/fpcsrc/tests/test/cg/tneg.pp
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.