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

* constant folding of not must check if the deftype is really an orddef, resolves #33696

Browse Source 
git-svn-id: trunk@39406 -
This commit is contained in:
florian 2018-07-07 14:17:41 +00:00
parent 4522494982
commit 96e92527e9
3 changed files with 58 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -492,7 +492,7 @@ compiler/ngenutil.pas svneol=native#text/plain
compiler/ngtcon.pas svneol=native#text/plain
compiler/ninl.pas svneol=native#text/plain
compiler/nld.pas svneol=native#text/plain
compiler/nmat.pas -text svneol=native#text/plain
compiler/nmat.pas svneol=native#text/plain
compiler/nmem.pas svneol=native#text/plain
compiler/nobj.pas svneol=native#text/plain
compiler/nobjc.pas svneol=native#text/plain
@ -16195,6 +16195,7 @@ tests/webtbs/tw3360.pp svneol=native#text/plain
tests/webtbs/tw33635.pp svneol=native#text/pascal
tests/webtbs/tw3364.pp svneol=native#text/plain
tests/webtbs/tw3366.pp svneol=native#text/plain
tests/webtbs/tw33696.pp svneol=native#text/pascal
tests/webtbs/tw33706.pp svneol=native#text/plain
tests/webtbs/tw33818.pp svneol=native#text/pascal
tests/webtbs/tw33839a.pp -text svneol=native#text/pascal

13
compiler/nmat.pas
View File

@ -227,7 +227,7 @@ implementation
{ allow operator overloading }
t:=self;
if isbinaryoverloaded(t,[]) then
if isbinaryoverloaded(t,[]) then
begin
result:=t;
exit;
@ -787,7 +787,7 @@ implementation
{ allow operator overloading }
t:=self;
if isbinaryoverloaded(t,[]) then
if isbinaryoverloaded(t,[]) then
begin
result:=t;
exit;
@ -1004,7 +1004,7 @@ implementation
begin
{ allow operator overloading }
t:=self;
if isunaryoverloaded(t,[]) then
if isunaryoverloaded(t,[]) then
begin
result:=t;
exit;
@ -1136,7 +1136,7 @@ implementation
begin
{ allow operator overloading }
t:=self;
if isunaryoverloaded(t,[]) then
if isunaryoverloaded(t,[]) then
begin
result:=t;
exit;
@ -1194,7 +1194,8 @@ implementation
end;
{ constant folding }
if (left.nodetype=ordconstn) then
if (left.nodetype=ordconstn) and
(left.resultdef.typ=orddef) then
begin
v:=tordconstnode(left).value;
def:=left.resultdef;
@ -1315,7 +1316,7 @@ implementation
begin
{ allow operator overloading }
t:=self;
if isunaryoverloaded(t,[]) then
if isunaryoverloaded(t,[]) then
begin
result:=t;
exit;

49
tests/webtbs/tw33696.pp Normal file
View File

@ -0,0 +1,49 @@
{$mode objfpc}{$H+}
type
ternary = (F, U, T);
operator and (const a,b:ternary):ternary;inline;
const lookupAnd:array[ternary,ternary] of ternary =
((F,F,F),(F,U,U),(F,U,T));
begin
Result:= LookupAnd[a,b];
end;
operator or (const a,b:ternary):ternary;inline;
const lookupOr:array[ternary,ternary] of ternary =
((F,U,T),(U,U,T),(T,T,T));
begin
Result := LookUpOr[a,b];
end;
operator not (const a:ternary):ternary;inline;
const LookupNot:array[ternary] of ternary =(T,U,F);
begin
Result:= LookUpNot[a];
end;
begin
// works as expected
writeln('AND');write(F and F);write(F and U);
writeln(F and T);write(U and F);write(U and U);
writeln(U and T);write(T and F);write(T and U);
writeln(T and T);
writeln;
//works as expected
writeln('OR');write(F or F);write(F or U);
writeln(F or T);write(U or F);write(U or U);
writeln(U or T);write(T or F);write(T or U);
writeln(T or T);
writeln;
// this fails, but compiles and runs w/o error indication.
// and renders the wrong results
writeln('NOT');
writeln(not F);// prints -1 unstead of T, it does not pick the overload!
writeln(not U);// prints -2 instead of U, it does not pick the overload!
writeln(not T);// prints -3 instead of F, it does not pick the overload!
// which makes this next construct impossible while the compiler suggests it's legal.
{
writeln(T and not F);
}
end.