paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-02 06:39:36 +01:00
Code Issues Packages Projects Releases Wiki Activity

MG: fixes for fpc 1.1: range check errors

Browse Source 
git-svn-id: trunk@365 -
This commit is contained in:
lazarus 2001-10-24 00:35:55 +00:00
parent e7de97e52a
commit 5535649f0b
11 changed files with 53 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
components/codetools/allcodetoolunits.pp
View File

@ -15,8 +15,8 @@ interface
uses
MemCheck,
CodeToolManager, AVL_Tree, KeywordFuncLists, ExprEval, LinkScanner, SourceLog,
BasicCodeTools, CodeCache, SourceChanger, CodeTools, DefineTemplates;
CodeToolManager, CodeTools, LinkScanner, BasicCodeTools, SourceChanger,
CodeCache, KeywordFuncLists, SourceLog, ExprEval, AVL_Tree, DefineTemplates;
implementation
@ -26,6 +26,9 @@ end.
{ =============================================================================
$Log$
Revision 1.2 2001/10/24 00:35:53 lazarus
MG: fixes for fpc 1.1: range check errors
Revision 1.1 2001/10/09 10:04:43 lazarus
MG: added allcodetoolunits.pp

4
components/codetools/codetoolmanager.pas
View File

@ -39,8 +39,8 @@ uses
{$IFDEF MEM_CHECK}
MemCheck,
{$ENDIF}
Classes, SysUtils, CodeTools, DefineTemplates, CodeCache, ExprEval,
LinkScanner, KeywordFuncLists, TypInfo, SourceChanger;
Classes, SysUtils, CodeTools, SourceChanger, DefineTemplates, CodeCache,
ExprEval, LinkScanner, KeywordFuncLists, TypInfo;
type
TCodeToolManager = class;

4
components/codetools/codetools.pas
View File

@ -53,8 +53,8 @@ uses
{$IFDEF MEM_CHECK}
MemCheck,
{$ENDIF}
Classes, SysUtils, SourceLog, KeywordFuncLists, BasicCodeTools, LinkScanner,
CodeCache, AVL_Tree, TypInfo, SourceChanger;
Classes, SysUtils, SourceChanger, CodeCache, BasicCodeTools, LinkScanner,
SourceLog, KeywordFuncLists, AVL_Tree, TypInfo;
type
TGetStringProc = procedure(const s: string) of object;

38
components/codetools/memcheck.pas
View File

@ -170,7 +170,7 @@ begin
crc:=i;
for n:=1 to 8 do
if odd(crc) then
crc:=(crc shr 1) xor $edb88320
crc:=(crc shr 1) xor integer($edb88320)
else
crc:=crc shr 1;
Crc32Tbl[i]:=crc;
@ -203,7 +203,7 @@ var
crc : longint;
pl : plongint;
begin
crc:=$ffffffff;
crc:=integer($ffffffff);
crc:=UpdateCrc32(crc,p^.size,sizeof(longint));
crc:=UpdateCrc32(crc,p^.calls,tracesize*sizeof(longint));
if extra_info_size>0 then
@ -223,7 +223,7 @@ var
crc : longint;
pl : plongint;
begin
crc:=$ffffffff;
crc:=integer($ffffffff);
crc:=UpdateCrc32(crc,p^.size,sizeof(longint));
crc:=UpdateCrc32(crc,p^.calls,tracesize*sizeof(longint));
if extra_info_size>0 then
@ -337,9 +337,9 @@ begin
i:=0;
while pp<>nil do
begin
if ((pp^.sig<>$DEADBEEF) or usecrc) and
if ((pp^.sig<>integer($DEADBEEF)) or usecrc) and
((pp^.sig<>calculate_sig(pp)) or not usecrc) and
(pp^.sig <> $AAAAAAAA) then
(pp^.sig <> integer($AAAAAAAA)) then
begin
writeln(ptext^,'error in linked list of heap_mem_info');
RunError(204);
@ -372,12 +372,12 @@ begin
inc(bp,sizeof(longint));
p:=SysGetMem(bp);
{ Create the info block }
pheap_mem_info(p)^.sig:=$DEADBEEF;
pheap_mem_info(p)^.sig:=integer($DEADBEEF);
pheap_mem_info(p)^.size:=size;
if add_tail then
begin
pl:=pointer(p)+bp-sizeof(longint);
pl^:=$DEADBEEF;
pl^:=integer($DEADBEEF);
end;
bp:=get_caller_frame(get_frame);
for i:=1 to tracesize do
@ -436,13 +436,13 @@ begin
pp:=pheap_mem_info(p);
if not quicktrace and not(is_in_getmem_list(pp)) then
RunError(204);
if (pp^.sig=$AAAAAAAA) and not usecrc then
if (pp^.sig=integer($AAAAAAAA)) and not usecrc then
begin
error_in_heap:=true;
dump_already_free(pp,ptext^);
if haltonerror then halt(1);
end
else if ((pp^.sig<>$DEADBEEF) or usecrc) and
else if ((pp^.sig<>integer($DEADBEEF)) or usecrc) and
((pp^.sig<>calculate_sig(pp)) or not usecrc) then
begin
error_in_heap:=true;
@ -466,7 +466,7 @@ begin
exit;
end;
{ now it is released !! }
pp^.sig:=$AAAAAAAA;
pp^.sig:=integer($AAAAAAAA);
if not keepreleased then
begin
if pp^.next<>nil then
@ -591,7 +591,7 @@ begin
dec(p,sizeof(theap_mem_info)+extra_info_size);
pp:=pheap_mem_info(p);
{ test block }
if ((pp^.sig<>$DEADBEEF) or usecrc) and
if ((pp^.sig<>integer($DEADBEEF)) or usecrc) and
((pp^.sig<>calculate_sig(pp)) or not usecrc) then
begin
error_in_heap:=true;
@ -632,12 +632,12 @@ begin
inc(getmem_size,size);
inc(getmem8_size,((size+7) div 8)*8);
{ Create the info block }
pp^.sig:=$DEADBEEF;
pp^.sig:=integer($DEADBEEF);
pp^.size:=size;
if add_tail then
begin
pl:=pointer(p)+bp-sizeof(longint);
pl^:=$DEADBEEF;
pl^:=integer($DEADBEEF);
end;
bp:=get_caller_frame(get_frame);
for i:=1 to tracesize do
@ -740,10 +740,10 @@ begin
+Cardinal(extra_info_size)+Cardinal(pp^.size)) then
begin
{ check allocated block }
if ((pp^.sig=$DEADBEEF) and not usecrc) or
if ((pp^.sig=integer($DEADBEEF)) and not usecrc) or
((pp^.sig=calculate_sig(pp)) and usecrc) or
{ special case of the fill_extra_info call }
((pp=heap_valid_last) and usecrc and (pp^.sig=$DEADBEEF)
((pp=heap_valid_last) and usecrc and (pp^.sig=integer($DEADBEEF))
and inside_trace_getmem) then exit
else
begin
@ -770,7 +770,7 @@ begin
if (cardinal(p)>=cardinal(pp)+sizeof(theap_mem_info)+cardinal(extra_info_size)) and
(cardinal(p)<=cardinal(pp)+sizeof(theap_mem_info)+cardinal(extra_info_size)+cardinal(pp^.size)) then
{ allocated block }
if ((pp^.sig=$DEADBEEF) and not usecrc) or
if ((pp^.sig=integer($DEADBEEF)) and not usecrc) or
((pp^.sig=calculate_sig(pp)) and usecrc) then
exit
else
@ -826,7 +826,7 @@ begin
Writeln(ptext^,'More memory blocks than expected');
exit;
end;
if ((pp^.sig=$DEADBEEF) and not usecrc) or
if ((pp^.sig=integer($DEADBEEF)) and not usecrc) or
((pp^.sig=calculate_sig(pp)) and usecrc) then
begin
{ this one was not released !! }
@ -834,7 +834,7 @@ begin
call_stack(pp,ptext^);
dec(i);
end
else if pp^.sig<>$AAAAAAAA then
else if pp^.sig<>integer($AAAAAAAA) then
begin
dump_error(pp,ptext^);
{$ifdef EXTRA}
@ -864,7 +864,7 @@ begin
pp:=heap_mem_root;
while pp<>nil do
begin
pp^.sig:=$AAAAAAAA;
pp^.sig:=integer($AAAAAAAA);
pp:=pp^.previous;
end;
end;

4
components/codetools/sourcechanger.pas
View File

@ -41,8 +41,8 @@ unit SourceChanger;
interface
uses
Classes, SysUtils, SourceLog, LinkScanner, AVL_Tree, CodeCache,
KeywordFuncLists, BasicCodeTools;
Classes, SysUtils, CodeCache, BasicCodeTools, SourceLog, LinkScanner, AVL_Tree,
KeywordFuncLists;
type
// TBeautifyCodeOptions

6
components/synedit/synedit.pp
View File

@ -1074,11 +1074,11 @@ const
begin
inherited CreateParams(Params);
with Params do begin
{$R-}
WindowClass.Style := WindowClass.Style and not ClassStylesOff;
{$IFOPT R+}{$DEFINE RangeCheckOn}{$R-}{$ENDIF}
WindowClass.Style := WindowClass.Style and not Cardinal(ClassStylesOff);
Style := Style or ScrollBar[FScrollBars] or BorderStyles[fBorderStyle]
or WS_CLIPCHILDREN;
{$R+}
{$IFDEF RangeCheckOn}{$R+}{$ENDIF}
if NewStyleControls and Ctl3D and (fBorderStyle = bsSingle) then begin
Style := Style and not Cardinal(WS_BORDER);
ExStyle := ExStyle or WS_EX_CLIENTEDGE;

6
components/synedit/synhighlightercpp.pp
View File

@ -1488,7 +1488,7 @@ begin
with TBetterRegistry.Create do
begin
try
RootKey := HKEY_LOCAL_MACHINE;
RootKey := integer(HKEY_LOCAL_MACHINE);
{$IFNDEF SYN_LAZARUS}
if OpenKeyReadOnly('\SOFTWARE\Borland\C++Builder') then
begin
@ -1523,13 +1523,13 @@ function TSynCppSyn.UseUserSettings(settingIndex: integer): boolean;
begin
for i := 1 to Length(name) do
if name[i] = ' ' then name[i] := '_';
Result := attri.LoadFromBorlandRegistry(HKEY_CURRENT_USER,
Result := attri.LoadFromBorlandRegistry(integer(HKEY_CURRENT_USER),
'\SOFTWARE\Borland\C++Builder\'+settingTag+'\Highlight',name,true);
end; { ReadCPPB1 }
function ReadCPPB3OrMore(settingTag: string; attri: TSynHighlighterAttributes; key: string): boolean;
begin
Result := attri.LoadFromBorlandRegistry(HKEY_CURRENT_USER,
Result := attri.LoadFromBorlandRegistry(integer(HKEY_CURRENT_USER),
'\Software\Borland\C++Builder\'+settingTag+'\Editor\Highlight',
key,false);
end; { ReadCPPB3OrMore }

6
components/synedit/synhighlighterpas.pp
View File

@ -1506,7 +1506,7 @@ begin
with TBetterRegistry.Create do
begin
try
RootKey := HKEY_LOCAL_MACHINE;
RootKey := integer(HKEY_LOCAL_MACHINE);
{$IFNDEF SYN_LAZARUS}
// ToDo Registry
if OpenKeyReadOnly('\SOFTWARE\Borland\Delphi') then
@ -1544,14 +1544,14 @@ function TSynPasSyn.UseUserSettings(settingIndex: integer): boolean;
begin
for i := 1 to Length(name) do
if name[i] = ' ' then name[i] := '_';
Result := attri.LoadFromBorlandRegistry(HKEY_CURRENT_USER,
Result := attri.LoadFromBorlandRegistry(integer(HKEY_CURRENT_USER),
'\Software\Borland\Delphi\'+settingTag+'\Highlight',name,true);
end; { ReadDelphi2Or3 }
function ReadDelphi4OrMore(settingTag: string;
attri: TSynHighlighterAttributes; key: string): boolean;
begin
Result := attri.LoadFromBorlandRegistry(HKEY_CURRENT_USER,
Result := attri.LoadFromBorlandRegistry(integer(HKEY_CURRENT_USER),
'\Software\Borland\Delphi\'+settingTag+'\Editor\Highlight',
key,false);
end; { ReadDelphi4OrMore }

5
lcl/graphics.pp
View File

@ -697,7 +697,7 @@ end;
function ColorToRGB(Color: TColor): Longint;
begin
if (Color and SYS_COLOR_BASE) <> 0
if (Cardinal(Color) and SYS_COLOR_BASE) <> 0
then Result := GetSysColor(Color and $000000FF)
else Result := Color;
Result := Result and $FFFFFF;
@ -743,6 +743,9 @@ end.
{ =============================================================================
$Log$
Revision 1.14 2001/10/24 00:35:55 lazarus
MG: fixes for fpc 1.1: range check errors
Revision 1.13 2001/09/30 08:34:49 lazarus
MG: fixed mem leaks and fixed range check errors

5
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -793,7 +793,7 @@ Assert(False, 'Trace:TODO: CREATERECTRGN in gtkwinapi.inc');
Assert(False, 'Trace:!!!!!!!!!!!!!!!!!!');
Assert(False, 'Trace:!!!!!!!!!!!!!!!!!!');
result := -1;
Result := Cardinal(-1);
end;
@ -3604,6 +3604,9 @@ end;
{ =============================================================================
$Log$
Revision 1.45 2001/10/24 00:35:55 lazarus
MG: fixes for fpc 1.1: range check errors
Revision 1.44 2001/10/16 14:19:13 lazarus
MG: added nvidia opengl support and a new opengl example from satan

7
lcl/interfaces/gtk/gtkwinapiwindow.pp
View File

@ -215,10 +215,12 @@ var
ObjectClass: PGTKObjectClass;
WidgetClass: PGTKWidgetClass;
SignalID: Guint;
AdjustType: TGtkType;
begin
ObjectClass := PGTKObjectClass(theClass);
WidgetClass := PGTKWidgetClass(theClass);
AdjustType := gtk_adjustment_get_type;
SignalID := gtk_signal_new(
'set_scroll_adjustments',
GTK_RUN_FIRST,
@ -227,7 +229,7 @@ begin
@gtk_marshal_NONE__POINTER_POINTER,
GTK_TYPE_NONE,
2,
[gtk_adjustment_get_type, gtk_adjustment_get_type]
[AdjustType, AdjustType]
);
with WidgetClass^ do
@ -616,6 +618,9 @@ end.
{ =============================================================================
$Log$
Revision 1.13 2001/10/24 00:35:55 lazarus
MG: fixes for fpc 1.1: range check errors
Revision 1.12 2001/10/10 17:55:06 lazarus
MG: fixed caret lost, gtk cleanup, bracket lvls, bookmark saving