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

* fix from Peter arraysize warning (nav Newsgroup msg)

Browse Source
This commit is contained in:
marco 2003-11-05 14:18:03 +00:00
parent 5ba9745d5e
commit 094ab8b446
2 changed files with 46 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
compiler/nmem.pas
View File

@ -658,8 +658,7 @@ implementation
is_pwidechar(left.resulttype.def) then
begin
{ convert pointer to array }
htype.setdef(tarraydef.create(0,$7fffffff,s32bittype));
tarraydef(htype.def).setelementtype(tpointerdef(left.resulttype.def).pointertype);
htype.setdef(tarraydef.create_from_pointer(tpointerdef(left.resulttype.def).pointertype));
inserttypeconv(left,htype);
resulttype:=tarraydef(htype.def).elementtype;
@ -925,7 +924,10 @@ begin
end.
{
$Log$
Revision 1.70 2003-10-31 18:44:18 peter
Revision 1.71 2003-11-05 14:18:03 marco
* fix from Peter arraysize warning (nav Newsgroup msg)
Revision 1.70 2003/10/31 18:44:18 peter
* don't search for compatible procvars when the proc is not
overloaded

75
compiler/symdef.pas
View File

@ -365,6 +365,7 @@ interface
lowrange,
highrange : longint;
rangetype : ttype;
IsConvertedPointer,
IsDynamicArray,
IsVariant,
IsConstructor,
@ -373,6 +374,7 @@ interface
_elementtype : ttype;
public
function elesize : longint;
constructor create_from_pointer(const elemt : ttype);
constructor create(l,h : longint;const t : ttype);
constructor ppuload(ppufile:tcompilerppufile);
procedure ppuwrite(ppufile:tcompilerppufile);override;
@ -2703,9 +2705,18 @@ implementation
IsConstructor:=false;
IsArrayOfConst:=false;
IsDynamicArray:=false;
IsConvertedPointer:=false;
end;
constructor tarraydef.create_from_pointer(const elemt : ttype);
begin
self.create(0,$7fffffff,s32bittype);
IsConvertedPointer:=true;
setelementtype(elemt);
end;
constructor tarraydef.ppuload(ppufile:tcompilerppufile);
begin
inherited ppuloaddef(ppufile);
@ -2780,53 +2791,46 @@ implementation
function tarraydef.size : longint;
var
_resultsize,
newsize,
cachedsize: TConstExprInt;
newsize : TConstExprInt;
begin
if IsDynamicArray then
begin
size:=POINTER_SIZE;
exit;
end;
cachedsize := elesize;
{Tarraydef.size may never be called for an open array!}
if highrange<lowrange then
internalerror(99080501);
newsize:=(int64(highrange)-int64(lowrange)+1)*cachedsize;
if (cachedsize>0) and
(
(TConstExprInt(highrange)-TConstExprInt(lowrange) > $7fffffff) or
{ () are needed around elesize-1 to avoid a possible
integer overflow for elesize=1 !! PM }
(($7fffffff div cachedsize + (cachedsize -1)) < (int64(highrange) - int64(lowrange)))
) Then
begin
Message(sym_e_segment_too_large);
_resultsize := 4
end
newsize:=(int64(highrange)-int64(lowrange)+1)*elesize;
{ prevent an overflow }
if newsize>high(longint) then
result:=high(longint)
else
begin
{ prevent an overflow }
if newsize>high(longint) then
_resultsize:=high(longint)
else
_resultsize:=newsize;
end;
size := _resultsize;
result:=newsize;
end;
procedure tarraydef.setelementtype(t: ttype);
begin
_elementtype:=t;
If IsDynamicArray then
exit;
if (TConstExprInt(highrange)-TConstExprInt(lowrange) > $7fffffff) then
procedure tarraydef.setelementtype(t: ttype);
var
cachedsize : TConstExprInt;
begin
_elementtype:=t;
if not(IsDynamicArray or
IsConvertedPointer or
(highrange<lowrange)) then
begin
{ cache element size for performance on multidimensional arrays }
cachedsize := elesize;
if (cachedsize>0) and
(
(TConstExprInt(highrange)-TConstExprInt(lowrange) > $7fffffff) or
{ () are needed around cachedsize-1 to avoid a possible
integer overflow for cachedsize=1 !! PM }
(($7fffffff div cachedsize + (cachedsize -1)) < (int64(highrange) - int64(lowrange)))
) Then
Message(sym_e_segment_too_large);
end;
end;
end;
function tarraydef.alignment : longint;
@ -6108,7 +6112,10 @@ implementation
end.
{
$Log$
Revision 1.187 2003-11-01 15:50:03 peter
Revision 1.188 2003-11-05 14:18:03 marco
* fix from Peter arraysize warning (nav Newsgroup msg)
Revision 1.187 2003/11/01 15:50:03 peter
* fix check for valid procdef in property rtti
Revision 1.186 2003/10/29 21:56:28 peter