freepascal.ru

Добрый день,
вопрос простой. Попробую на примере.
Евть в $FPCDIR/fcl-web/src/websocket/fpwebsocketclient.pp вот такой вот класс

Код: Выделить всё

  TWSThreadMessagePump = Class(TWSMessagePump)
  Private
    FThread : TThread;
    Procedure ThreadTerminated(Sender : TObject);
  Protected
    Type
      TMessageDriverThread = Class(TThread)
      Public
        FPump : TWSThreadMessagePump;
        Constructor Create(aPump : TWSThreadMessagePump; aTerminate : TNotifyEvent);
        Procedure Execute;override;
      End;
  Public
    Procedure Execute; override;
    Procedure Terminate; override;
  End;

Нужно в моем классе перекрыть TMessageDriverThread.Execute , ну скажем чтобы вебсок клиент посылал серверу пинг, и если сервер отвалится, то отбой.
Как нужно извратиться? Пробовал так, но ругается, что не видит TMessageDriverThread, хотя у анцестора TWSThreadMessagePump он в protected.

Код: Выделить всё

unit myunit
interface
uses fpwebsocketclient;
type
  TMyWSMsgPump_descendant = class (TWSThreadMessagePump )
  protected
    type
      TMyDrvThread_descendant = Class(TMessageDriverThread )
      Public
        Procedure Execute;override;
      End;   
  end;
....
interface
Procedure TMyWSMsgPump_descendant.TMessageDriverThread.Execute;
begin
  inherited;
......
end;

implementation
----
end;


Class(TWSThreadMessagePump.TMessageDriverThread )
?

sts писал(а):Class(TWSThreadMessagePump.TMessageDriverThread )

Ну это я попробовал самым первым образом, даже

sts писал(а):Class(TMyWSMsgPump_descendant.TMessageDriverThread )

Verbose: Free Pascal Compiler version 3.3.1 [2023/04/13] for x86_64
Verbose: Copyright (c) 1993-2022 by Florian Klaempfl and others
Verbose: Target OS: Win64 for x64
Verbose: Compiling project1.ppr
project1.ppr(11,60) Error: Identifier not found "TMessageDriverThread"
project1.ppr(11,80) Error: Class type expected, but got "<erroneous type>"
project1.ppr(13,19) Error: There is no method in an ancestor class to be overridden: "Execute;"
project1.ppr(21,15) Error: Identifier idents no member "Execute"
project1.ppr(30,0) Verbose: There were 4 errors compiling module, stopping
Verbose: Compilation aborted

Хотел положить во вложение ppr, но злой админ запрещает. Поэтому вставляю как код

Код: Выделить всё

program project1;

uses
  fpwebsocketclient;

type
  TMyWSMsgPump_descendant = class(TWSThreadMessagePump)
  protected
    type
      { TMyDrvThread_descendant }
      TMyDrvThread_descendant = class(TWSThreadMessagePump.TMessageDriverThread)
      public
        procedure Execute; override;
      end;
  end;

  { TMyWSMsgPump_descendant.TMyDrvThread_descendant }

  procedure TMyWSMsgPump_descendant.TMyDrvThread_descendant.Execute;
  begin
    inherited Execute;
  end;

var
  X: TMyWSMsgPump_descendant;
begin
  X := TMyWSMsgPump_descendant.Create(nil);
  X.Free;
end.


Похоже на глюк компилятора.

Код: Выделить всё

{$mode objfpc}
program test6;

type
  Class1 = class
  protected
    type
      Class2 = class
        procedure find; virtual;
      end;
    var
      b: Class2;
  end;

  Class3 = class(Class1)
  protected
    type
      Class4 = class(Class2)
        procedure find; override;
      end;
    var
      c: Class4;
  end;

procedure Class1.Class2.find;
  begin
    WriteLn('Class1.Class2.find');
  end;

procedure Class3.Class4.find;
  begin
    inherited;
    WriteLn('Class3.Class4.find');
  end;

var
  a: Class3;

begin
  a := Class3.Create;
  a.c := a.Class4.Create;
  a.c.find;
end.

вот это работает

Добавлено спустя 2 минуты 58 секунд:
fpc3.0.4

Добавлено спустя 2 минуты 56 секунд:

Код: Выделить всё

  Class3 = class(Class1)
  protected
    type
      Class4 = class(Class3.Class2)
        procedure find; override;
      end;
    var
      c: Class4;
  end;

тоже
хм

А если Class1 будет объявлен в другом модуле?

Да, наверное, это баг, ща зарепорчу. Можно обойти как:

Код: Выделить всё

type
  TMyWSMsgPump_descendant = class (TWSThreadMessagePump )
  protected
    type
      Local_TMessageDriverThread = TMessageDriverThread;
      TMyDrvThread_descendant = Class(Local_TMessageDriverThread )
      Public
        Procedure Execute;override;
      End;   
  end;


runewalsh писал(а):Да, наверное, это баг, ща зарепорчу.

Спасибо.
А в fpwebsocketclient.pp еще и баг с потоком TMessageDriverThread у TWSThreadMessagePump. При освобождении формуляра все время падает.