mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-12 10:29:36 +02:00
179 lines
5.5 KiB
ObjectPascal
179 lines
5.5 KiB
ObjectPascal
{****************************************************************}
|
|
{ CODE GENERATOR TEST PROGRAM }
|
|
{****************************************************************}
|
|
{ NODE TESTED : secondnot() }
|
|
{****************************************************************}
|
|
{ PRE-REQUISITES: secondload() }
|
|
{ secondassign() }
|
|
{****************************************************************}
|
|
{ DEFINES: VERBOSE = Write test information to screen }
|
|
{ FPC = Target is FreePascal compiler }
|
|
{****************************************************************}
|
|
{ REMARKS: }
|
|
{ }
|
|
{ }
|
|
{ }
|
|
{****************************************************************}
|
|
Program tnot;
|
|
|
|
{----------------------------------------------------}
|
|
{ Cases to test: }
|
|
{ CURRENT NODE (result) }
|
|
{ - LOC_REGISTER }
|
|
{ - LOC_FLAGS }
|
|
{ LEFT NODE (value to complement) }
|
|
{ possible cases : int64,byte,word,longint }
|
|
{ boolean }
|
|
{ - LOC_CREGISTER }
|
|
{ - LOC_REFERENCE / LOC_MEM }
|
|
{ - LOC_REGISTER }
|
|
{ - LOC_FLAGS }
|
|
{ - LOC_JUMP }
|
|
{----------------------------------------------------}
|
|
|
|
|
|
{$IFNDEF FPC}
|
|
type smallint = integer;
|
|
{$ENDIF}
|
|
|
|
function getintres : smallint;
|
|
begin
|
|
getintres := $7F7F;
|
|
end;
|
|
|
|
function getbyteboolval : bytebool;
|
|
begin
|
|
getbyteboolval := TRUE;
|
|
end;
|
|
|
|
function getbooleanval : boolean;
|
|
begin
|
|
getbooleanval := TRUE;
|
|
end;
|
|
|
|
procedure test(value, required: longint);
|
|
begin
|
|
if value <> required then
|
|
begin
|
|
writeln('Got ',value,' instead of ',required);
|
|
halt(1);
|
|
end
|
|
else
|
|
writeln('Passed!');
|
|
end;
|
|
|
|
const
|
|
lb = longbool(false);
|
|
|
|
var
|
|
longres : longint;
|
|
intres : smallint;
|
|
booleanval : boolean;
|
|
byteboolval : bytebool;
|
|
wordboolval : wordbool;
|
|
longboolval : longbool;
|
|
booleanres : boolean;
|
|
byteboolres : bytebool;
|
|
wordboolres : wordbool;
|
|
longboolres : longbool;
|
|
{$ifdef fpc}
|
|
int64res : int64;
|
|
{$endif}
|
|
Begin
|
|
WriteLn('------------------------------ LONGINT --------------------------------');
|
|
{ CURRENT NODE: REGISTER }
|
|
{ LEFT NODE : REFERENCE }
|
|
WriteLn('(current) : LOC_REGISTER; (left) : LOC_REFERENCE');
|
|
longres := $7F7F7F7F;
|
|
longres := not longres;
|
|
Write('Value should be $80808080...');
|
|
|
|
{ the following test give range check errors }
|
|
{$R-}
|
|
test(longres,$80808080);
|
|
|
|
{ CURRENT NODE : REGISTER }
|
|
{ LEFT NODE : REGISTER }
|
|
WriteLn('(current) : LOC_REGISTER; (left) : LOC_REGISTER');
|
|
longres := not getintres;
|
|
Write('Value should be $8080...');
|
|
test(longres, $FFFF8080);
|
|
|
|
WriteLn('----------------------------- BOOLEAN -----------------------------------');
|
|
|
|
{ CURRENT NODE : LOC_REGISTER }
|
|
{ LEFT NODE : LOC_REFERENCE }
|
|
WriteLn('(current) : LOC_REGISTER; (left) : LOC_REFERENCE');
|
|
booleanval := TRUE;
|
|
booleanres := not booleanval;
|
|
Write('Value should be FALSE...');
|
|
test(ord(booleanres),0);
|
|
|
|
byteboolval := TRUE;
|
|
byteboolres := not byteboolval;
|
|
Write('Value should be FALSE...');
|
|
test(ord(byteboolres),0);
|
|
|
|
wordboolval := TRUE;
|
|
wordboolres := not wordboolval;
|
|
Write('Value should be FALSE...');
|
|
test(longint(wordboolres),0);
|
|
|
|
longboolval := TRUE;
|
|
longboolres := not longboolval;
|
|
Write('Value should be FALSE...');
|
|
test(longint(longboolres),0);
|
|
|
|
{ CURRENT NODE : LOC_REGISTER }
|
|
{ LEFT NODE : LOC_REGISTER }
|
|
WriteLn('(current) : LOC_REGISTER; (left) : LOC_REGISTER');
|
|
longboolres := not getbyteboolval;
|
|
Write('Value should be FALSE...');
|
|
test(longint(longboolres),0);
|
|
|
|
{ CURRENT NODE : LOC_FLAGS }
|
|
{ LEFT NODE : LOC_FLAGS }
|
|
WriteLn('(current) : LOC_FLAGS; (left) : LOC_FLAGS');
|
|
intres := 1;
|
|
booleanres := TRUE;
|
|
booleanres:= not ((intres = 1));
|
|
Write('Value should be FALSE...');
|
|
test(ord(booleanres),0);
|
|
|
|
intres := 1;
|
|
byteboolres := TRUE;
|
|
byteboolres:= not ((intres = 1));
|
|
Write('Value should be FALSE...');
|
|
test(ord(byteboolres),0);
|
|
|
|
longboolres:=not(lb);
|
|
Write('Value should be $ffffffff...');
|
|
test(ord(longboolres),-1);
|
|
|
|
{ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! }
|
|
{ CURRENT_NODE : LOC_JUMP }
|
|
{ ???????????????????????}
|
|
|
|
{ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! }
|
|
{ CURRENT_NODE : LOC_FLAGS }
|
|
{ LEFT NODE : <> LOC_FLAGS }
|
|
{ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! }
|
|
{$IFDEF FPC}
|
|
WriteLn('------------------------------ INT64 ----------------------------------');
|
|
{ CURRENT NODE: REGISTER }
|
|
{ LEFT NODE : REFERENCE }
|
|
WriteLn('(current) : LOC_REGISTER; (left) : LOC_REFERENCE');
|
|
int64res := $7F7F7F7F;
|
|
int64res := not int64res;
|
|
Write('Value should be $80808080...');
|
|
test(int64res and $FFFFFFFF,$80808080);
|
|
|
|
{ CURRENT NODE : REGISTER }
|
|
{ LEFT NODE : REGISTER }
|
|
WriteLn('(current) : LOC_REGISTER; (left) : LOC_REGISTER');
|
|
int64res := not (word(getintres));
|
|
Write('Value should be $8080...');
|
|
test(int64res and $FFFFFFFF,$00008080);
|
|
{$ENDIF}
|
|
end.
|