From b17384ebc1c443ea84bf4b420b5244199e5e4124 Mon Sep 17 00:00:00 2001 From: mattias Date: Tue, 18 Jul 2006 17:20:34 +0000 Subject: [PATCH] TButtonGlyph now uses shared bitmaps, improved debugging mem leaks git-svn-id: trunk@9629 - --- examples/multithreading/waitforexample1.lpi | 188 +----------------- ide/componentpalette.pas | 177 +++++++++-------- ide/lazarus.lpi | 3 +- ide/main.pp | 2 +- lcl/include/buttonglyph.inc | 28 +-- lcl/interfaces/gtk/gtkdef.pp | 12 +- lcl/interfaces/gtk/gtklistsl.inc | 21 ++ lcl/interfaces/gtk/gtkobject.inc | 21 +- lcl/interfaces/gtk/gtkwinapi.inc | 56 ++++-- lcl/interfaces/gtk/gtkwsbuttons.pp | 3 + lcl/lclproc.pas | 28 ++- packager/packagedefs.pas | 6 +- .../HowToCreate_fpc_crosswin32_rpm.txt | 16 +- .../cross_unix/build_linux_cross_win32_rpm.sh | 4 +- tools/install/cross_unix/update_cross_fpc.sh | 4 +- 15 files changed, 231 insertions(+), 338 deletions(-) diff --git a/examples/multithreading/waitforexample1.lpi b/examples/multithreading/waitforexample1.lpi index aed2660d2e..adba17cd7b 100644 --- a/examples/multithreading/waitforexample1.lpi +++ b/examples/multithreading/waitforexample1.lpi @@ -4,13 +4,13 @@ + + - - @@ -25,16 +25,11 @@ - + - - - - - @@ -42,185 +37,8 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/ide/componentpalette.pas b/ide/componentpalette.pas index 7ba2d08f89..46a157a65a 100644 --- a/ide/componentpalette.pas +++ b/ide/componentpalette.pas @@ -451,99 +451,104 @@ begin exit; end; //writeln('TComponentPalette.UpdateNoteBookButtons A'); + // lock fUpdatingNotebook:=true; - OldActivePage:=FNoteBook.ActivePage; - // remove every page in the notebook without a visible page - for i:=FNoteBook.PageCount-1 downto 0 do begin - PageIndex:=IndexOfPageComponent(FNoteBook.Page[i]); - if (PageIndex<0) or (not Pages[PageIndex].Visible) then begin - if PageIndex>=0 then - Pages[i].PageComponent:=nil; - FNoteBook.Pages.Delete(i); - end; - end; - // insert a notebook page for every visible palette page - PageIndex:=0; - for i:=0 to Count-1 do begin - if not Pages[i].Visible then continue; - if Pages[i].PageComponent=nil then begin - // insert a new notebook page - FNoteBook.Pages.Insert(PageIndex,Pages[i].PageName); - Pages[i].PageComponent:=FNoteBook.Page[PageIndex]; - end else begin - // move to the right position - CurPageIndex:=TPage(Pages[i].PageComponent).PageIndex; - if CurPageIndex<>PageIndex then - FNoteBook.Pages.Move(CurPageIndex,PageIndex); - end; - inc(PageIndex); - end; - // create a speedbutton for every visible component - for i:=0 to Count-1 do begin - CurPage:=Pages[i]; - if not CurPage.Visible then continue; - CurNoteBookPage:=TPage(CurPage.PageComponent); - if not (CurNoteBookPage is TPage) then RaiseException('CurNoteBookPage'); - ButtonX:=0; - // create selection button - if CurPage.SelectButton=nil then begin - CurBtn:=TSpeedButton.Create(nil); - CurPage.SelectButton:=CurBtn; - with CurBtn do begin - Name:='PaletteSelectBtn'+IntToStr(i); - Parent:=CurNoteBookPage; - OnClick := @SelectionToolClick; - Glyph.LoadFromLazarusResource('tmouse'); - Flat := True; - GroupIndex:= 1; - Down := True; - Hint := lisSelectionTool; - SetBounds(ButtonX,0,ComponentPaletteBtnWidth,ComponentPaletteBtnHeight); + FNoteBook.DisableAlign; + try + OldActivePage:=FNoteBook.ActivePage; + // remove every page in the notebook without a visible page + for i:=FNoteBook.PageCount-1 downto 0 do begin + PageIndex:=IndexOfPageComponent(FNoteBook.Page[i]); + if (PageIndex<0) or (not Pages[PageIndex].Visible) then begin + if PageIndex>=0 then + Pages[i].PageComponent:=nil; + FNoteBook.Pages.Delete(i); end; end; - inc(ButtonX,((ComponentPaletteBtnWidth*3) div 2)+2); - // create component buttons - for j:=0 to CurPage.Count-1 do begin - CurComponent:=TPkgComponent(CurPage[j]); - if CurComponent.Visible then begin - if CurComponent.Button=nil then begin - CurBtn:=TSpeedButton.Create(nil); - CurComponent.Button:=CurBtn; - CreatePopupMenu; - with CurBtn do begin - Name:='PaletteBtnPage'+IntToStr(i)+'_'+IntToStr(j) - +'_'+CurComponent.ComponentClass.ClassName; - Parent := CurNoteBookPage; - SetBounds(ButtonX,0,ComponentPaletteBtnWidth,ComponentPaletteBtnHeight); - Glyph := CurComponent.GetIconCopy; - GroupIndex := 1; - Flat := true; - OnClick := @ComponentBtnClick; - OnDblClick := @ComponentBtnDblClick; - Hint := CurComponent.ComponentClass.ClassName; - CurBtn.PopupMenu:=Self.PopupMenu; - Visible:=true; - end; - //writeln('TComponentPalette.UpdateNoteBookButtons Created Button: ',CurComponent.ComponentClass.ClassName,' ',CurComponent.Button.Name); + // insert a notebook page for every visible palette page + PageIndex:=0; + for i:=0 to Count-1 do begin + if not Pages[i].Visible then continue; + if Pages[i].PageComponent=nil then begin + // insert a new notebook page + FNoteBook.Pages.Insert(PageIndex,Pages[i].PageName); + Pages[i].PageComponent:=FNoteBook.Page[PageIndex]; + end else begin + // move to the right position + CurPageIndex:=TPage(Pages[i].PageComponent).PageIndex; + if CurPageIndex<>PageIndex then + FNoteBook.Pages.Move(CurPageIndex,PageIndex); + end; + inc(PageIndex); + end; + // create a speedbutton for every visible component + for i:=0 to Count-1 do begin + CurPage:=Pages[i]; + if not CurPage.Visible then continue; + CurNoteBookPage:=TPage(CurPage.PageComponent); + if not (CurNoteBookPage is TPage) then RaiseException('CurNoteBookPage'); + ButtonX:=0; + // create selection button + if CurPage.SelectButton=nil then begin + CurBtn:=TSpeedButton.Create(nil); + CurPage.SelectButton:=CurBtn; + with CurBtn do begin + Name:='PaletteSelectBtn'+IntToStr(i); + OnClick := @SelectionToolClick; + Glyph.LoadFromLazarusResource('tmouse'); + Flat := True; + GroupIndex:= 1; + Down := True; + Hint := lisSelectionTool; + SetBounds(ButtonX,0,ComponentPaletteBtnWidth,ComponentPaletteBtnHeight); + Parent:=CurNoteBookPage; end; - end else if CurComponent.Button<>nil then begin - //writeln('TComponentPalette.UpdateNoteBookButtons Destroy Button: ',CurComponent.ComponentClass.ClassName,' ',CurComponent.Button.Name); - CurComponent.Button.Free; - CurComponent.Button:=nil; end; - inc(ButtonX,ComponentPaletteBtnWidth+2); + inc(ButtonX,((ComponentPaletteBtnWidth*3) div 2)+2); + // create component buttons + for j:=0 to CurPage.Count-1 do begin + CurComponent:=TPkgComponent(CurPage[j]); + if CurComponent.Visible then begin + if CurComponent.Button=nil then begin + CurBtn:=TSpeedButton.Create(nil); + CurComponent.Button:=CurBtn; + CreatePopupMenu; + with CurBtn do begin + Name:='PaletteBtnPage'+IntToStr(i)+'_'+IntToStr(j) + +'_'+CurComponent.ComponentClass.ClassName; + SetBounds(ButtonX,0,ComponentPaletteBtnWidth,ComponentPaletteBtnHeight); + Glyph := CurComponent.Icon; + GroupIndex := 1; + Flat := true; + OnClick := @ComponentBtnClick; + OnDblClick := @ComponentBtnDblClick; + Hint := CurComponent.ComponentClass.ClassName; + CurBtn.PopupMenu:=Self.PopupMenu; + Parent := CurNoteBookPage; + end; + //writeln('TComponentPalette.UpdateNoteBookButtons Created Button: ',CurComponent.ComponentClass.ClassName,' ',CurComponent.Button.Name); + end; + end else if CurComponent.Button<>nil then begin + //writeln('TComponentPalette.UpdateNoteBookButtons Destroy Button: ',CurComponent.ComponentClass.ClassName,' ',CurComponent.Button.Name); + CurComponent.Button.Free; + CurComponent.Button:=nil; + end; + inc(ButtonX,ComponentPaletteBtnWidth+2); + end; end; + // restore active page + if (OldActivePage<>'') and (FNoteBook.Pages.IndexOf(OldActivePage)>=0) then + begin + FNoteBook.ActivePage:=OldActivePage; + end else if FNoteBook.PageCount>0 then begin + FNoteBook.PageIndex:=0; + end; + finally + // unlock + fUpdatingNotebook:=false; + fNoteBookNeedsUpdate:=false; + FNoteBook.EnableAlign; end; - // restore active page - if (OldActivePage<>'') and (FNoteBook.Pages.IndexOf(OldActivePage)>=0) then - begin - FNoteBook.ActivePage:=OldActivePage; - end else if FNoteBook.PageCount>0 then begin - FNoteBook.PageIndex:=0; - end; - // unlock - fUpdatingNotebook:=false; - fNoteBookNeedsUpdate:=false; //writeln('TComponentPalette.UpdateNoteBookButtons END'); end; diff --git a/ide/lazarus.lpi b/ide/lazarus.lpi index a86aa5b5a7..2d0809e8a4 100644 --- a/ide/lazarus.lpi +++ b/ide/lazarus.lpi @@ -14,7 +14,6 @@ - @@ -40,7 +39,7 @@ - + diff --git a/ide/main.pp b/ide/main.pp index 604fd51e98..8a8602d84e 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -2742,7 +2742,7 @@ Begin OnCloseQuery:=@OnDesignerCloseQuery; OnPersistentDeleted:=@OnDesignerPersistentDeleted; OnGetNonVisualCompIcon:= - @TComponentPalette(IDEComponentPalette).OnGetNonVisualCompIcon; + @TComponentPalette(IDEComponentPalette).OnGetNonVisualCompIcon; OnGetSelectedComponentClass:=@OnDesignerGetSelectedComponentClass; OnModified:=@OnDesignerModified; OnPasteComponent:=@OnDesignerPasteComponent; diff --git a/lcl/include/buttonglyph.inc b/lcl/include/buttonglyph.inc index 193d5eaf17..c4a2469efa 100644 --- a/lcl/include/buttonglyph.inc +++ b/lcl/include/buttonglyph.inc @@ -26,37 +26,29 @@ begin FOriginal.OnChange := @GlyphChanged; end; -{------------------------------------------------------------------------------} -{ TButtonGlyph destructor } -{------------------------------------------------------------------------------} +{------------------------------------------------------------------------------ + TButtonGlyph destructor +------------------------------------------------------------------------------} destructor TButtonGlyph.Destroy; -Begin +begin FOriginal.Free; FOriginal:=nil; inherited Destroy; end; -{------------------------------------------------------------------------------} -{ TButtonGlyph SetGlyph } -{------------------------------------------------------------------------------} +{------------------------------------------------------------------------------ + TButtonGlyph SetGlyph +------------------------------------------------------------------------------} procedure TButtonGlyph.SetGlyph(Value : TBitmap); var GlyphCount : integer; begin if FOriginal = Value then exit; - {$IFDEF BitmapSharingWorks} if FOriginal=nil then begin FOriginal:=TBitmap.Create; end; FOriginal.OnChange:=nil; FOriginal.Assign(Value); - {$ELSE} - if FOriginal<>nil then begin - FOriginal.OnChange:=nil; - FOriginal.Free; - end; - FOriginal:= Value; - {$ENDIF} FOriginal.OnChange := @GlyphChanged; FNumGlyphs:=1; if (FOriginal <> nil) and (FOriginal.Height > 0) then begin @@ -75,9 +67,9 @@ begin if Assigned(FOnChange) then FOnChange(Self); end; -{------------------------------------------------------------------------------} -{ TButtonGlyph Draw } -{------------------------------------------------------------------------------} +{------------------------------------------------------------------------------ + TButtonGlyph Draw +------------------------------------------------------------------------------} Function TButtonGlyph.Draw(Canvas: TCanvas; const Client: TRect; const Offset: TPoint; State: TButtonState; Transparent: Boolean; BiDiFlags: Longint): TRect; diff --git a/lcl/interfaces/gtk/gtkdef.pp b/lcl/interfaces/gtk/gtkdef.pp index 9ad1dbde1d..ce166057f9 100644 --- a/lcl/interfaces/gtk/gtkdef.pp +++ b/lcl/interfaces/gtk/gtkdef.pp @@ -380,8 +380,8 @@ const GDKX_KEY_LaunchF = $1008FF4F; -function NewPGDIObject: PGDIObject; -procedure DisposePGDIObject(GDIObject: PGdiObject); +function InternalNewPGDIObject: PGDIObject; +procedure InternalDisposePGDIObject(GDIObject: PGdiObject); function NewDeviceContext: TDeviceContext; procedure DisposeDeviceContext(DeviceContext: TDeviceContext); @@ -393,6 +393,9 @@ var DebugDeviceContexts: TDebugLCLItems = nil; {$ENDIF} +procedure GtkDefDone; + + implementation @@ -411,7 +414,7 @@ type const GDIObjectMemManager: TGDIObjectMemManager = nil; -function NewPGDIObject: PGDIObject; +function InternalNewPGDIObject: PGDIObject; begin if GDIObjectMemManager=nil then begin GDIObjectMemManager:=TGDIObjectMemManager.Create; @@ -423,7 +426,7 @@ begin {$ENDIF} end; -procedure DisposePGDIObject(GDIObject: PGdiObject); +procedure InternalDisposePGDIObject(GDIObject: PGdiObject); begin {$IFDEF DebugLCLComponents} DebugGdiObjects.MarkDestroyed(GDIObject); @@ -605,7 +608,6 @@ begin DCFlags:=[]; end; - procedure GtkDefInit; begin {$IFDEF DebugLCLComponents} diff --git a/lcl/interfaces/gtk/gtklistsl.inc b/lcl/interfaces/gtk/gtklistsl.inc index 1a7c855064..bc6cb46979 100644 --- a/lcl/interfaces/gtk/gtklistsl.inc +++ b/lcl/interfaces/gtk/gtklistsl.inc @@ -437,6 +437,20 @@ var i: integer; begin if not (glsItemCacheNeedsUpdate in FStates) then exit; + + {$IFDEF DebugLCLComponents} + // if items were removed => mark them as destroyed + for i:=0 to FCachedCount-1 do begin + if (FGtkList=nil) + or (g_list_find(FGtkList^.children,FCachedItems[i])=nil) then begin + if DebugGtkWidgets.IsCreated(FCachedItems[i]) then begin + DebugLn(['TGtkListStringList.UpdateItemCache item vanished: ',i]); + DebugGtkWidgets.MarkDestroyed(FCachedItems[i]); + end; + end; + end; + {$ENDIF} + if (FGtkList<>nil) and (FGtkList^.children<>nil) then FCachedCount:=g_list_length(FGtkList^.children) else @@ -455,6 +469,13 @@ begin i:=0; while CurListItem<>nil do begin FCachedItems[i]:=PGtkListItem(CurListItem^.Data); + {$IFDEF DebugLCLComponents} + if not DebugGtkWidgets.IsCreated(PGtkListItem(CurListItem^.Data)) then + begin + DebugLn(['TGtkListStringList.UpdateItemCache unknown item ',i,' ',DbgSName(Owner)]); + DumpStack; + end; + {$ENDIF} inc(i); CurListItem:=CurListItem^.Next; end; diff --git a/lcl/interfaces/gtk/gtkobject.inc b/lcl/interfaces/gtk/gtkobject.inc index b5f98c8361..6e7677964f 100644 --- a/lcl/interfaces/gtk/gtkobject.inc +++ b/lcl/interfaces/gtk/gtkobject.inc @@ -515,6 +515,8 @@ begin FKeyStateList_.Free; {$ENDIF} FTimerData.Free; + + GtkDefDone; // finally remove our loghandler g_log_remove_handler(nil, FLogHandlerID); @@ -4230,6 +4232,7 @@ begin FFixWidgetsResized.Remove(FixWidget); // destroy the widget + //DebugLn(['TGtkWidgetSet.DestroyConnectedWidget ',GetWidgetDebugReport(Widget)]); DestroyWidget(Widget); // remove all remaining messages to this widget @@ -6103,16 +6106,8 @@ begin if Result then with PGdiObject(GDIObject)^ do case GDIType of - gdiBitmap : begin - case GDIBitmapType of - gbPixmap: Result := GDIPixmapObject <> nil; - gbBitmap: Result := GDIBitmapObject <> nil; - {obsolete: gbImage: Result := GDI_RGBImageObject <> nil;} - else - Result := False; - end; - end; - gdiBrush : Result := True; //Result := GDIBrushPixmap <> nil; //GDIBrushPixmap may be nil + gdiBitmap : Result:=true; + gdiBrush : Result := True; gdiFont : Result := GDIFontObject <> nil;// ToDo: create font on demand gdiPen : Result := True; gdiRegion : Result := True; @@ -6252,7 +6247,7 @@ end; function TGtkWidgetSet.NewDC: TDeviceContext; begin Assert(False, Format('Trace:> [TGtkWidgetSet.NewDC]', [])); - Result:=GtkDef.NewDeviceContext; + Result:=NewDeviceContext; with Result do begin {$ifdef TraceGdiCalls} @@ -6488,7 +6483,7 @@ end; function TGtkWidgetSet.NewGDIObject(const GDIType: TGDIType): PGdiObject; begin Assert(False, Format('Trace:> [TGtkWidgetSet.NewGDIObject]', [])); - Result:=GtkDef.NewPGDIObject; + Result:=GtkDef.InternalNewPGDIObject; {$ifdef TraceGdiCalls} FillStackAddrs(get_caller_frame(get_frame), @Result^.StackAddrs); {$endif} @@ -6511,7 +6506,7 @@ begin if FGDIObjects.Contains(GDIObject) then begin dec(GDIObject^.RefCount); FGDIObjects.Remove(GDIObject); - GtkDef.DisposePGDIObject(GDIObject); + GtkDef.InternalDisposePGDIObject(GDIObject); end else RaiseGDBException(''); end; diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc index dc6c7a48a5..92736b8ef8 100644 --- a/lcl/interfaces/gtk/gtkwinapi.inc +++ b/lcl/interfaces/gtk/gtkwinapi.inc @@ -4990,8 +4990,10 @@ begin then begin Widget := Window^.focus_widget; {$IFDEF DebugLCLComponents} - if DebugGtkWidgets.IsDestroyed(Widget) then - DebugLn('TGtkWidgetSet.GetFocus ',DebugGtkWidgets.GetInfo(Widget,true)); + if DebugGtkWidgets.IsDestroyed(Widget) then begin + DebugLn(['TGtkWidgetSet.GetFocus Window^.focus_widget was laready destroyed:']); + DebugLn(DebugGtkWidgets.GetInfo(Widget,true)); + end; {$ENDIF} if (Widget <> nil) and gtk_widget_has_focus(Widget) @@ -7901,8 +7903,20 @@ function TGtkWidgetSet.SelectObject(DC: HDC; GDIObj: HGDIOBJ): HGDIOBJ; begin DebugLn(['TGtkWidgetSet.SelectObject DC=',dbghex(DC),' IsValidDC(DC)=',IsValidDC(DC),' GDIObj=',dbghex(GDIObj),' IsValidGDIObject(GDIObj)=',IsValidGDIObject(GDIObj)]); DumpStack; + {$IFDEF DebugLCLComponents} + if not IsValidDC(DC) then begin + DebugLn(['DebugInvalidGDIObject DC:']); + debugln(DebugDeviceContexts.GetInfo(Pointer(DC),true)); + end; + if not IsValidGDIObject(GDIObj) then begin + DebugLn(['DebugInvalidGDIObject GDIObj:']); + debugln(DebugGdiObjects.GetInfo(Pointer(GDIObj),true)); + end; + {$ENDIF} end; +var + NewDrawable: PGdkPixmap; begin Result := 0; @@ -7922,28 +7936,36 @@ begin with TDeviceContext(DC) do begin Assert(False, Format('trace: [TGtkWidgetSet.SelectObject] DC: 0x%x, Type: Bitmap', [DC])); + if CurrentBitmap=nil then begin + // creating HBitmap on the fly (To find mem leaks) + CurrentBitmap:=NewGDIObject(gdiBitmap); + end; Result := HBITMAP(CurrentBitmap); if CurrentBitmap<>PGDIObject(GDIObj) then begin CurrentBitmap := PGDIObject(GDIObj); - if GC <> nil then begin - gdk_gc_unref(GC); - GC:=nil; - end; with CurrentBitmap^ do case GDIBitmapType of - gbPixmap: Drawable := GDIPixmapObject; - gbBitmap: Drawable := GDIBitmapObject; - {obsolete: gbImage: Drawable := nil;//GDI_RGBImageObject;} + gbPixmap: NewDrawable := GDIPixmapObject; + gbBitmap: NewDrawable := GDIBitmapObject; else - Drawable := nil; + NewDrawable := nil; end; - //DebugLn('TGtkWidgetSet.SelectObject DC=',DbgS(DC),8),' GDIBitmap=',DbgS(Cardinal(CurrentBitmap), - //' GDIBitmapType=',ord(CurrentBitmap^.GDIBitmapType),' Drawable=',DbgS(Drawable)); - - GC := gdk_gc_new(Drawable); - - gdk_gc_set_function(GC, GDK_COPY); - SelectedColors := dcscCustom; + if NewDrawable<>nil then begin + //DebugLn('TGtkWidgetSet.SelectObject DC=',DbgS(DC),8),' GDIBitmap=',DbgS(Cardinal(CurrentBitmap), + //' GDIBitmapType=',ord(CurrentBitmap^.GDIBitmapType),' Drawable=',DbgS(Drawable)); + if GC <> nil then begin + gdk_gc_unref(GC); + GC:=nil; + end; + Drawable:=NewDrawable; + GC := gdk_gc_new(Drawable); + gdk_gc_set_function(GC, GDK_COPY); + SelectedColors := dcscCustom; + end else begin + // use defaults, free dummy gdiobject + DisposeGDIObject(CurrentBitmap); + CurrentBitmap:=nil; + end; end; end; diff --git a/lcl/interfaces/gtk/gtkwsbuttons.pp b/lcl/interfaces/gtk/gtkwsbuttons.pp index c16161ad13..43684c8b52 100644 --- a/lcl/interfaces/gtk/gtkwsbuttons.pp +++ b/lcl/interfaces/gtk/gtkwsbuttons.pp @@ -130,6 +130,9 @@ begin Result := TLCLIntfHandle(gtk_button_new_with_label('button')); if Result = 0 then Exit; + {$IFDEF DebugLCLComponents} + DebugGtkWidgets.MarkCreated(Pointer(Result),'button'); + {$ENDIF} WidgetInfo := CreateWidgetInfo(Pointer(Result), Button, AParams); diff --git a/lcl/lclproc.pas b/lcl/lclproc.pas index 5977527146..fefe3a8ee2 100644 --- a/lcl/lclproc.pas +++ b/lcl/lclproc.pas @@ -91,6 +91,7 @@ type function FindInfo(p: Pointer; CreateIfNotExists: boolean = false ): TDebugLCLItemInfo; function IsDestroyed(p: Pointer): boolean; + function IsCreated(p: Pointer): boolean; function MarkCreated(p: Pointer; const InfoText: string): TDebugLCLItemInfo; procedure MarkDestroyed(p: Pointer); function GetInfo(p: Pointer; WithStackTraces: boolean): string; @@ -2393,27 +2394,31 @@ begin end; end; -function UTF8CStringToUTF8String(SourceStart: PChar; SourceLen: SizeInt) : string; +function UTF8CStringToUTF8String(SourceStart: PChar; SourceLen: SizeInt) : string; var Source: PChar; Dest: PChar; SourceEnd: PChar; CharLen: integer; + SourceCopied: PChar; // Copies from SourceStart till Source to Dest and updates Dest procedure CopyPart; inline; var CopyLength: SizeInt; begin - CopyLength := Source - SourceStart; + CopyLength := Source - SourceCopied; if CopyLength=0 then exit; - move(SourceStart^ , Dest^, CopyLength); + move(SourceCopied^ , Dest^, CopyLength); + SourceCopied:=Source; inc(Dest, CopyLength); end; begin - Source:= SourceStart; SetLength(Result, SourceLen); + if SourceLen=0 then exit; + SourceCopied:=SourceStart; + Source:=SourceStart; Dest:=PChar(Result); SourceEnd := Source + SourceLen; while Source/tools/install/cross_unix/ []$ ./build_linux_cross_win32_rpm.sh downloadbinutils downloadfpc buildbinutils -This will download the FPC svn to ~/freepascal/fpc. +This will download the FPC svn to ~/freepascal/fpc, its install files to +~/freepascal/install and the binutils to ~/freepascal/binutils. Create the fpc rpm and install it: @@ -21,3 +25,11 @@ Then build the fpc_crosswin32 rpm and install it: []$ sudo rpm -Uvh /RPMS/i386/fpc_crosswin32-.i386.rpm Now you can cross compile from linux to win32. + + +================================================================================ + +The following environment variables are handled: +The base directory BuildRoot. Default value is ~/freepascal + []$ export BuildRoot=/home/user/freepascal + diff --git a/tools/install/cross_unix/build_linux_cross_win32_rpm.sh b/tools/install/cross_unix/build_linux_cross_win32_rpm.sh index 920e994b2d..5e0aa96733 100755 --- a/tools/install/cross_unix/build_linux_cross_win32_rpm.sh +++ b/tools/install/cross_unix/build_linux_cross_win32_rpm.sh @@ -7,7 +7,9 @@ set -e #set -x # This is the root for all download and building directories -BuildRoot=~/freepascal +if [ ! -d "$BuildRoot" ]; then + BuildRoot=~/freepascal +fi #=============================================================================== # parse command line parameters diff --git a/tools/install/cross_unix/update_cross_fpc.sh b/tools/install/cross_unix/update_cross_fpc.sh index b7ab0c5df5..ba93e67ee6 100755 --- a/tools/install/cross_unix/update_cross_fpc.sh +++ b/tools/install/cross_unix/update_cross_fpc.sh @@ -7,7 +7,9 @@ set -e set -x # This is the root for all download and building directories -BuildRoot=~/freepascal +if [ ! -d "$BuildRoot" ]; then + BuildRoot=~/freepascal +fi # the binutils version to download BinutilsVersion=2.16