From 8349cde7db0841610472120f81242e3274535aa4 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Thu, 24 Jan 2008 21:30:55 +0000 Subject: [PATCH] * changed byte/word/longbool to be Delphi-compatible (+ similar changes 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 - --- .gitattributes | 1 + compiler/arm/cgcpu.pas | 2 +- compiler/arm/narmcnv.pas | 18 +++- compiler/cgobj.pas | 6 +- compiler/dbgdwarf.pas | 1 + compiler/dbgstabs.pas | 2 + compiler/defcmp.pas | 8 +- compiler/defutil.pas | 22 ++++- compiler/htypechk.pas | 2 +- compiler/m68k/n68kadd.pas | 4 +- compiler/m68k/n68kcnv.pas | 25 +++++- compiler/nadd.pas | 6 +- compiler/ncgcnv.pas | 36 +++++--- compiler/ncgld.pas | 40 ++++++--- compiler/ncgrtti.pas | 4 +- compiler/ncnv.pas | 18 +++- compiler/ninl.pas | 24 ++++-- compiler/nmat.pas | 1 + compiler/nset.pas | 2 +- compiler/pdecsub.pas | 2 +- compiler/ppcgen/cgppc.pas | 3 +- compiler/ppcgen/ngppcadd.pas | 4 +- compiler/ppcgen/ngppccnv.pas | 64 ++++++++++++-- compiler/ppu.pas | 2 +- compiler/psystem.pas | 13 +-- compiler/ptconst.pas | 4 + compiler/ptype.pas | 4 +- compiler/sparc/cgcpu.pas | 2 +- compiler/sparc/ncpucnv.pas | 67 ++++++++++----- compiler/symconst.pas | 2 +- compiler/symdef.pas | 9 +- compiler/x86/cgx86.pas | 3 +- compiler/x86/nx86cnv.pas | 62 +++++++++++--- rtl/powerpc/int64p.inc | 2 +- rtl/unix/tthread.inc | 6 +- tests/test/cg/taddbool.pp | 159 ++++++++++++++++++++++++++++++++-- tests/test/cg/tcnvint1.pp | 161 +++++++++++++++++++++++++---------- tests/test/cg/tcnvint2.pp | 8 +- tests/test/cg/tnot.pp | 20 ++++- tests/webtbs/tw10233.pp | 30 +++++++ 40 files changed, 676 insertions(+), 173 deletions(-) create mode 100644 tests/webtbs/tw10233.pp diff --git a/.gitattributes b/.gitattributes index f140b632a6..1aac2f3fed 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/compiler/arm/cgcpu.pas b/compiler/arm/cgcpu.pas index 8c6d14a200..59e2a4af96 100644 --- a/compiler/arm/cgcpu.pas +++ b/compiler/arm/cgcpu.pas @@ -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 diff --git a/compiler/arm/narmcnv.pas b/compiler/arm/narmcnv.pas index 24c26c78f2..bc8c0349ed 100644 --- a/compiler/arm/narmcnv.pas +++ b/compiler/arm/narmcnv.pas @@ -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; diff --git a/compiler/cgobj.pas b/compiler/cgobj.pas index 6e80061501..6a170ac539 100644 --- a/compiler/cgobj.pas +++ b/compiler/cgobj.pas @@ -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 } diff --git a/compiler/dbgdwarf.pas b/compiler/dbgdwarf.pas index 1b6ab25840..ad72af2e5d 100644 --- a/compiler/dbgdwarf.pas +++ b/compiler/dbgdwarf.pas @@ -1099,6 +1099,7 @@ implementation ]); finish_entry; end; + pasbool, bool8bit : begin append_entry(DW_TAG_base_type,false,[ diff --git a/compiler/dbgstabs.pas b/compiler/dbgstabs.pas index e4e166ab9c..241cbbd4a4 100644 --- a/compiler/dbgstabs.pas +++ b/compiler/dbgstabs.pas @@ -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 : diff --git a/compiler/defcmp.pas b/compiler/defcmp.pas index 33af76edb2..c8694eaecf 100644 --- a/compiler/defcmp.pas +++ b/compiler/defcmp.pas @@ -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 : diff --git a/compiler/defutil.pas b/compiler/defutil.pas index 4aab15765d..608830260e 100644 --- a/compiler/defutil.pas +++ b/compiler/defutil.pas @@ -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]); diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index 9de2c28c76..307e34532a 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -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 = diff --git a/compiler/m68k/n68kadd.pas b/compiler/m68k/n68kadd.pas index 3bcab3b4ab..1cc45742eb 100644 --- a/compiler/m68k/n68kadd.pas +++ b/compiler/m68k/n68kadd.pas @@ -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 diff --git a/compiler/m68k/n68kcnv.pas b/compiler/m68k/n68kcnv.pas index be59f96f32..43065c061b 100644 --- a/compiler/m68k/n68kcnv.pas +++ b/compiler/m68k/n68kcnv.pas @@ -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; diff --git a/compiler/nadd.pas b/compiler/nadd.pas index 848a017fb2..0c75ee1d5f 100644 --- a/compiler/nadd.pas +++ b/compiler/nadd.pas @@ -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).sizeleft.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.size0) + 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); diff --git a/compiler/ninl.pas b/compiler/ninl.pas index d26d6cf4f3..0d80c10760 100644 --- a/compiler/ninl.pas +++ b/compiler/ninl.pas @@ -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 : diff --git a/compiler/nmat.pas b/compiler/nmat.pas index 45a20c9628..4588485281 100644 --- a/compiler/nmat.pas +++ b/compiler/nmat.pas @@ -783,6 +783,7 @@ implementation v:=tordconstnode(left).value; def:=left.resultdef; case torddef(left.resultdef).ordtype of + pasbool, bool8bit, bool16bit, bool32bit, diff --git a/compiler/nset.pas b/compiler/nset.pas index 629d998ba6..dc59f6a3bb 100644 --- a/compiler/nset.pas +++ b/compiler/nset.pas @@ -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 ( diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index 046c8e0c1d..743ddd5a17 100644 --- a/compiler/pdecsub.pas +++ b/compiler/pdecsub.pas @@ -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 diff --git a/compiler/ppcgen/cgppc.pas b/compiler/ppcgen/cgppc.pas index 50a7b9da85..fa4fb4a3fd 100644 --- a/compiler/ppcgen/cgppc.pas +++ b/compiler/ppcgen/cgppc.pas @@ -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 diff --git a/compiler/ppcgen/ngppcadd.pas b/compiler/ppcgen/ngppcadd.pas index b11d655f78..1a3c712f45 100644 --- a/compiler/ppcgen/ngppcadd.pas +++ b/compiler/ppcgen/ngppcadd.pas @@ -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 diff --git a/compiler/ppcgen/ngppccnv.pas b/compiler/ppcgen/ngppccnv.pas index c9ebc25ba9..4246d592f7 100644 --- a/compiler/ppcgen/ngppccnv.pas +++ b/compiler/ppcgen/ngppccnv.pas @@ -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. \ No newline at end of file +end. diff --git a/compiler/ppu.pas b/compiler/ppu.pas index 086b57bd96..7616dc1a69 100644 --- a/compiler/ppu.pas +++ b/compiler/ppu.pas @@ -43,7 +43,7 @@ type {$endif Test_Double_checksum} const - CurrentPPUVersion = 89; + CurrentPPUVersion = 90; { buffer sizes } maxentrysize = 1024; diff --git a/compiler/psystem.pas b/compiler/psystem.pas index 46a7c30a86..7ea9881dac 100644 --- a/compiler/psystem.pas +++ b/compiler/psystem.pas @@ -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); diff --git a/compiler/ptconst.pas b/compiler/ptconst.pas index 5abfdbf414..4b5816a4f8 100644 --- a/compiler/ptconst.pas +++ b/compiler/ptconst.pas @@ -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 diff --git a/compiler/ptype.pas b/compiler/ptype.pas index 17b80c6068..4d0f061ca8 100644 --- a/compiler/ptype.pas +++ b/compiler/ptype.pas @@ -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; diff --git a/compiler/sparc/cgcpu.pas b/compiler/sparc/cgcpu.pas index 4fb580309d..6d902dab55 100644 --- a/compiler/sparc/cgcpu.pas +++ b/compiler/sparc/cgcpu.pas @@ -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); diff --git a/compiler/sparc/ncpucnv.pas b/compiler/sparc/ncpucnv.pas index 9c5ba86fb6..f0a4a42cc7 100644 --- a/compiler/sparc/ncpucnv.pas +++ b/compiler/sparc/ncpucnv.pas @@ -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; diff --git a/compiler/symconst.pas b/compiler/symconst.pas index 35afc1dd75..b8013e8730 100644 --- a/compiler/symconst.pas +++ b/compiler/symconst.pas @@ -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 ); diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 1cf0ce1995..94a358ff03 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -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 diff --git a/compiler/x86/cgx86.pas b/compiler/x86/cgx86.pas index 6511f54e4e..d72de51125 100644 --- a/compiler/x86/cgx86.pas +++ b/compiler/x86/cgx86.pas @@ -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; diff --git a/compiler/x86/nx86cnv.pas b/compiler/x86/nx86cnv.pas index d942a84507..d33205d13a 100644 --- a/compiler/x86/nx86cnv.pas +++ b/compiler/x86/nx86cnv.pas @@ -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; diff --git a/rtl/powerpc/int64p.inc b/rtl/powerpc/int64p.inc index 551860ca53..02f809bdb4 100644 --- a/rtl/powerpc/int64p.inc +++ b/rtl/powerpc/int64p.inc @@ -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 diff --git a/rtl/unix/tthread.inc b/rtl/unix/tthread.inc index 2fe2823b93..bb75a09efe 100644 --- a/rtl/unix/tthread.inc +++ b/rtl/unix/tthread.inc @@ -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); diff --git a/tests/test/cg/taddbool.pp b/tests/test/cg/taddbool.pp index d26a518719..340c064a84 100644 --- a/tests/test/cg/taddbool.pp +++ b/tests/test/cg/taddbool.pp @@ -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; diff --git a/tests/test/cg/tcnvint1.pp b/tests/test/cg/tcnvint1.pp index 11419be49f..062932b705 100644 --- a/tests/test/cg/tcnvint1.pp +++ b/tests/test/cg/tcnvint1.pp @@ -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); diff --git a/tests/test/cg/tcnvint2.pp b/tests/test/cg/tcnvint2.pp index 4facb877ed..069c89112b 100644 --- a/tests/test/cg/tcnvint2.pp +++ b/tests/test/cg/tcnvint2.pp @@ -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!'); diff --git a/tests/test/cg/tnot.pp b/tests/test/cg/tnot.pp index 4e51577be0..597ec908ce 100644 --- a/tests/test/cg/tnot.pp +++ b/tests/test/cg/tnot.pp @@ -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)); diff --git a/tests/webtbs/tw10233.pp b/tests/webtbs/tw10233.pp new file mode 100644 index 0000000000..bdfbaf9fc1 --- /dev/null +++ b/tests/webtbs/tw10233.pp @@ -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.