paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-14 07:59:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* changed byte/word/longbool to be Delphi-compatible (+ similar changes

Browse Source 
for qwordbool) + test:
    o assigning true to such a variable now sets them to $ff/$ffff/$ffffffff
    o these types are now all signed
    o converting an integer type to a byte/word/long/qwordbool using an
      explicit type cast keeps the integer's original value stored in the
      bool, instead of forcing it to ord(true)/ord(false)
    (mantis #10233 and #10613, implemented for all architectures, testsuite
     tested for ppc32, sparc and x86)
  * fixed some places where the rtl depended on longbool(true) having the
    value 1
  * extended several boolean tests (and adapted some to no longer assume
    that byte/word/long/qwordbool(true)=1)
  + support for converting to qwordbool in second_int_to_bool for x86, ppc
    and sparc

git-svn-id: trunk@9898 -
This commit is contained in:
Jonas Maebe 2008-01-24 21:30:55 +00:00
parent 53d90218af
commit 8349cde7db
40 changed files with 676 additions and 173 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -7964,6 +7964,7 @@ tests/webtbs/tw1021.pp svneol=native#text/plain
tests/webtbs/tw10210.pp svneol=native#text/plain
tests/webtbs/tw10224.pp svneol=native#text/plain
tests/webtbs/tw1023.pp svneol=native#text/plain
tests/webtbs/tw10233.pp svneol=native#text/plain
tests/webtbs/tw10320.pp svneol=native#text/plain
tests/webtbs/tw10350.pp svneol=native#text/plain
tests/webtbs/tw10371.pp svneol=native#text/plain

2
compiler/arm/cgcpu.pas
View File

@ -1817,7 +1817,7 @@ unit cgcpu;
if not((def.typ=pointerdef) or
((def.typ=orddef) and
(torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,bool8bit,bool16bit,bool32bit]))) then
(torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,pasbool]))) then
ai.SetCondition(C_VC)
else
if TAiCpu(List.Last).opcode in [A_RSB,A_RSC,A_SBC,A_SUB] then

18
compiler/arm/narmcnv.pas
View File

@ -189,13 +189,23 @@ implementation
secondpass(left);
if codegenerror then
exit;
{ byte(boolean) or word(wordbool) or longint(longbool) must
be accepted for var parameters }
{ bytebool(byte) or wordbool(word) or longbool(longint) must }
{ be accepted for var parameters, and must not change the }
{ the ordinal value }
if (nf_explicit in flags) and
(left.resultdef.size=resultdef.size) and
(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) and
is_cbool(resultdef) and
not is_pasbool(left.resultdef) then
begin
location_copy(location,left.location);
location.size:=def_cgsize(resultdef);
{ change of sign? Then we have to sign/zero-extend in }
{ case of a loc_(c)register }
if (location.size<>left.location.size) and
(location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
location_force_reg(current_asmdata.CurrAsmList,location,location.size,true);
current_procinfo.CurrTrueLabel:=oldTrueLabel;
current_procinfo.CurrFalseLabel:=oldFalseLabel;
exit;
@ -267,6 +277,8 @@ implementation
location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,location.register);
if (is_cbool(resultdef)) then
cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,location.register,location.register);
current_procinfo.CurrTrueLabel:=oldTrueLabel;
current_procinfo.CurrFalseLabel:=oldFalseLabel;
end;

6
compiler/cgobj.pas
View File

@ -3276,7 +3276,10 @@ implementation
begin
{ range checking on and range checkable value? }
if not(cs_check_range in current_settings.localswitches) or
not(fromdef.typ in [orddef,enumdef]) then
not(fromdef.typ in [orddef,enumdef]) or
{ C-style booleans can't really fail range checks, }
{ all values are always valid }
is_cbool(todef) then
exit;
{$ifndef cpu64bit}
{ handle 64bit rangechecks separate for 32bit processors }
@ -3297,7 +3300,6 @@ implementation
if (todef.typ = arraydef) then
todef := tarraydef(todef).rangedef;
{ no range check if from and to are equal and are both longint/dword }
{ no range check if from and to are equal and are both longint/dword }
{ (if we have a 32bit processor) or int64/qword, since such }
{ operations can at most cause overflows (JM) }
{ Note that these checks are mostly processor independent, they only }

1
compiler/dbgdwarf.pas
View File

@ -1099,6 +1099,7 @@ implementation
]);
finish_entry;
end;
pasbool,
bool8bit :
begin
append_entry(DW_TAG_base_type,false,[

2
compiler/dbgstabs.pas
View File

@ -558,6 +558,7 @@ implementation
case def.ordtype of
uvoid :
result:=strpnew(def_stab_number(def));
pasbool,
bool8bit,
bool16bit,
bool32bit,
@ -580,6 +581,7 @@ implementation
result:=strpnew('-20;');
uwidechar :
result:=strpnew('-30;');
pasbool,
bool8bit :
result:=strpnew('-21;');
bool16bit :

8
compiler/defcmp.pas
View File

@ -152,7 +152,7 @@ implementation
(bvoid,
bint,bint,bint,bint,
bint,bint,bint,bint,
bbool,bbool,bbool,bbool,
bbool,bbool,bbool,bbool,bbool,
bchar,bchar,bint);
basedefconvertsimplicit : array[tbasedef,tbasedef] of tconverttype =
@ -236,7 +236,7 @@ implementation
end;
end;
uvoid,
bool8bit,bool16bit,bool32bit,bool64bit:
pasbool,bool8bit,bool16bit,bool32bit,bool64bit:
eq:=te_equal;
else
internalerror(200210061);
@ -1451,8 +1451,8 @@ implementation
u8bit,u16bit,u32bit,u64bit,
s8bit,s16bit,s32bit,s64bit :
is_subequal:=(torddef(def2).ordtype in [s64bit,u64bit,s32bit,u32bit,u8bit,s8bit,s16bit,u16bit]);
bool8bit,bool16bit,bool32bit,bool64bit :
is_subequal:=(torddef(def2).ordtype in [bool8bit,bool16bit,bool32bit,bool64bit]);
pasbool,bool8bit,bool16bit,bool32bit,bool64bit :
is_subequal:=(torddef(def2).ordtype in [pasbool,bool8bit,bool16bit,bool32bit,bool64bit]);
uchar :
is_subequal:=(torddef(def2).ordtype=uchar);
uwidechar :

22
compiler/defutil.pas
View File

@ -62,6 +62,12 @@ interface
{# Returns true if definition is a boolean }
function is_boolean(def : tdef) : boolean;
{# Returns true if definition is a Pascal-style boolean (1 = true, zero = false) }
function is_pasbool(def : tdef) : boolean;
{# Returns true if definition is a C-style boolean (non-zero value = true, zero = false) }
function is_cbool(def : tdef) : boolean;
{# Returns true if definition is a char
This excludes the unicode char.
@ -352,7 +358,7 @@ implementation
is_ordinal:=dt in [uchar,uwidechar,
u8bit,u16bit,u32bit,u64bit,
s8bit,s16bit,s32bit,s64bit,
bool8bit,bool16bit,bool32bit,bool64bit];
pasbool,bool8bit,bool16bit,bool32bit,bool64bit];
end;
enumdef :
is_ordinal:=true;
@ -401,6 +407,20 @@ implementation
{ true if p is a boolean }
function is_boolean(def : tdef) : boolean;
begin
result:=(def.typ=orddef) and
(torddef(def).ordtype in [pasbool,bool8bit,bool16bit,bool32bit,bool64bit]);
end;
function is_pasbool(def : tdef) : boolean;
begin
result:=(def.typ=orddef) and
(torddef(def).ordtype = pasbool);
end;
{ true if def is a C-style boolean (non-zero value = true, zero = false) }
function is_cbool(def : tdef) : boolean;
begin
result:=(def.typ=orddef) and
(torddef(def).ordtype in [bool8bit,bool16bit,bool32bit,bool64bit]);

2
compiler/htypechk.pas
View File

@ -2205,7 +2205,7 @@ implementation
variantorddef_cl: array[tordtype] of tvariantequaltype =
(tve_incompatible,tve_byte,tve_word,tve_cardinal,tve_chari64,
tve_shortint,tve_smallint,tve_longint,tve_chari64,
tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,
tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,
tve_chari64,tve_chari64,tve_dblcurrency);
{$warning fixme for 128 bit floats }
variantfloatdef_cl: array[tfloattype] of tvariantequaltype =

4
compiler/m68k/n68kadd.pas
View File

@ -358,8 +358,8 @@ implementation
otl,ofl : tasmlabel;
begin
// writeln('second_cmpboolean');
if (torddef(left.resultdef).ordtype=bool8bit) or
(torddef(right.resultdef).ordtype=bool8bit) then
if (torddef(left.resultdef).ordtype in [pasbool,bool8bit]) or
(torddef(right.resultdef).ordtype in [pasbool,bool8bit]) then
cgsize:=OS_8
else
if (torddef(left.resultdef).ordtype=bool16bit) or

25
compiler/m68k/n68kcnv.pas
View File

@ -161,15 +161,32 @@ implementation
opsize : tcgsize;
begin
secondpass(left);
{ byte(boolean) or word(wordbool) or longint(longbool) must }
{ be accepted for var parameters }
{$warning needs LOC_JUMP support, because called for bool_to_bool from ncgcnv }
{ bytebool(byte) or wordbool(word) or longbool(longint) must }
{ be accepted for var parameters, and must not change the }
{ the ordinal value }
if (nf_explicit in flags) and
(left.resultdef.size=resultdef.size) and
(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) and
is_cbool(resultdef) and
not is_pasbool(left.resultdef) then
begin
location_copy(location,left.location);
location.size:=def_cgsize(resultdef);
{ change of sign? Then we have to sign/zero-extend in }
{ case of a loc_(c)register }
if (location.size<>left.location.size) and
(location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
location_force_reg(current_asmdata.CurrAsmList,location,location.size,true);
{ ACTIVATE when loc_jump support is added
current_procinfo.CurrTrueLabel:=oldTrueLabel;
current_procinfo.CurrFalseLabel:=oldFalseLabel;
}
exit;
end;
location_reset(location,LOC_REGISTER,def_cgsize(left.resultdef));
opsize := def_cgsize(left.resultdef);
case left.location.loc of
@ -210,6 +227,8 @@ implementation
internalerror(200512182);
end;
cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,hreg1);
if (is_cbool(resultdef)) then
cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,hreg1,hreg1);
location.register := hreg1;
end;

6
compiler/nadd.pas
View File

@ -987,13 +987,15 @@ implementation
if (is_boolean(ld) and is_boolean(rd)) or
(nf_short_bool in flags) then
begin
if torddef(left.resultdef).size>torddef(right.resultdef).size then
if (torddef(left.resultdef).size>torddef(right.resultdef).size) or
(is_cbool(left.resultdef) and not is_cbool(right.resultdef)) then
begin
right:=ctypeconvnode.create_internal(right,left.resultdef);
ttypeconvnode(right).convtype:=tc_bool_2_bool;
typecheckpass(right);
end
else if torddef(left.resultdef).size<torddef(right.resultdef).size then
else if (torddef(left.resultdef).size<torddef(right.resultdef).size) or
(not is_cbool(left.resultdef) and is_cbool(right.resultdef)) then
begin
left:=ctypeconvnode.create_internal(left,right.resultdef);
ttypeconvnode(left).convtype:=tc_bool_2_bool;

36
compiler/ncgcnv.pas
View File

@ -394,6 +394,7 @@ interface
procedure tcgtypeconvnode.second_bool_to_int;
var
newsize: tcgsize;
oldTrueLabel,oldFalseLabel : tasmlabel;
begin
oldTrueLabel:=current_procinfo.CurrTrueLabel;
@ -402,12 +403,26 @@ interface
current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
secondpass(left);
location_copy(location,left.location);
{ byte(boolean) or word(wordbool) or longint(longbool) must }
{ be accepted for var parameters }
if not((nf_explicit in flags) and
(left.resultdef.size=resultdef.size) and
(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER])) then
location_force_reg(current_asmdata.CurrAsmList,location,def_cgsize(resultdef),false);
newsize:=def_cgsize(resultdef);
{ byte(bytebool) or word(wordbool) or longint(longbool) must be }
{ accepted for var parameters and assignments, and must not }
{ change the ordinal value or value location. }
{ htypechk.valid_for_assign ensures that such locations with a }
{ size<sizeof(register) cannot be LOC_CREGISTER (they otherwise }
{ could be in case of a plain assignment), and LOC_REGISTER can }
{ never be an assignment target. The remaining LOC_REGISTER/ }
{ LOC_CREGISTER locations do have to be sign/zero-extended. }
if not(nf_explicit in flags) or
(location.loc in [LOC_FLAGS,LOC_JUMP]) or
{ change of size/signedness? Then we have to sign/ }
{ zero-extend in case of a loc_(c)register }
((newsize<>left.location.size) and
((left.resultdef.size<>resultdef.size) or
not(location.loc in [LOC_REFERENCE,LOC_CREFERENCE]))) then
location_force_reg(current_asmdata.CurrAsmList,location,newsize,true)
else
{ may differ in sign, e.g. bytebool -> byte }
location.size:=newsize;
current_procinfo.CurrTrueLabel:=oldTrueLabel;
current_procinfo.CurrFalseLabel:=oldFalseLabel;
end;
@ -429,11 +444,12 @@ interface
internalerror(20060409);
location_copy(location,left.location);
end
else if (resultdef.size=left.resultdef.size) and
not(is_cbool(resultdef) xor
is_cbool(left.resultdef)) then
second_bool_to_int
else
if resultdef.size<left.resultdef.size then
second_int_to_bool
else
second_bool_to_int;
second_int_to_bool
end;

40
compiler/ncgld.pas
View File

@ -841,7 +841,10 @@ implementation
begin
current_asmdata.getjumplabel(hlabel);
cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel);
cg.a_load_const_loc(current_asmdata.CurrAsmList,1,left.location);
if is_pasbool(left.resultdef) then
cg.a_load_const_loc(current_asmdata.CurrAsmList,1,left.location)
else
cg.a_load_const_loc(current_asmdata.CurrAsmList,-1,left.location);
cg.a_jmp_always(current_asmdata.CurrAsmList,hlabel);
cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
cg.a_load_const_loc(current_asmdata.CurrAsmList,0,left.location);
@ -850,20 +853,29 @@ implementation
{$ifdef cpuflags}
LOC_FLAGS :
begin
{This can be a wordbool or longbool too, no?}
case left.location.loc of
LOC_REGISTER,LOC_CREGISTER:
cg.g_flags2reg(current_asmdata.CurrAsmList,def_cgsize(left.resultdef),right.location.resflags,left.location.register);
LOC_REFERENCE:
cg.g_flags2ref(current_asmdata.CurrAsmList,def_cgsize(left.resultdef),right.location.resflags,left.location.reference);
LOC_SUBSETREG,LOC_SUBSETREF:
begin
r:=cg.getintregister(current_asmdata.CurrAsmList,def_cgsize(left.resultdef));
cg.g_flags2reg(current_asmdata.CurrAsmList,def_cgsize(left.resultdef),right.location.resflags,r);
cg.a_load_reg_loc(current_asmdata.CurrAsmList,def_cgsize(left.resultdef),r,left.location);
if is_pasbool(left.resultdef) then
begin
case left.location.loc of
LOC_REGISTER,LOC_CREGISTER:
cg.g_flags2reg(current_asmdata.CurrAsmList,left.location.size,right.location.resflags,left.location.register);
LOC_REFERENCE:
cg.g_flags2ref(current_asmdata.CurrAsmList,left.location.size,right.location.resflags,left.location.reference);
LOC_SUBSETREG,LOC_SUBSETREF:
begin
r:=cg.getintregister(current_asmdata.CurrAsmList,left.location.size);
cg.g_flags2reg(current_asmdata.CurrAsmList,left.location.size,right.location.resflags,r);
cg.a_load_reg_loc(current_asmdata.CurrAsmList,left.location.size,r,left.location);
end;
else
internalerror(200203273);
end;
else
internalerror(200203273);
end
else
begin
r:=cg.getintregister(current_asmdata.CurrAsmList,left.location.size);
cg.g_flags2reg(current_asmdata.CurrAsmList,left.location.size,right.location.resflags,r);
cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,left.location.size,r,r);
cg.a_load_reg_loc(current_asmdata.CurrAsmList,left.location.size,r,left.location);
end;
end;
{$endif cpuflags}

4
compiler/ncgrtti.pas
View File

@ -430,7 +430,7 @@ implementation
(otUByte{otNone},
otUByte,otUWord,otULong,otUByte{otNone},
otSByte,otSWord,otSLong,otUByte{otNone},
otUByte,otUWord,otULong,otUByte,
otUByte,otSByte,otSWord,otSLong,otSByte,
otUByte,otUWord,otUByte);
begin
write_rtti_name(def);
@ -469,7 +469,7 @@ implementation
{ high }
current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(def.high.svalue));
end;
bool8bit:
pasbool:
begin
current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkBool));
dointeger;

18
compiler/ncnv.pas
View File

@ -2135,7 +2135,21 @@ implementation
else
{ no longer an ordconst with an explicit typecast }
exclude(left.flags, nf_explicit);
testrange(resultdef,tordconstnode(left).value,(nf_explicit in flags));
{ when converting from one boolean type to another, force }
{ booleans to 0/1, and byte/word/long/qwordbool to 0/-1 }
{ (Delphi-compatibile) }
if is_boolean(left.resultdef) and
is_boolean(resultdef) and
(is_cbool(left.resultdef) or
is_cbool(resultdef)) then
begin
if is_pasbool(resultdef) then
tordconstnode(left).value:=ord(tordconstnode(left).value<>0)
else
tordconstnode(left).value:=-ord(tordconstnode(left).value<>0);
end
else
testrange(resultdef,tordconstnode(left).value,(nf_explicit in flags));
left.resultdef:=resultdef;
result:=left;
left:=nil;
@ -2464,7 +2478,7 @@ implementation
{ convert to a 64bit int (only necessary for 32bit processors) (JM) }
if resultdef.size > sizeof(aint) then
begin
result := ctypeconvnode.create_internal(left,u32inttype);
result := ctypeconvnode.create_internal(left,s32inttype);
result := ctypeconvnode.create(result,resultdef);
left := nil;
firstpass(result);

24
compiler/ninl.pas
View File

@ -493,6 +493,7 @@ implementation
readfunctype:=s64currencytype;
is_real:=true;
end;
pasbool,
bool8bit,
bool16bit,
bool32bit,
@ -1508,30 +1509,41 @@ implementation
orddef :
begin
case torddef(left.resultdef).ordtype of
bool8bit,
pasbool,
uchar:
begin
{ change to byte() }
result:=ctypeconvnode.create_internal(left,u8inttype);
left:=nil;
end;
bool16bit,
uwidechar :
begin
{ change to word() }
result:=ctypeconvnode.create_internal(left,u16inttype);
left:=nil;
end;
bool8bit:
begin
{ change to shortint() }
result:=ctypeconvnode.create_internal(left,s8inttype);
left:=nil;
end;
bool16bit :
begin
{ change to smallint() }
result:=ctypeconvnode.create_internal(left,s16inttype);
left:=nil;
end;
bool32bit :
begin
{ change to dword() }
result:=ctypeconvnode.create_internal(left,u32inttype);
{ change to longint() }
result:=ctypeconvnode.create_internal(left,s32inttype);
left:=nil;
end;
bool64bit :
begin
{ change to qword() }
result:=ctypeconvnode.create_internal(left,u64inttype);
{ change to int64() }
result:=ctypeconvnode.create_internal(left,s64inttype);
left:=nil;
end;
uvoid :

1
compiler/nmat.pas
View File

@ -783,6 +783,7 @@ implementation
v:=tordconstnode(left).value;
def:=left.resultdef;
case torddef(left.resultdef).ordtype of
pasbool,
bool8bit,
bool16bit,
bool32bit,

2
compiler/nset.pas
View File

@ -247,7 +247,7 @@ implementation
}
if (
(left.resultdef.typ = orddef) and not
(torddef(left.resultdef).ordtype in [s8bit,u8bit,uchar,bool8bit])
(torddef(left.resultdef).ordtype in [s8bit,u8bit,uchar,pasbool,bool8bit])
)
or
(

2
compiler/pdecsub.pas
View File

@ -1103,7 +1103,7 @@ implementation
single_type(pd.returndef,false);
if (optoken in [_EQUAL,_GT,_LT,_GTE,_LTE]) and
((pd.returndef.typ<>orddef) or
(torddef(pd.returndef).ordtype<>bool8bit)) then
(torddef(pd.returndef).ordtype<>pasbool)) then
Message(parser_e_comparative_operator_return_boolean);
if (optoken=_ASSIGNMENT) and
equal_defs(pd.returndef,tparavarsym(pd.parast.SymList[0]).vardef) then

3
compiler/ppcgen/cgppc.pas
View File

@ -601,8 +601,7 @@ unit cgppc;
current_asmdata.getjumplabel(hl);
if not ((def.typ=pointerdef) or
((def.typ=orddef) and
(torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
bool8bit,bool16bit,bool32bit,bool64bit]))) then
(torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,pasbool]))) then
begin
if (current_settings.optimizecputype >= cpu_ppc970) or
(current_settings.cputype >= cpu_ppc970) then

4
compiler/ppcgen/ngppcadd.pas
View File

@ -177,8 +177,8 @@ implementation
firstcomplex(self);
cmpop:=false;
if (torddef(left.resultdef).ordtype=bool8bit) or
(torddef(right.resultdef).ordtype=bool8bit) then
if (torddef(left.resultdef).ordtype in [pasbool,bool8bit]) or
(torddef(right.resultdef).ordtype in [pasbool,bool8bit]) then
cgsize:=OS_8
else
if (torddef(left.resultdef).ordtype=bool16bit) or

64
compiler/ppcgen/ngppccnv.pas
View File

@ -85,20 +85,33 @@ implementation
if codegenerror then
exit;
{ byte(boolean) or word(wordbool) or longint(longbool) must }
{ be accepted for var parameters }
{ bytebool(byte) or wordbool(word) or longbool(longint) must }
{ be accepted for var parameters, and must not change the }
{ the ordinal value }
if (nf_explicit in flags) and
(left.resultdef.size=resultdef.size) and
(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) and
is_cbool(resultdef) and
not is_pasbool(left.resultdef) then
begin
location_copy(location,left.location);
location.size:=def_cgsize(resultdef);
{ change of sign? Then we have to sign/zero-extend in }
{ case of a loc_(c)register }
if (location.size<>left.location.size) and
(location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
location_force_reg(current_asmdata.CurrAsmList,location,location.size,true);
current_procinfo.CurrTrueLabel:=oldTrueLabel;
current_procinfo.CurrFalseLabel:=oldFalseLabel;
location_copy(location,left.location);
exit;
end;
location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
opsize := def_cgsize(left.resultdef);
{$ifndef cpu64bit}
if (opsize in [OS_64,OS_S64]) then
opsize:=OS_32;
{$endif cpu64bit}
case left.location.loc of
LOC_CREFERENCE,LOC_REFERENCE,LOC_REGISTER,LOC_CREGISTER :
begin
@ -132,21 +145,39 @@ implementation
hreg1 := left.location.register;
end;
hreg2 := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_SUBIC,hreg2,hreg1,1));
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBFE,hreg1,hreg2,hreg1));
if not(is_cbool(resultdef)) then
begin
{ hreg2:=hreg1-1; carry:=hreg1=0 }
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_SUBIC,hreg2,hreg1,1));
{ hreg1:=hreg1-hreg2+carry (= hreg1-(hreg1-1)-carry) }
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBFE,hreg1,hreg2,hreg1));
end
else
begin
{ carry:=hreg1<>0 }
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_SUBFIC,hreg2,hreg1,0));
{ hreg1:=hreg1-hreg1-carry }
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBFE,hreg1,hreg1,hreg1));
end;
end;
LOC_FLAGS :
begin
hreg1:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
resflags:=left.location.resflags;
cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,hreg1);
if (is_cbool(resultdef)) then
cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,hreg1,hreg1);
end;
LOC_JUMP :
begin
hreg1:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
current_asmdata.getjumplabel(hlabel);
cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel);
cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,1,hreg1);
if not(is_cbool(resultdef)) then
cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,1,hreg1)
else
cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,-1,hreg1);
cg.a_jmp_always(current_asmdata.CurrAsmList,hlabel);
cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,0,hreg1);
@ -155,9 +186,24 @@ implementation
else
internalerror(10062);
end;
location.register := hreg1;
{$ifndef cpu64bit}
if (location.size in [OS_64,OS_S64]) then
begin
location.register64.reglo:=hreg1;
location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
if (is_cbool(resultdef)) then
{ reglo is either 0 or -1 -> reghi has to become the same }
cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,location.register64.reglo,location.register64.reghi)
else
{ unsigned }
cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,location.register64.reghi);
end
else
{$endif cpu64bit}
location.register:=hreg1;
current_procinfo.CurrTrueLabel:=oldTrueLabel;
current_procinfo.CurrFalseLabel:=oldFalseLabel;
end;
end.
end.

2
compiler/ppu.pas
View File

@ -43,7 +43,7 @@ type
{$endif Test_Double_checksum}
const
CurrentPPUVersion = 89;
CurrentPPUVersion = 90;
{ buffer sizes }
maxentrysize = 1024;

13
compiler/psystem.pas
View File

@ -132,10 +132,11 @@ implementation
s32inttype:=torddef.create(s32bit,int64(low(longint)),int64(high(longint)));
u64inttype:=torddef.create(u64bit,low(qword),high(qword));
s64inttype:=torddef.create(s64bit,low(int64),high(int64));
booltype:=torddef.create(bool8bit,0,1);
bool16type:=torddef.create(bool16bit,0,1);
bool32type:=torddef.create(bool32bit,0,1);
bool64type:=torddef.create(bool64bit,0,1);
booltype:=torddef.create(pasbool,0,1);
bool8type:=torddef.create(bool8bit,low(int64),high(int64));
bool16type:=torddef.create(bool16bit,low(int64),high(int64));
bool32type:=torddef.create(bool32bit,low(int64),high(int64));
bool64type:=torddef.create(bool64bit,low(int64),high(int64));
cchartype:=torddef.create(uchar,0,255);
cwidechartype:=torddef.create(uwidechar,0,65535);
cshortstringtype:=tstringdef.createshort(255);
@ -250,7 +251,7 @@ implementation
addtype('UnicodeString',cunicodestringtype);
addtype('OpenString',openshortstringtype);
addtype('Boolean',booltype);
addtype('ByteBool',booltype);
addtype('ByteBool',bool8type);
addtype('WordBool',bool16type);
addtype('LongBool',bool32type);
addtype('QWordBool',bool64type);
@ -290,6 +291,7 @@ implementation
addtype('$unicodestring',cwidestringtype);
addtype('$openshortstring',openshortstringtype);
addtype('$boolean',booltype);
addtype('$boolean8',bool8type);
addtype('$boolean16',bool16type);
addtype('$boolean32',bool32type);
addtype('$boolean64',bool64type);
@ -386,6 +388,7 @@ implementation
loadtype('s80real',s80floattype);
loadtype('s64currency',s64currencytype);
loadtype('boolean',booltype);
loadtype('boolean8',bool8type);
loadtype('boolean16',bool16type);
loadtype('boolean32',bool32type);
loadtype('boolean64',bool64type);

4
compiler/ptconst.pas
View File

@ -184,7 +184,11 @@ implementation
begin
n:=comp_expr(true);
{ for C-style booleans, true=-1 and false=0) }
if is_cbool(def) then
inserttypeconv(n,def);
case def.ordtype of
pasbool,
bool8bit :
begin
if is_constboolnode(n) then

4
compiler/ptype.pas
View File

@ -510,7 +510,7 @@ implementation
def:=torddef.create(uchar,lv,hv)
else
if is_boolean(pt1.resultdef) then
def:=torddef.create(bool8bit,lv,hv)
def:=torddef.create(pasbool,lv,hv)
else if is_signed(pt1.resultdef) then
def:=torddef.create(range_to_basetype(lv,hv),lv,hv)
else
@ -614,7 +614,7 @@ implementation
{$ifdef cpu64bit}
u32bit,s64bit,
{$endif cpu64bit}
bool8bit,bool16bit,bool32bit,bool64bit,
pasbool,bool8bit,bool16bit,bool32bit,bool64bit,
uwidechar] then
begin
lowval:=torddef(def).low;

2
compiler/sparc/cgcpu.pas
View File

@ -1010,7 +1010,7 @@ implementation
begin
if not((def.typ=pointerdef) or
((def.typ=orddef) and
(torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,bool8bit,bool16bit,bool32bit]))) then
(torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,pasbool]))) then
begin
ai:=TAiCpu.Op_sym(A_Bxx,hl);
ai.SetCondition(C_NO);

67
compiler/sparc/ncpucnv.pas
View File

@ -233,17 +233,27 @@ implementation
if codegenerror then
exit;
{ byte(boolean) or word(wordbool) or longint(longbool) must }
{ be accepted for var parameters }
if (nf_explicit in flags)and
(left.resultdef.size=resultdef.size)and
(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
begin
location_copy(location,left.location);
current_procinfo.CurrTrueLabel:=oldTrueLabel;
current_procinfo.CurrFalseLabel:=oldFalseLabel;
exit;
end;
{ bytebool(byte) or wordbool(word) or longbool(longint) must }
{ be accepted for var parameters, and must not change the }
{ the ordinal value }
if (nf_explicit in flags) and
(left.resultdef.size=resultdef.size) and
not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) and
is_cbool(resultdef) and
not is_pasbool(left.resultdef) then
begin
location_copy(location,left.location);
location.size:=def_cgsize(resultdef);
{ change of sign? Then we have to sign/zero-extend in }
{ case of a loc_(c)register }
if (location.size<>left.location.size) and
(location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
location_force_reg(current_asmdata.CurrAsmList,location,location.size,true);
current_procinfo.CurrTrueLabel:=oldTrueLabel;
current_procinfo.CurrFalseLabel:=oldFalseLabel;
exit;
end;
location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
opsize:=def_cgsize(left.resultdef);
case left.location.loc of
@ -260,27 +270,35 @@ implementation
if left.location.size in [OS_64,OS_S64] then
begin
hreg1:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,hreg2,tregister(succ(longint(hreg2))),hreg1);
cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,hreg2,left.location.register64.reghi,hreg1);
hreg2:=hreg1;
opsize:=OS_32;
end;
{$endif cpu64bit}
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBCC,NR_G0,hreg2,NR_G0));
hreg1:=cg.getintregister(current_asmdata.CurrAsmList,opsize);
current_asmdata.CurrAsmList.concat(taicpu.op_reg_const_reg(A_ADDX,NR_G0,0,hreg1));
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBCC,NR_G0,hreg2,NR_G0));
if is_pasbool(resultdef) then
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ADDX,NR_G0,NR_G0,hreg1))
else
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBX,NR_G0,NR_G0,hreg1));
end;
LOC_FLAGS :
begin
hreg1:=cg.GetIntRegister(current_asmdata.CurrAsmList,location.size);
resflags:=left.location.resflags;
cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,hreg1);
if (is_cbool(resultdef)) then
cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,hreg1,hreg1);
end;
LOC_JUMP :
begin
hreg1:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
current_asmdata.getjumplabel(hlabel);
cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel);
cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,1,hreg1);
if not(is_cbool(resultdef)) then
cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,1,hreg1)
else
cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,-1,hreg1);
cg.a_jmp_always(current_asmdata.CurrAsmList,hlabel);
cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,0,hreg1);
@ -289,10 +307,21 @@ implementation
else
internalerror(10062);
end;
location.register:=hreg1;
if location.size in [OS_64, OS_S64] then
internalerror(200408241);
{$ifndef cpu64bit}
if (location.size in [OS_64,OS_S64]) then
begin
location.register64.reglo:=hreg1;
location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
if (is_cbool(resultdef)) then
{ reglo is either 0 or -1 -> reghi has to become the same }
cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,location.register64.reglo,location.register64.reghi)
else
{ unsigned }
cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,location.register64.reghi);
end
else
{$endif cpu64bit}
location.register:=hreg1;
current_procinfo.CurrTrueLabel:=oldTrueLabel;
current_procinfo.CurrFalseLabel:=oldFalseLabel;

2
compiler/symconst.pas
View File

@ -177,7 +177,7 @@ type
uvoid,
u8bit,u16bit,u32bit,u64bit,
s8bit,s16bit,s32bit,s64bit,
bool8bit,bool16bit,bool32bit,bool64bit,
pasbool,bool8bit,bool16bit,bool32bit,bool64bit,
uchar,uwidechar,scurrency
);

9
compiler/symdef.pas
View File

@ -576,6 +576,7 @@ interface
cchartype, { Char }
cwidechartype, { WideChar }
booltype, { boolean type }
bool8type,
bool16type,
bool32type,
bool64type, { implement me }
@ -1510,7 +1511,7 @@ implementation
0,
1,2,4,8,
1,2,4,8,
1,2,4,8,
1,1,2,4,8,
1,2,8
);
begin
@ -1555,7 +1556,7 @@ implementation
varUndefined,
varbyte,varqword,varlongword,varqword,
varshortint,varsmallint,varinteger,varint64,
varboolean,varboolean,varUndefined,varUndefined,
varboolean,varboolean,varboolean,varUndefined,varUndefined,
varUndefined,varUndefined,varCurrency);
begin
result:=basetype2vardef[ordtype];
@ -1584,7 +1585,7 @@ implementation
'untyped',
'Byte','Word','DWord','QWord',
'ShortInt','SmallInt','LongInt','Int64',
'Boolean','WordBool','LongBool','QWordBool',
'Boolean','ByteBool','WordBool','LongBool','QWordBool',
'Char','WideChar','Currency');
begin
@ -3367,7 +3368,7 @@ implementation
'',
'Uc','Us','Ui','Us',
'Sc','s','i','x',
'b','b','b','b',
'b','b','b','b','b',
'c','w','x');
var

3
compiler/x86/cgx86.pas
View File

@ -2053,8 +2053,7 @@ unit cgx86;
current_asmdata.getjumplabel(hl);
if not ((def.typ=pointerdef) or
((def.typ=orddef) and
(torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
bool8bit,bool16bit,bool32bit,bool64bit]))) then
(torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,pasbool]))) then
cond:=C_NO
else
cond:=C_NB;

62
compiler/x86/nx86cnv.pas
View File

@ -85,6 +85,9 @@ implementation
procedure tx86typeconvnode.second_int_to_bool;
var
{$ifndef cpu64bit}
hreg2,
{$endif cpu64bit}
hregister : tregister;
{$ifndef cpu64bit}
href : treference;
@ -99,13 +102,22 @@ implementation
secondpass(left);
if codegenerror then
exit;
{ byte(boolean) or word(wordbool) or longint(longbool) must }
{ be accepted for var parameters }
{ bytebool(byte) or wordbool(word) or longbool(longint) must }
{ be accepted for var parameters, and must not change the }
{ the ordinal value }
if (nf_explicit in flags) and
(left.resultdef.size=resultdef.size) and
(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) and
is_cbool(resultdef) and
not is_pasbool(left.resultdef) then
begin
location_copy(location,left.location);
location.size:=def_cgsize(resultdef);
{ change of sign? Then we have to sign/zero-extend in }
{ case of a loc_(c)register }
if (location.size<>left.location.size) and
(location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
location_force_reg(current_asmdata.CurrAsmList,location,location.size,true);
current_procinfo.CurrTrueLabel:=oldTrueLabel;
current_procinfo.CurrFalseLabel:=oldFalseLabel;
exit;
@ -156,23 +168,51 @@ implementation
end;
LOC_JUMP :
begin
hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
current_asmdata.getjumplabel(hlabel);
cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel);
cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,1,hregister);
if not(is_cbool(resultdef)) then
cg.a_load_const_reg(current_asmdata.CurrAsmList,location.size,1,location.register)
else
cg.a_load_const_reg(current_asmdata.CurrAsmList,location.size,-1,location.register);
cg.a_jmp_always(current_asmdata.CurrAsmList,hlabel);
cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,0,hregister);
cg.a_load_const_reg(current_asmdata.CurrAsmList,location.size,0,location.register);
cg.a_label(current_asmdata.CurrAsmList,hlabel);
cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_INT,hregister,hregister);
end;
else
internalerror(10062);
end;
{ load flags to register }
location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,location.register);
if (left.location.loc<>LOC_JUMP) then
begin
{ load flags to register }
location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
{$ifndef cpu64bit}
if (location.size in [OS_64,OS_S64]) then
begin
hreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
cg.g_flags2reg(current_asmdata.CurrAsmList,OS_32,resflags,hreg2);
if (is_cbool(resultdef)) then
cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,OS_32,hreg2,hreg2);
location.register64.reglo:=hreg2;
location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
if (is_cbool(resultdef)) then
{ reglo is either 0 or -1 -> reghi has to become the same }
cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,location.register64.reglo,location.register64.reghi)
else
{ unsigned }
cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,location.register64.reghi);
end
else
{$endif cpu64bit}
begin
location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,location.register);
if (is_cbool(resultdef)) then
cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,location.register,location.register);
end
end;
current_procinfo.CurrTrueLabel:=oldTrueLabel;
current_procinfo.CurrFalseLabel:=oldFalseLabel;
end;

2
rtl/powerpc/int64p.inc
View File

@ -152,7 +152,7 @@
or. r10,r3,r5 // are both msw's 0?
mulhwu r8,r4,r6 // msw of product of lsw's
subi r0,r7,1 // if no overflowcheck, r0 := $ffffffff, else r0 := 0;
not r0,r7 // if no overflowcheck, r0 := $ffffffff, else r0 := 0;
beq .LDone // if both msw's are zero, skip cross products
mullw r9,r4,r5 // lsw of first cross-product
cntlzw r11,r3 // count leading zeroes of msw1

6
rtl/unix/tthread.inc
View File

@ -247,7 +247,7 @@ begin
if FThreadID = GetCurrentThreadID then
begin
if not FSuspended and
(InterLockedExchange(longint(FSuspended),ord(true)) = ord(false)) then
(InterLockedExchange(longint(FSuspended),longint(longbool(true))) = longint(longbool(false))) then
CurrentTM.SemaphoreWait(FSem)
end
else
@ -264,7 +264,9 @@ begin
if (not FSuspendedExternal) then
begin
if FSuspended and
(InterLockedExchange(longint(FSuspended),ord(false)) = ord(true)) then
{ don't compare with ord(true) or ord(longbool(true)), }
{ becaue a longbool's "true" value is anyting <> false }
(InterLockedExchange(longint(FSuspended),longint(false)) <> longint(longbool(false))) then
begin
WRITE_DEBUG('resuming ',ptruint(self));
CurrentTM.SemaphorePost(FSem);

159
tests/test/cg/taddbool.pp
View File

@ -25,7 +25,8 @@ end;
procedure BoolTestAnd;
var
bb1, bb2: boolean;
b1, b2: boolean;
bb1, bb2: bytebool;
wb1, wb2: wordbool;
lb1, lb2: longbool;
result : boolean;
@ -33,6 +34,36 @@ begin
result := true;
{ BOOLEAN AND BOOLEAN }
Write('boolean AND boolean test...');
b1 := true;
b2 := false;
if b1 and b2 then
result := false;
if b2 then
result := false;
b1 := false;
b2 := false;
if b1 and b2 then
result := false;
b1 := b1 and b2;
if b1 then
result := false;
if b1 and FALSE then
result := false;
b1 := true;
b2 := true;
if b1 and b2 then
begin
if result then
WriteLn('Success.')
else
Fail;
end
else
Fail;
{ BYTEBOOL AND BYTEBOOL }
Write('bytebool AND bytebool test...');
bb1 := true;
bb2 := false;
if bb1 and bb2 then
@ -129,7 +160,8 @@ end;
procedure BoolTestOr;
var
bb1, bb2: boolean;
b1, b2: boolean;
bb1, bb2: bytebool;
wb1, wb2: wordbool;
lb1, lb2: longbool;
result : boolean;
@ -137,6 +169,36 @@ begin
result := false;
{ BOOLEAN AND BOOLEAN }
Write('boolean OR boolean test...');
b1 := true;
b2 := false;
if b1 or b2 then
result := true;
b1 := false;
b2 := false;
if b1 or b2 then
result := false;
b1 := b1 or b2;
if b1 then
result := false;
if b1 or FALSE then
result := false;
b1 := true;
b2 := true;
if b1 or b2 then
begin
if result then
WriteLn('Success.')
else
Fail;
end
else
Fail;
{ BYTEBOOL AND BYTEBOOL }
Write('bytebool OR bytebool test...');
bb1 := true;
bb2 := false;
if bb1 or bb2 then
@ -231,7 +293,8 @@ end;
Procedure BoolTestXor;
var
bb1, bb2: boolean;
b1, b2: boolean;
bb1, bb2: bytebool;
wb1, wb2: wordbool;
lb1, lb2: longbool;
result : boolean;
@ -239,6 +302,38 @@ begin
result := false;
{ BOOLEAN XOR BOOLEAN }
Write('boolean XOR boolean test...');
b1 := true;
b2 := false;
if b1 xor b2 then
result := true;
b1 := false;
b2 := false;
if b1 xor b2 then
result := false;
b1 := b1 xor b2;
if b1 then
result := false;
if b1 xor FALSE then
result := false;
b1 := true;
b2 := true;
if b1 xor b2 then
begin
Fail;
end
else
begin
if result then
WriteLn('Success.')
else
Fail;
end;
{ BYTEBOOL XOR BYTEBOOL }
Write('bytebool XOR bytebool test...');
bb1 := true;
bb2 := false;
if bb1 xor bb2 then
@ -338,7 +433,8 @@ end;
Procedure BoolTestEqual;
var
bb1, bb2, bb3: boolean;
b1, b2, b3: boolean;
bb1, bb2, bb3: bytebool;
wb1, wb2, wb3: wordbool;
lb1, lb2, lb3: longbool;
result : boolean;
@ -348,6 +444,30 @@ Begin
{ BOOLEAN = BOOLEAN }
result := true;
Write('boolean = boolean test...');
b1 := true;
b2 := true;
b3 := false;
b1 := (b1 = b2) and (b2 and false);
if b1 then
result := false;
b1 := true;
b2 := true;
b3 := false;
b1 := (b1 = b2) and (b2 and true);
if not b1 then
result := false;
if b1 = b2 then
begin
if result then
WriteLn('Success.')
else
Fail;
end
else
Fail;
{ BYTEBOOL = BYTEBOOL }
result := true;
Write('bytebool = bytebool test...');
bb1 := true;
bb2 := true;
bb3 := false;
@ -440,7 +560,8 @@ end;
Procedure BoolTestNotEqual;
var
bb1, bb2, bb3: boolean;
b1, b2, b3: boolean;
bb1, bb2, bb3: bytebool;
wb1, wb2, wb3: wordbool;
lb1, lb2, lb3: longbool;
result : boolean;
@ -448,6 +569,34 @@ Begin
{ BOOLEAN <> BOOLEAN }
result := true;
Write('boolean <> boolean test...');
b1 := true;
b2 := true;
b3 := false;
b1 := (b1 <> b2) and (b2 <> false);
if b1 then
result := false;
b1 := true;
b2 := true;
b3 := false;
b1 := (b1 <> b2) and (b2 <> true);
if b1 then
result := false;
b1 := false;
b2 := false;
if b1 <> b2 then
begin
Fail;
end
else
begin
if result then
WriteLn('Success.')
else
Fail;
end;
{ BYTEBOOL <> BYTEBOOL }
result := true;
Write('bytebool <> bytebool test...');
bb1 := true;
bb2 := true;
bb3 := false;

161
tests/test/cg/tcnvint1.pp
View File

@ -25,9 +25,11 @@ var
{$ifndef tp}
toint64 : int64;
{$endif}
b1 : boolean;
bb1 : bytebool;
wb1 : wordbool;
lb1 : longbool;
b2 : boolean;
bb2 : bytebool;
wb2 : wordbool;
lb2 : longbool;
@ -35,40 +37,70 @@ begin
{ left : LOC_REGISTER }
{ from : LOC_REFERENCE/LOC_REGISTER }
WriteLn('Testing LOC_REFERENCE...');
bb1 := TRUE;
tobyte := byte(bb1);
b1 := TRUE;
tobyte := byte(b1);
WriteLn('boolean->byte : value should be 1...',tobyte);
if tobyte <> 1 then
halt(1);
b1 := FALSE;
tobyte := byte(b1);
WriteLn('boolean->byte : value should be 0...',tobyte);
if tobyte <> 0 then
halt(1);
b1 := TRUE;
toword := word(b1);
WriteLn('boolean->word : value should be 1...',toword);
if toword <> 1 then
halt(1);
b1 := FALSE;
toword := word(b1);
WriteLn('boolean->word : value should be 0...',toword);
if toword <> 0 then
halt(1);
b1 := TRUE;
tolong := longint(b1);
WriteLn('boolean->longint : value should be 1...',tolong);
if tolong <> 1 then
halt(1);
b1 := FALSE;
tolong := longint(b1);
WriteLn('boolean->longint : value should be 0...',tolong);
if tolong <> 0 then
halt(1);
bb1 := TRUE;
tobyte := byte(bb1);
WriteLn('bytebool->byte : value should be 255...',tobyte);
if tobyte <> 255 then
halt(1);
bb1 := FALSE;
tobyte := byte(bb1);
WriteLn('boolean->byte : value should be 0...',tobyte);
WriteLn('bytebool->byte : value should be 0...',tobyte);
if tobyte <> 0 then
halt(1);
bb1 := TRUE;
toword := word(bb1);
WriteLn('boolean->word : value should be 1...',toword);
if toword <> 1 then
WriteLn('bytebool->word : value should be 65535...',toword);
if toword <> 65535 then
halt(1);
bb1 := FALSE;
toword := word(bb1);
WriteLn('boolean->word : value should be 0...',toword);
WriteLn('bytebool->word : value should be 0...',toword);
if toword <> 0 then
halt(1);
bb1 := TRUE;
tolong := longint(bb1);
WriteLn('boolean->longint : value should be 1...',tolong);
if tolong <> 1 then
WriteLn('bytebool->longint : value should be -1...',tolong);
if tolong <> -1 then
halt(1);
bb1 := FALSE;
tolong := longint(bb1);
WriteLn('boolean->longint : value should be 0...',tolong);
WriteLn('bytebool->longint : value should be 0...',tolong);
if tolong <> 0 then
halt(1);
wb1 := TRUE;
tobyte := byte(wb1);
WriteLn('wordbool->byte : value should be 1...',tobyte);
if tobyte <> 1 then
WriteLn('wordbool->byte : value should be 255...',tobyte);
if tobyte <> 255 then
halt(1);
wb1 := FALSE;
tobyte := byte(wb1);
@ -77,8 +109,8 @@ begin
halt(1);
wb1 := TRUE;
toword := word(wb1);
WriteLn('wordbool->word : value should be 1...',toword);
if toword <> 1 then
WriteLn('wordbool->word : value should be 65535...',toword);
if toword <> 65535 then
halt(1);
wb1 := FALSE;
toword := word(wb1);
@ -87,8 +119,8 @@ begin
halt(1);
wb1 := TRUE;
tolong := longint(wb1);
WriteLn('wordbool->longint : value should be 1...',tolong);
if tolong <> 1 then
WriteLn('wordbool->longint : value should be -1...',tolong);
if tolong <> -1 then
halt(1);
wb1 := FALSE;
tolong := longint(wb1);
@ -96,20 +128,30 @@ begin
if tolong <> 0 then
halt(1);
{$ifndef tp}
bb1 := TRUE;
toint64 :=int64(bb1);
b1 := TRUE;
toint64 :=int64(b1);
WriteLn('boolean->int64 : value should be 1...',toint64);
if toint64 <> 1 then
halt(1);
b1 := FALSE;
toint64 :=int64(b1);
WriteLn('boolean->int64 : value should be 0...',toint64);
if toint64 <> 0 then
halt(1);
bb1 := TRUE;
toint64 :=int64(bb1);
WriteLn('bytebool->int64 : value should be -1...',toint64);
if toint64 <> -1 then
halt(1);
bb1 := FALSE;
toint64 :=int64(bb1);
WriteLn('boolean->int64 : value should be 0...',toint64);
WriteLn('bytebool->int64 : value should be 0...',toint64);
if toint64 <> 0 then
halt(1);
wb1 := TRUE;
toint64 :=int64(wb1);
WriteLn('wordbool->int64 : value should be 1...',toint64);
if toint64 <> 1 then
WriteLn('wordbool->int64 : value should be -1...',toint64);
if toint64 <> -1 then
halt(1);
wb1 := FALSE;
toint64 :=int64(wb1);
@ -119,8 +161,8 @@ begin
{$endif}
lb1 := TRUE;
tobyte := byte(lb1);
WriteLn('longbool->byte : value should be 1...',tobyte);
if tobyte <> 1 then
WriteLn('longbool->byte : value should be 255...',tobyte);
if tobyte <> 255 then
halt(1);
lb1 := FALSE;
tobyte := byte(lb1);
@ -129,8 +171,8 @@ begin
halt(1);
lb1 := TRUE;
toword := word(lb1);
WriteLn('longbool->word : value should be 1...',toword);
if toword <> 1 then
WriteLn('longbool->word : value should be 65535...',toword);
if toword <> 65535 then
halt(1);
lb1 := FALSE;
toword := word(lb1);
@ -139,8 +181,8 @@ begin
halt(1);
lb1 := TRUE;
tolong := longint(lb1);
WriteLn('longbool->longint : value should be 1...',tolong);
if tolong <> 1 then
WriteLn('longbool->longint : value should be -1...',tolong);
if tolong <> -1 then
halt(1);
lb1 := FALSE;
tolong := longint(lb1);
@ -149,34 +191,65 @@ begin
halt(1);
{ left : LOC_REGISTER }
{ from : LOC_REFERENCE }
wb1 := TRUE;
b2 := wb1;
WriteLn('wordbool->boolean : value should be TRUE...',b2);
if not b2 then
halt(1);
wb1 := FALSE;
b2 := wb1;
WriteLn('wordbool->boolean : value should be FALSE...',b2);
if b2 then
halt(1);
lb1 := TRUE;
b2 := lb1;
WriteLn('longbool->boolean : value should be TRUE...',b2);
if not b2 then
halt(1);
lb1 := FALSE;
b2 := lb1;
WriteLn('longbool->boolean : value should be FALSE...',b2);
if b2 then
halt(1);
wb1 := TRUE;
bb2 := wb1;
WriteLn('wordbool->boolean : value should be TRUE...',bb2);
WriteLn('wordbool->bytebool : value should be TRUE...',bb2);
if not bb2 then
halt(1);
wb1 := FALSE;
bb2 := wb1;
WriteLn('wordbool->boolean : value should be FALSE...',bb2);
WriteLn('wordbool->bytebool : value should be FALSE...',bb2);
if bb2 then
halt(1);
lb1 := TRUE;
bb2 := lb1;
WriteLn('longbool->boolean : value should be TRUE...',bb2);
WriteLn('longbool->bytebool : value should be TRUE...',bb2);
if not bb2 then
halt(1);
lb1 := FALSE;
bb2 := lb1;
WriteLn('longbool->boolean : value should be FALSE...',bb2);
WriteLn('longbool->bytebool : value should be FALSE...',bb2);
if bb2 then
halt(1);
b1 := TRUE;
lb2 := b1;
WriteLn('boolean->longbool : value should be TRUE...',lb2);
if not lb2 then
halt(1);
b1 := FALSE;
lb2 := b1;
WriteLn('boolean->longbool : value should be FALSE...',lb2);
if lb2 then
halt(1);
bb1 := TRUE;
lb2 := bb1;
WriteLn('boolean->longbool : value should be TRUE...',lb2);
WriteLn('bytebool->longbool : value should be TRUE...',lb2);
if not lb2 then
halt(1);
bb1 := FALSE;
lb2 := bb1;
WriteLn('boolean->longbool : value should be FALSE...',lb2);
WriteLn('bytebool->longbool : value should be FALSE...',lb2);
if lb2 then
halt(1);
{ left : LOC_REGISTER }
@ -237,61 +310,61 @@ begin
WriteLn('Testing LOC_FLAGS...');
wb1 := TRUE;
bb1 := FALSE;
bb1 := (wb1 > bb1);
bb1 := (wb1 <> bb1);
WriteLn('Value should be TRUE...',bb1);
if not bb1 then
halt(1);
wb1 := FALSE;
bb1 := FALSE;
bb1 := (wb1 > bb1);
bb1 := (wb1 <> bb1);
WriteLn('Value should be FALSE...',bb1);
if bb1 then
halt(1);
lb1 := TRUE;
bb1 := FALSE;
bb1 := (bb1 > lb1);
bb1 := (bb1 = lb1);
WriteLn('Value should be FALSE...',bb1);
if bb1 then
halt(1);
lb1 := FALSE;
bb1 := TRUE;
bb1 := (bb1 > lb1);
bb1 := (bb1 <> lb1);
WriteLn('Value should be TRUE...',bb1);
if not bb1 then
halt(1);
lb1 := TRUE;
bb1 := FALSE;
wb1 := (bb1 > lb1);
wb1 := (bb1 = lb1);
WriteLn('Value should be FALSE...',wb1);
if wb1 then
halt(1);
lb1 := FALSE;
lb1 := TRUE;
bb1 := TRUE;
wb1 := (bb1 > lb1);
wb1 := (bb1 = lb1);
WriteLn('Value should be TRUE...',wb1);
if not wb1 then
halt(1);
lb1 := TRUE;
bb1 := FALSE;
lb1 := (bb1 > lb1);
lb1 := (bb1 = lb1);
WriteLn('Value should be FALSE...',lb1);
if lb1 then
halt(1);
lb1 := FALSE;
bb1 := TRUE;
lb1 := (bb1 > lb1);
bb1 := FALSE;
lb1 := (bb1 = lb1);
WriteLn('Value should be TRUE...',lb1);
if not lb1 then
halt(1);
bb1 := TRUE;
bb2 := FALSE;
lb1 := (bb1 > bb2);
lb1 := (bb1 <> bb2);
WriteLn('Value should be TRUE...',lb1);
if not lb1 then
halt(1);
bb1 := FALSE;
bb2 := TRUE;
lb1 := (bb1 > bb2);
lb1 := (bb1 = bb2);
WriteLn('Value should be FALSE...',lb1);
if lb1 then
halt(1);

8
tests/test/cg/tcnvint2.pp
View File

@ -103,8 +103,6 @@ begin
fromword := $1000;
lb1 := longbool(fromword);
Test('word -> longbool : Value should be TRUE...',lb1);
if not lb1 then
failed:=true;
{ ------------------------------------------------------------ }
{ WARNING : This test fails under Borland Pascal v7, but }
{ works under Delphi 3.0 (normally it should give TRUE). }
@ -161,9 +159,8 @@ begin
lb1 := longbool(getint64_2);
Test('int64 -> longbool : Value should be TRUE...',lb1);
{$endif}
(* CURRENTLY NEVER GOES INTO THE LOC_FLAGS LOCATION!
{ left : LOC_FLAGS }
Test('Testing LOC_FLAGS...');
Writeln('Testing LOC_FLAGS...');
frombyte := 10;
fromword := 2;
bb1 := bytebool(frombyte > fromword);
@ -183,14 +180,13 @@ begin
fromword := $1000;
fromlong := $0100;
lb1 := longbool(fromlong > fromword);
Test('Value should be FALSE...',lb1);
Test('Value should be TRUE...',not lb1);
{$ifndef tp}
fromint64 := $10000000;
fromlong := $02;
lb1 := longbool(fromint64 > fromlong);
Test('Value should be TRUE...',lb1);
{$endif}
*)
if failed then
begin
Writeln('Some tests failed!');

20
tests/test/cg/tnot.pp
View File

@ -41,11 +41,16 @@ begin
getintres := $7F7F;
end;
function getbyteboolval : boolean;
function getbyteboolval : bytebool;
begin
getbyteboolval := TRUE;
end;
function getbooleanval : boolean;
begin
getbooleanval := TRUE;
end;
procedure test(value, required: longint);
begin
if value <> required then
@ -62,9 +67,11 @@ end;
var
longres : longint;
intres : smallint;
booleanval : boolean;
byteboolval : bytebool;
wordboolval : wordbool;
longboolval : longbool;
booleanres : boolean;
byteboolres : bytebool;
wordboolres : wordbool;
longboolres : longbool;
@ -96,6 +103,11 @@ Begin
{ 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...');
@ -121,6 +133,12 @@ Begin
{ 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));

30
tests/webtbs/tw10233.pp Normal file
View File

@ -0,0 +1,30 @@
var
i: Byte;
w: word;
l: cardinal;
g: qword;
begin
i := 128;
if Byte(ByteBool(i))<>128 then
halt(1);
w := 32768;
if Word(WordBool(w))<>32768 then
halt(2);
l := $80000000;
if Cardinal(LongBool(l))<>$80000000 then
halt(3);
g := qword($8000000000000000);
if qword(qwordBool(g))<>qword($8000000000000000) then
halt(4);
if Byte(ByteBool(w))<>high(byte) then
halt(5);
if Word(WordBool(l))<>high(word) then
halt(6);
l := $80000000;
if Cardinal(LongBool(g))<>high(cardinal) then
halt(7);
g := qword($8000000000000000);
if qword(qwordBool(i))<>high(qword) then
halt(8);
end.