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

* correctly simplify tree transforms of (a+c1+c2) if a is a pointer, resolves #37671

Browse Source 
git-svn-id: trunk@47437 -
This commit is contained in:
florian 2020-11-16 21:47:19 +00:00
parent e94fb2edc3
commit 6380df9b42
4 changed files with 50 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -18504,6 +18504,7 @@ tests/webtbs/tw37508.pp svneol=native#text/pascal
tests/webtbs/tw3751.pp svneol=native#text/plain
tests/webtbs/tw37554.pp svneol=native#text/pascal
tests/webtbs/tw3758.pp svneol=native#text/plain
tests/webtbs/tw37621.pp -text svneol=native#text/pascal
tests/webtbs/tw3764.pp svneol=native#text/plain
tests/webtbs/tw3765.pp svneol=native#text/plain
tests/webtbs/tw37650.pp svneol=native#text/pascal

8
compiler/nadd.pas
View File

@ -490,7 +490,7 @@ implementation
var
t,vl,hp,lefttarget,righttarget: tnode;
t,vl,hp,lefttarget,righttarget, hp2: tnode;
lt,rt : tnodetype;
hdef,
rd,ld , inttype: tdef;
@ -793,7 +793,11 @@ implementation
{ keep the order of val+const else pointer operations might cause an error }
hp:=taddnode(left).left;
taddnode(left).left:=right;
left:=left.simplify(forinline);
left.resultdef:=nil;
do_typecheckpass(left);
hp2:=left.simplify(forinline);
if assigned(hp2) then
left:=hp2;
if resultdef.typ<>pointerdef then
begin
{ ensure that the constant is not expanded to a larger type due to overflow,

7
compiler/ncnv.pas
View File

@ -4117,7 +4117,9 @@ implementation
function ttypeconvnode.retains_value_location:boolean;
begin
result:=(convtype=tc_equal) or
result:=assigned(left.resultdef) and
(
(convtype=tc_equal) or
{ typecasting from void is always allowed }
is_void(left.resultdef) or
(left.resultdef.typ=formaldef) or
@ -4139,7 +4141,8 @@ implementation
{ on managed platforms, converting an element to an open array
involves creating an actual array -> value location changes }
((convtype=tc_elem_2_openarray) and
not(target_info.system in systems_managed_vm));
not(target_info.system in systems_managed_vm))
);
end;

38
tests/webtbs/tw37621.pp Normal file
View File

@ -0,0 +1,38 @@
program twctest;
{$mode delphi}
{$define InlineFuncs}
type
REChar = WideChar;
TRENextOff = PtrInt;
PRegExprChar = PWideChar;
TREOp = REChar; // internal p-code type //###0.933
const
REOpSz = SizeOf(TREOp) div SizeOf(REChar);
RENextOffSz = (SizeOf(TRENextOff) div SizeOf(REChar));
function CheckCharCategory(AChar: REChar; Ch0, Ch1: REChar): boolean;
// AChar: check this char against opcode
// Ch0, Ch1: opcode operands after OP_*CATEGORY
begin
end;
function MatchOneCharCategory(opnd, scan: PRegExprChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
// opnd: points to opcode operands after OP_*CATEGORY
// scan: points into InputString
begin
Result := CheckCharCategory(scan^, opnd^, (opnd + 1)^);
end;
procedure Test;
var
scan, reginput: PRegExprChar;
begin
if not MatchOneCharCategory(scan + REOpSz + RENextOffSz, reginput) then Exit;
end;
begin
Test;
end.