* synchronized with trunk

git-svn-id: branches/wasm@48515 -
This commit is contained in:
nickysn 2021-02-06 08:27:24 +00:00
commit ae75c87d65
4 changed files with 71 additions and 5 deletions

1
.gitattributes vendored
View File

@ -18464,6 +18464,7 @@ tests/webtbs/tw33898.pp -text svneol=native#text/pascal
tests/webtbs/tw33963.pp svneol=native#text/pascal
tests/webtbs/tw3402.pp svneol=native#text/plain
tests/webtbs/tw34021.pp -text svneol=native#text/pascal
tests/webtbs/tw34027.pp svneol=native#text/pascal
tests/webtbs/tw34037.pp svneol=native#text/pascal
tests/webtbs/tw34055.pp svneol=native#text/plain
tests/webtbs/tw3411.pp svneol=native#text/plain

View File

@ -427,6 +427,10 @@ type
function queue_subscriptn_multiple_by_name(def: tabstractrecorddef; const fields: array of TIDString): tdef;
{ queue a type conversion operation }
procedure queue_typeconvn(fromdef, todef: tdef); virtual;
{ queue a add operation }
procedure queue_addn(def: tdef; const index: tconstexprint); virtual;
{ queue a sub operation }
procedure queue_subn(def: tdef; const index: tconstexprint); virtual;
{ finalise the queue (so a new one can be created) and flush the
previously queued operations, applying them in reverse order on a...}
{ ... procdef }
@ -2080,6 +2084,18 @@ implementation
end;
procedure ttai_typedconstbuilder.queue_addn(def: tdef; const index: tconstexprint);
begin
inc(fqueue_offset,def.size*int64(index));
end;
procedure ttai_typedconstbuilder.queue_subn(def: tdef; const index: tconstexprint);
begin
dec(fqueue_offset,def.size*int64(index));
end;
procedure ttai_typedconstbuilder.queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym);
begin
inc(fqueue_offset,vs.fieldoffset);

View File

@ -150,7 +150,7 @@ uses
defutil,defcmp,
{ pass 1 }
htypechk,procinfo,
nmem,ncnv,ninl,ncon,nld,
nmem,ncnv,ninl,ncon,nld,nadd,
{ parser specific stuff }
pbase,pexpr,
{ codegen }
@ -826,7 +826,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
{ maybe pchar ? }
else
if is_char(def.pointeddef) and
(node.nodetype<>addrn) then
((node.nodetype=stringconstn) or is_constcharnode(node)) then
begin
{ create a tcb for the string data (it's placed in a separate
asmlist) }
@ -875,7 +875,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
{ maybe pwidechar ? }
else
if is_widechar(def.pointeddef) and
(node.nodetype<>addrn) then
(node.nodetype in [stringconstn,ordconstn]) then
begin
if (node.nodetype in [stringconstn,ordconstn]) then
begin
@ -912,13 +912,13 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
Message(parser_e_illegal_expression);
end
else
if (node.nodetype=addrn) or
if (node.nodetype in [addrn,addn,subn]) or
is_proc2procvar_load(node,pd) then
begin
{ insert typeconv }
inserttypeconv(node,def);
hp:=node;
while assigned(hp) and (hp.nodetype in [addrn,typeconvn,subscriptn,vecn]) do
while assigned(hp) and (hp.nodetype in [addrn,typeconvn,subscriptn,vecn,addn,subn]) do
hp:=tunarynode(hp).left;
if (hp.nodetype=loadn) then
begin
@ -927,6 +927,28 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
while assigned(hp) and (hp.nodetype<>loadn) do
begin
case hp.nodetype of
addn :
begin
if (is_constintnode(taddnode(hp).right) or
is_constenumnode(taddnode(hp).right) or
is_constcharnode(taddnode(hp).right) or
is_constboolnode(taddnode(hp).right)) and
is_pointer(taddnode(hp).left.resultdef) then
ftcb.queue_addn(tpointerdef(taddnode(hp).left.resultdef).pointeddef,get_ordinal_value(taddnode(hp).right))
else
Message(parser_e_illegal_expression);
end;
subn :
begin
if (is_constintnode(taddnode(hp).right) or
is_constenumnode(taddnode(hp).right) or
is_constcharnode(taddnode(hp).right) or
is_constboolnode(taddnode(hp).right)) and
is_pointer(taddnode(hp).left.resultdef) then
ftcb.queue_subn(tpointerdef(taddnode(hp).left.resultdef).pointeddef,get_ordinal_value(taddnode(hp).right))
else
Message(parser_e_illegal_expression);
end;
vecn :
begin
if (is_constintnode(tvecnode(hp).right) or

27
tests/webtbs/tw34027.pp Normal file
View File

@ -0,0 +1,27 @@
uses
strings;
type tz = record
name : pchar;
end;
const aa :array[0..2] of char = 'aa'#0;
const testArrZ : array [0..4] of tz = (
(name: @aa), { Ok }
(name: pchar(@aa)), { Ok }
(name: pchar(@aa)+1),
(name: pchar(@aa)+1+1),
(name: pchar(@aa)+1+1-1)
);
var b : pchar;
begin
b:=pchar(@aa)+1; {Ok}
if strlen(testArrZ[2].name)<>1 then
halt(1);
if strlen(testArrZ[3].name)<>0 then
halt(2);
if strlen(testArrZ[4].name)<>1 then
halt(2);
end.