paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-16 02:10:44 +01:00
Code Issues Packages Projects Releases Wiki Activity

* fixed the type conversions of the 'and' operator to be Delphi compatible. Fixes Mantis #25179

Browse Source 
git-svn-id: trunk@26882 -
This commit is contained in:
nickysn 2014-02-25 18:06:29 +00:00
parent b32d5a49fa
commit 888ecdaee4
3 changed files with 308 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -10997,6 +10997,7 @@ tests/test/talign.pp svneol=native#text/plain
tests/test/talign1.pp svneol=native#text/plain
tests/test/talign2.pp svneol=native#text/plain
tests/test/taligned1.pp svneol=native#text/pascal
tests/test/tand1.pp svneol=native#text/plain
tests/test/targ1a.pp svneol=native#text/plain
tests/test/targ1b.pp svneol=native#text/plain
tests/test/tarray1.pp svneol=native#text/plain

26
compiler/nadd.pas
View File

@ -1384,23 +1384,25 @@ implementation
{ size either as long as both values are signed or unsigned }
{ "xor" and "or" also don't care about the sign if the values }
{ occupy an entire register }
{ don't do it if either type is 64 bit, since in that case we }
{ can't safely find a "common" type }
{ don't do it if either type is 64 bit (except for "and"), }
{ since in that case we can't safely find a "common" type }
else if is_integer(ld) and is_integer(rd) and
not is_64bitint(ld) and not is_64bitint(rd) and
((nodetype=andn) or
((nodetype in [orn,xorn,equaln,unequaln,gtn,gten,ltn,lten]) and
not is_64bitint(ld) and not is_64bitint(rd) and
(is_signed(ld)=is_signed(rd)))) then
begin
if (rd.size=ld.size) and
(is_signed(ld) or is_signed(rd)) then
begin
{ Delphi-compatible: prefer unsigned type for "and" with equal size }
if not is_signed(rd) then
inserttypeconv_internal(left,rd)
else
inserttypeconv_internal(right,ld);
end
{ Delphi-compatible: prefer unsigned type for "and", when the
unsigned type is bigger than the signed one, and also bigger
than min(native_int, 32-bit) }
if (is_oversizedint(rd) or is_nativeint(rd) or is_32bitint(rd)) and
(rd.size>=ld.size) and
not is_signed(rd) and is_signed(ld) then
inserttypeconv_internal(left,rd)
else if (is_oversizedint(ld) or is_nativeint(ld) or is_32bitint(ld)) and
(ld.size>=rd.size) and
not is_signed(ld) and is_signed(rd) then
inserttypeconv_internal(right,ld)
else
begin
{ not to left right.resultdef, because that may

293
tests/test/tand1.pp Normal file
View File

@ -0,0 +1,293 @@
{ This test has been checked against Delphi XE3 and XE5, both 32-bit and 64-bit
versions }
{$IFDEF FPC}
{$MODE DELPHI}
{$IF defined(CPU32) or defined(CPU64)}
{$DEFINE Enable_Test}
{$ENDIF}
{$ELSE}
{$DEFINE Enable_Test}
{$ENDIF}
{$APPTYPE console}
{$IFDEF Enable_Test}
uses
SysUtils, Variants;
var
Error: Boolean;
function VariantType2String(basicType: Integer): string;
begin
case basicType of
varEmpty : Result := 'varEmpty';
varNull : Result := 'varNull';
varSmallInt : Result := 'varSmallInt';
varInteger : Result := 'varInteger';
varSingle : Result := 'varSingle';
varDouble : Result := 'varDouble';
varCurrency : Result := 'varCurrency';
varDate : Result := 'varDate';
varOleStr : Result := 'varOleStr';
varDispatch : Result := 'varDispatch';
varError : Result := 'varError';
varBoolean : Result := 'varBoolean';
varVariant : Result := 'varVariant';
varUnknown : Result := 'varUnknown';
varByte : Result := 'varByte';
varWord : Result := 'varWord';
varLongWord : Result := 'varLongWord';
varInt64 : Result := 'varInt64';
varStrArg : Result := 'varStrArg';
varString : Result := 'varString';
varAny : Result := 'varAny';
varTypeMask : Result := 'varTypeMask';
varShortInt : Result := 'varShortInt';
varUInt64 : Result := 'varUInt64';
else
Result := IntToStr(basicType);
end;
end;
procedure CheckBasicVariantType(varVar: Variant; expectedType: Integer);
var
basicType : Integer;
begin
basicType := VarType(varVar) and VarTypeMask;
if basicType = expectedType then
Writeln(VariantType2String(basicType))
else
begin
Writeln(VariantType2String(basicType), ' (ERROR! Expected: ', VariantType2String(expectedType), ')');
Error := True;
end;
end;
var
shortint_1, shortint_2: ShortInt;
smallint_1, smallint_2: SmallInt;
integer_1, integer_2: Integer;
int64_1, int64_2: Int64;
byte_1, byte_2: Byte;
word_1, word_2: Word;
longword_1, longword_2: LongWord;
uint64_1, uint64_2: UInt64;
v: Variant;
begin
Error := False;
shortint_1 := 1; shortint_2 := 1;
smallint_1 := 1; smallint_2 := 1;
integer_1 := 1; integer_2 := 1;
int64_1 := 1; int64_2 := 1;
byte_1 := 1; byte_2 := 1;
word_1 := 1; word_2 := 1;
longword_1 := 1; longword_2 := 1;
uint64_1 := 1; uint64_2 := 1;
Write('shortint and shortint: ':25);
v := shortint_1 and shortint_2;
CheckBasicVariantType(v, varShortInt);
Write('shortint and smallint: ':25);
v := shortint_1 and smallint_2;
CheckBasicVariantType(v, varSmallInt);
Write('shortint and integer: ':25);
v := shortint_1 and integer_2;
CheckBasicVariantType(v, varInteger);
Write('shortint and int64: ':25);
v := shortint_1 and int64_2;
CheckBasicVariantType(v, varInt64);
Write('shortint and byte: ':25);
v := shortint_1 and byte_2;
CheckBasicVariantType(v, varSmallInt);
Write('shortint and word: ':25);
v := shortint_1 and word_2;
CheckBasicVariantType(v, varInteger);
Write('shortint and longword: ':25);
v := shortint_1 and longword_2;
CheckBasicVariantType(v, varLongWord);
Write('shortint and uint64: ':25);
v := shortint_1 and uint64_2;
CheckBasicVariantType(v, varUInt64);
Write('smallint and shortint: ':25);
v := smallint_1 and shortint_2;
CheckBasicVariantType(v, varSmallInt);
Write('smallint and smallint: ':25);
v := smallint_1 and smallint_2;
CheckBasicVariantType(v, varSmallInt);
Write('smallint and integer: ':25);
v := smallint_1 and integer_2;
CheckBasicVariantType(v, varInteger);
Write('smallint and int64: ':25);
v := smallint_1 and int64_2;
CheckBasicVariantType(v, varInt64);
Write('smallint and byte: ':25);
v := smallint_1 and byte_2;
CheckBasicVariantType(v, varSmallInt);
Write('smallint and word: ':25);
v := smallint_1 and word_2;
CheckBasicVariantType(v, varInteger);
Write('smallint and longword: ':25);
v := smallint_1 and longword_2;
CheckBasicVariantType(v, varLongWord);
Write('smallint and uint64: ':25);
v := smallint_1 and uint64_2;
CheckBasicVariantType(v, varUInt64);
Write('integer and shortint: ':25);
v := integer_1 and shortint_2;
CheckBasicVariantType(v, varInteger);
Write('integer and smallint: ':25);
v := integer_1 and smallint_2;
CheckBasicVariantType(v, varInteger);
Write('integer and integer: ':25);
v := integer_1 and integer_2;
CheckBasicVariantType(v, varInteger);
Write('integer and int64: ':25);
v := integer_1 and int64_2;
CheckBasicVariantType(v, varInt64);
Write('integer and byte: ':25);
v := integer_1 and byte_2;
CheckBasicVariantType(v, varInteger);
Write('integer and word: ':25);
v := integer_1 and word_2;
CheckBasicVariantType(v, varInteger);
Write('integer and longword: ':25);
v := integer_1 and longword_2;
CheckBasicVariantType(v, varLongWord);
Write('integer and uint64: ':25);
v := integer_1 and uint64_2;
CheckBasicVariantType(v, varUInt64);
Write('int64 and shortint: ':25);
v := int64_1 and shortint_2;
CheckBasicVariantType(v, varInt64);
Write('int64 and smallint: ':25);
v := int64_1 and smallint_2;
CheckBasicVariantType(v, varInt64);
Write('int64 and integer: ':25);
v := int64_1 and integer_2;
CheckBasicVariantType(v, varInt64);
Write('int64 and int64: ':25);
v := int64_1 and int64_2;
CheckBasicVariantType(v, varInt64);
Write('int64 and byte: ':25);
v := int64_1 and byte_2;
CheckBasicVariantType(v, varInt64);
Write('int64 and word: ':25);
v := int64_1 and word_2;
CheckBasicVariantType(v, varInt64);
Write('int64 and longword: ':25);
v := int64_1 and longword_2;
CheckBasicVariantType(v, varInt64);
Write('int64 and uint64: ':25);
v := int64_1 and uint64_2;
CheckBasicVariantType(v, varUInt64);
Write('byte and shortint: ':25);
v := byte_1 and shortint_2;
CheckBasicVariantType(v, varSmallInt);
Write('byte and smallint: ':25);
v := byte_1 and smallint_2;
CheckBasicVariantType(v, varSmallInt);
Write('byte and integer: ':25);
v := byte_1 and integer_2;
CheckBasicVariantType(v, varInteger);
Write('byte and int64: ':25);
v := byte_1 and int64_2;
CheckBasicVariantType(v, varInt64);
Write('byte and byte: ':25);
v := byte_1 and byte_2;
CheckBasicVariantType(v, varByte);
Write('byte and word: ':25);
v := byte_1 and word_2;
CheckBasicVariantType(v, varWord);
Write('byte and longword: ':25);
v := byte_1 and longword_2;
CheckBasicVariantType(v, varLongWord);
Write('byte and uint64: ':25);
v := byte_1 and uint64_2;
CheckBasicVariantType(v, varUInt64);
Write('word and shortint: ':25);
v := word_1 and shortint_2;
CheckBasicVariantType(v, varInteger);
Write('word and smallint: ':25);
v := word_1 and smallint_2;
CheckBasicVariantType(v, varInteger);
Write('word and integer: ':25);
v := word_1 and integer_2;
CheckBasicVariantType(v, varInteger);
Write('word and int64: ':25);
v := word_1 and int64_2;
CheckBasicVariantType(v, varInt64);
Write('word and byte: ':25);
v := word_1 and byte_2;
CheckBasicVariantType(v, varWord);
Write('word and word: ':25);
v := word_1 and word_2;
CheckBasicVariantType(v, varWord);
Write('word and longword: ':25);
v := word_1 and longword_2;
CheckBasicVariantType(v, varLongWord);
Write('word and uint64: ':25);
v := word_1 and uint64_2;
CheckBasicVariantType(v, varUInt64);
Write('longword and shortint: ':25);
v := longword_1 and shortint_2;
CheckBasicVariantType(v, varLongWord);
Write('longword and smallint: ':25);
v := longword_1 and smallint_2;
CheckBasicVariantType(v, varLongWord);
Write('longword and integer: ':25);
v := longword_1 and integer_2;
CheckBasicVariantType(v, varLongWord);
Write('longword and int64: ':25);
v := longword_1 and int64_2;
CheckBasicVariantType(v, varInt64);
Write('longword and byte: ':25);
v := longword_1 and byte_2;
CheckBasicVariantType(v, varLongWord);
Write('longword and word: ':25);
v := longword_1 and word_2;
CheckBasicVariantType(v, varLongWord);
Write('longword and longword: ':25);
v := longword_1 and longword_2;
CheckBasicVariantType(v, varLongWord);
Write('longword and uint64: ':25);
v := longword_1 and uint64_2;
CheckBasicVariantType(v, varUInt64);
Write('uint64 and shortint: ':25);
v := uint64_1 and shortint_2;
CheckBasicVariantType(v, varUInt64);
Write('uint64 and smallint: ':25);
v := uint64_1 and smallint_2;
CheckBasicVariantType(v, varUInt64);
Write('uint64 and integer: ':25);
v := uint64_1 and integer_2;
CheckBasicVariantType(v, varUInt64);
Write('uint64 and int64: ':25);
v := uint64_1 and int64_2;
CheckBasicVariantType(v, varUInt64);
Write('uint64 and byte: ':25);
v := uint64_1 and byte_2;
CheckBasicVariantType(v, varUInt64);
Write('uint64 and word: ':25);
v := uint64_1 and word_2;
CheckBasicVariantType(v, varUInt64);
Write('uint64 and longword: ':25);
v := uint64_1 and longword_2;
CheckBasicVariantType(v, varUInt64);
Write('uint64 and uint64: ':25);
v := uint64_1 and uint64_2;
CheckBasicVariantType(v, varUInt64);
if Error then
begin
Writeln('Errors found!');
Halt(1);
end
else
Writeln('Success!');
end.
{$ELSE Enable_Test}
begin
end.
{$ENDIF Enable_Test}