* Test for mantis 14798

git-svn-id: trunk@14166 -

.gitattributes

@@ -10021,6 +10021,7 @@ tests/webtbs/tw14740.pp svneol=native#text/plain
 tests/webtbs/tw14743.pp svneol=native#text/pascal
 tests/webtbs/tw1477.pp svneol=native#text/plain
 tests/webtbs/tw1479.pp svneol=native#text/plain
+tests/webtbs/tw14798.pp svneol=native#text/plain
 tests/webtbs/tw14812.pp svneol=native#text/plain
 tests/webtbs/tw1485.pp svneol=native#text/plain
 tests/webtbs/tw1489.pp svneol=native#text/plain

tests/webtbs/tw14798.pp

@@ -0,0 +1,133 @@
+{ Source provided for Free Pascal Bug Report 14708 }
+{ Submitted by "Anton Kavalenka" on  2009-11-11 }
+{ e-mail:  }
+program tw14709;
+
+{$mode delphi}{$H+}
+{$apptype console}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Classes,Sysutils
+  { you can add units after this };
+
+var ok : boolean = true;
+
+type
+  TIntComponent=class(TComponent)
+  public
+    procedure DoChange(Sender:TObject);
+  end;
+
+  TTestComponent=class(TComponent)
+  private
+    fButton,
+    fEdit:TIntComponent;
+    fOnChangeButton,fOnChangeEdit:TNotifyEvent;
+    fStr:string;
+  public
+    constructor Create(AnOwner:TComponent);override;
+    procedure GetChildren(Proc: TGetChildProc; Root: TComponent);override;
+    procedure Change;
+  published
+    property Str:string read fStr write fStr;
+    property OnChangeButton:TNotifyEvent read fOnChangeButton write fOnChangeButton;
+    property OnChangeEdit:TNotifyEvent read fOnChangeEdit write fOnChangeEdit;
+  end;
+
+procedure TIntComponent.DoChange(Sender:TObject);
+begin
+  writeln(Self.className+' reports that '+Sender.ClassName+' changed');
+end;
+
+constructor TTestComponent.Create(AnOwner:TComponent);
+begin
+  inherited Create(AnOwner);
+  fStr:='Test string';
+  fButton:=TIntComponent.Create(Self);
+  fOnChangeButton:=fButton.DoChange;
+
+  fEdit:=TIntComponent.Create(Self);
+  fOnChangeEdit:=fEdit.DoChange;
+end;
+
+procedure TTestComponent.GetChildren(Proc: TGetChildProc; Root: TComponent);
+var
+  i:integer;
+begin
+ { for i:=0 to Componentcount-1 do
+  Proc(Components[i]);
+  }
+end;
+
+procedure TTestComponent.Change;
+begin
+  writeln(format('OnChangeButton code=%x data=%x',
+    [ptruint(TMethod(fOnChangeButton).Code),
+     ptruint(TMethod(fOnChangeButton).Data)]));
+  writeln(format('OnChangeEdit code=%x data=%x',
+    [ptruint(TMethod(fOnChangeEdit).Code),
+     ptruint(TMethod(fOnChangeEdit).Data)]));
+
+  if Assigned(OnChangeButton) then
+    OnChangeButton(Self)
+  else
+    begin
+
+      writeln('OnChangeButton handler is clear');
+      ok:=false;
+    end;
+  if Assigned(OnChangeEdit) then
+    OnChangeEdit(Self)
+  else
+    begin
+
+      writeln('OnChangeEdit handler is clear');
+      ok:=false;
+    end;
+end;
+
+var
+  tc:TTestComponent;
+  ms,os,f:TStream;
+begin
+  RegisterClasses([TTestComponent,TIntComponent]);
+  tc:=TTestComponent.Create(nil);
+  writeln('Testing....');
+  tc.Change;
+  ms:=TmemoryStream.Create;
+  ms.WriteComponent(tc);
+  writeln('Cleanup...');
+  tc.free;
+  ms.Position:=0;
+
+  writeln('Dumping streamed object as text:');
+  
+  f:=TFileStream.Create('dump.bin',fmCreate);
+  f.CopyFrom(ms,ms.size);
+  f.free;
+  
+  
+  ms.Position:=0;
+  os:=TMemoryStream.Create;
+  ObjectBinaryToText(ms,os);
+  os.Position:=0;
+  repeat
+    write(char(os.ReadByte));
+  until os.Position>=os.Size;
+  writeln();
+
+  ms.Position:=0;
+  tc:=TTestComponent(ms.ReadComponent(nil));
+  writeln('Just read, testing ...');
+  tc.Change;
+
+  tc.free;
+  ms.free;
+  os.Free;
+  if not ok then 
+    halt(1);
+end.
+