mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-21 16:49:16 +02:00
* make variables not regable if they are referenced by an absolute
variable of a different size git-svn-id: trunk@6817 -
This commit is contained in:
parent
bdc378e250
commit
1205d05ba4
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -8113,6 +8113,7 @@ tests/webtbs/tw8371.pp svneol=native#text/plain
|
||||
tests/webtbs/tw8391.pp svneol=native#text/plain
|
||||
tests/webtbs/tw8434.pp svneol=native#text/plain
|
||||
tests/webtbs/tw8462.pp svneol=native#text/plain
|
||||
tests/webtbs/tw8513.pp svneol=native#text/plain
|
||||
tests/webtbs/ub1873.pp svneol=native#text/plain
|
||||
tests/webtbs/ub1883.pp svneol=native#text/plain
|
||||
tests/webtbs/uw0555.pp svneol=native#text/plain
|
||||
|
@ -51,7 +51,7 @@ implementation
|
||||
systems,
|
||||
{ symtable }
|
||||
symconst,symbase,symtype,symtable,defutil,defcmp,
|
||||
fmodule,
|
||||
fmodule,htypechk,
|
||||
{ pass 1 }
|
||||
node,pass_1,aasmdata,
|
||||
nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nmem,
|
||||
@ -814,6 +814,14 @@ implementation
|
||||
abssym.fileinfo:=vs.fileinfo;
|
||||
abssym.abstyp:=tovar;
|
||||
abssym.ref:=node_to_propaccesslist(pt);
|
||||
{ if the sizes are different, can't be a regvar since you }
|
||||
{ can't be "absolute upper 8 bits of a register" (except }
|
||||
{ if its a record field of the same size of a record }
|
||||
{ regvar, but in that case pt.resultdef.size will have }
|
||||
{ the same size since it refers to the field and not to }
|
||||
{ the whole record -- which is why we use pt and not hp) }
|
||||
if (vs.vardef.size <> pt.resultdef.size) then
|
||||
make_not_regable(pt,vr_addr);
|
||||
end
|
||||
else
|
||||
Message(parser_e_absolute_only_to_var_or_const);
|
||||
|
54
tests/webtbs/tw8513.pp
Normal file
54
tests/webtbs/tw8513.pp
Normal file
@ -0,0 +1,54 @@
|
||||
type
|
||||
TMyType = cardinal;
|
||||
tr = record
|
||||
a,b,c,d: byte;
|
||||
end;
|
||||
|
||||
procedure t(var l: cardinal);
|
||||
begin
|
||||
if (l <> $cafebabe) then
|
||||
halt(4);
|
||||
l := $c001d00d;
|
||||
end;
|
||||
|
||||
var
|
||||
Item: TMyType;
|
||||
ItemAsByte: byte absolute Item;
|
||||
|
||||
r: tr;
|
||||
b: byte absolute r.b;
|
||||
|
||||
l: cardinal;
|
||||
labs: cardinal absolute l;
|
||||
begin
|
||||
{ Of course I understand fully that this code is bad
|
||||
(unless you really want to read the 1st byte of 4-byte LongInt
|
||||
type, messing with endianess problems).
|
||||
|
||||
In real code, I accessed ItemAsByte only when
|
||||
SizeOf(TMyType) = 1 (the code is
|
||||
used like a simple template, so it must work with any
|
||||
TMyType, and the case when SizeOf(TMyType) = 1 uses some
|
||||
specially optimized versions (e.g. FillChar(..., ItemAsByte)
|
||||
can be used in this case to fill the array of TMyType). }
|
||||
|
||||
{$ifdef FPC_BIG_ENDIAN}
|
||||
item:=$deadbeef;
|
||||
{$else}
|
||||
item:=$efbeadde;
|
||||
{$endif}
|
||||
if (itemasbyte <> $de) then
|
||||
halt(1);
|
||||
|
||||
r.a := $de;
|
||||
r.b := $ad;
|
||||
r.c := $be;
|
||||
r.d := $ef;
|
||||
if (b <> $ad) then
|
||||
halt(2);
|
||||
|
||||
l := $cafebabe;
|
||||
t(labs);
|
||||
if (l <> $c001d00d) then
|
||||
halt(6);
|
||||
end.
|
Loading…
Reference in New Issue
Block a user