← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcsrc/tests/test/cg/tnot.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/tests/test/cg/tnot.pp
 
1
{****************************************************************}
 
2
{  CODE GENERATOR TEST PROGRAM                                   }
 
3
{****************************************************************}
 
4
{ NODE TESTED : secondnot()                                      }
 
5
{****************************************************************}
 
6
{ PRE-REQUISITES: secondload()                                   }
 
7
{                 secondassign()                                 }
 
8
{****************************************************************}
 
9
{ DEFINES:   VERBOSE = Write test information to screen          }
 
10
{            FPC     = Target is FreePascal compiler             }
 
11
{****************************************************************}
 
12
{ REMARKS:                                                       }
 
13
{                                                                }
 
14
{                                                                }
 
15
{                                                                }
 
16
{****************************************************************}
 
17
Program tnot;
 
18
 
 
19
{----------------------------------------------------}
 
20
{ Cases to test:                                     }
 
21
{   CURRENT NODE (result)                            }
 
22
{     - LOC_REGISTER                                 }
 
23
{     - LOC_FLAGS                                    }
 
24
{   LEFT NODE (value to complement)                  }
 
25
{     possible cases : int64,byte,word,longint       }
 
26
{                      boolean                       }
 
27
{     - LOC_CREGISTER                                }
 
28
{     - LOC_REFERENCE / LOC_MEM                      }
 
29
{     - LOC_REGISTER                                 }
 
30
{     - LOC_FLAGS                                    }
 
31
{     - LOC_JUMP                                     }
 
32
{----------------------------------------------------}
 
33
 
 
34
 
 
35
{$IFNDEF FPC}
 
36
type  smallint = integer;
 
37
{$ENDIF}
 
38
 
 
39
function getintres : smallint;
 
40
begin
 
41
 getintres := $7F7F;
 
42
end;
 
43
 
 
44
function getbyteboolval : boolean;
 
45
begin
 
46
  getbyteboolval := TRUE;
 
47
end;
 
48
 
 
49
procedure test(value, required: longint);
 
50
begin
 
51
  if value <> required then
 
52
    begin
 
53
      writeln('Got ',value,' instead of ',required);
 
54
      halt(1);
 
55
    end
 
56
  else
 
57
    writeln('Passed!');
 
58
end;
 
59
 
 
60
 
 
61
 
 
62
var
 
63
 longres :  longint;
 
64
 intres : smallint;
 
65
 byteboolval : bytebool;
 
66
 wordboolval : wordbool;
 
67
 longboolval : longbool;
 
68
 byteboolres : bytebool;
 
69
 wordboolres : wordbool;
 
70
 longboolres : longbool;
 
71
{$ifdef fpc}
 
72
 int64res : int64;
 
73
{$endif}
 
74
Begin
 
75
   WriteLn('------------------------------ LONGINT --------------------------------');
 
76
   { CURRENT NODE: REGISTER }
 
77
   { LEFT NODE : REFERENCE  }
 
78
   WriteLn('(current) : LOC_REGISTER; (left) : LOC_REFERENCE');
 
79
   longres := $7F7F7F7F;
 
80
   longres := not longres;
 
81
   Write('Value should be $80808080...');
 
82
 
 
83
   { the following test give range check errors }
 
84
   {$R-}
 
85
   test(longres,$80808080);
 
86
 
 
87
   { CURRENT NODE : REGISTER }
 
88
   { LEFT NODE : REGISTER    }
 
89
   WriteLn('(current) : LOC_REGISTER; (left) : LOC_REGISTER');
 
90
   longres := not getintres;
 
91
   Write('Value should be $8080...');
 
92
   test(longres, $FFFF8080);
 
93
 
 
94
   WriteLn('----------------------------- BOOLEAN -----------------------------------');
 
95
 
 
96
   { CURRENT NODE : LOC_REGISTER }
 
97
   { LEFT NODE :  LOC_REFERENCE  }
 
98
   WriteLn('(current) : LOC_REGISTER; (left) : LOC_REFERENCE');
 
99
   byteboolval := TRUE;
 
100
   byteboolres := not byteboolval;
 
101
   Write('Value should be FALSE...');
 
102
   test(ord(byteboolres),0);
 
103
 
 
104
   wordboolval := TRUE;
 
105
   wordboolres := not wordboolval;
 
106
   Write('Value should be FALSE...');
 
107
   test(longint(wordboolres),0);
 
108
 
 
109
   longboolval := TRUE;
 
110
   longboolres := not longboolval;
 
111
   Write('Value should be FALSE...');
 
112
   test(longint(longboolres),0);
 
113
 
 
114
   { CURRENT NODE : LOC_REGISTER }
 
115
   { LEFT NODE :  LOC_REGISTER  }
 
116
   WriteLn('(current) : LOC_REGISTER; (left) : LOC_REGISTER');
 
117
   longboolres := not getbyteboolval;
 
118
   Write('Value should be FALSE...');
 
119
   test(longint(longboolres),0);
 
120
 
 
121
   { CURRENT NODE : LOC_FLAGS }
 
122
   { LEFT NODE :  LOC_FLAGS  }
 
123
   WriteLn('(current) : LOC_FLAGS; (left) : LOC_FLAGS');
 
124
   intres := 1;
 
125
   byteboolres := TRUE;
 
126
   byteboolres:= not ((intres = 1));
 
127
   Write('Value should be FALSE...');
 
128
   test(ord(byteboolres),0);
 
129
 
 
130
  { !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! }
 
131
  { CURRENT_NODE : LOC_JUMP }
 
132
  { ???????????????????????}
 
133
 
 
134
  { !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! }
 
135
  { CURRENT_NODE : LOC_FLAGS          }
 
136
  { LEFT NODE : <> LOC_FLAGS          }
 
137
  { !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! }
 
138
{$IFDEF FPC}
 
139
   WriteLn('------------------------------  INT64  ----------------------------------');
 
140
   { CURRENT NODE: REGISTER }
 
141
   { LEFT NODE : REFERENCE  }
 
142
   WriteLn('(current) : LOC_REGISTER; (left) : LOC_REFERENCE');
 
143
   int64res := $7F7F7F7F;
 
144
   int64res := not int64res;
 
145
   Write('Value should be $80808080...');
 
146
   test(int64res and $FFFFFFFF,$80808080);
 
147
 
 
148
   { CURRENT NODE : REGISTER }
 
149
   { LEFT NODE : REGISTER    }
 
150
   WriteLn('(current) : LOC_REGISTER; (left) : LOC_REGISTER');
 
151
   int64res := not (word(getintres));
 
152
   Write('Value should be $8080...');
 
153
   test(int64res and $FFFFFFFF,$00008080);
 
154
{$ENDIF}
 
155
end.