Главная » Статьи » FreePascal

Внутри FreePascal Generics.Collections library (часть 2)

2. Применение наследников класса TCustomComparer<T>

Часть 1.

В модуле Generics.Defaults объявляется абстрактный класс:

  TCustomComparer<T> =
       class(TSingletonImplementation, IComparer<T>, IEqualityComparer<T>, IExtendedEqualityComparer<T>)
  protected
    function Compare(constref Left, Right: T): Integer;           virtual; abstract;
    function Equals(constref Left, Right: T): Boolean;            reintroduce; overload; virtual; abstract;
    function GetHashCode(constref Value: T): UInt32;              reintroduce; overload; virtual; abstract;
    procedure GetHashList(constref Value: T; AHashList: PUInt32); virtual; abstract;
  end;

На основе этого класса объявляется и реализуется ряд классов, которые специализируются для встроенного хешера TDelphiQuadrupleHashFactory и строковых типов string, AnsiString и UnicodeString:

С учетом регистра Без учета регистра
 ♦ TStringComparer
 ♦ TAnsiStringComparer
 ♦ TUnicodeStringComparer
 ♦ TOrdinalStringComparer
 ♦ TIStringComparer
 ♦ TIAnsiStringComparer
 ♦ TIUnicodeStringComparer
 ♦ TIOrdinalStringComparer

Для специализации на конкретные типы данных и хешера в классе TOrdinalComparer<T, THashFactory> объявляется метод:

  TOrdinalComparer<T, THashFactory> = class(TCustomComparer<T>)
  public
    class function Ordinal: TCustomComparer<T>; virtual; abstract;
  end;

реализуемый затем в классах–наследниках TGStringComparer<T, THashFactory> и TGIStringComparer<T, THashFactory>.

Возвращаемые методом Ordinal классы являются наследниками TCustomComparer<T>, поэтому в них реализованы интерфейсы IEqualityComparer<T> и IExtendedEqualityComparer<T>. В связи с этим для тестирования применения указанных выше в таблице классов в тестовую программу нужно внести минимальные изменения — заменить строку 18:

18   iExtEqu := TAnsiStringComparer.Ordinal;

Однако первый же запуск привел к появлению сообщений об исключениях класса External:SIGSEGV в методах GetHashCode и GetHashList:

исключение в GetHashCode     исключение в GetHashList

Анализ этих методов показал, что в них выполняется вызов методов интерфейсов из переменных класса FEqualityComparer и FExtendedEqualityComparer, на момент вызова оба поля имели значение равное NIL. Эти поля инициализируются в конструкторе class constructor TOrdinalComparer<T, THashFactory>.Create;, который, как мы видим, объявлен как конструктор класса. Код в конструкторе, выполняющий инициализацию указанных полей, выглядит следующим образом:

  if THashFactory.InheritsFrom(TExtendedHashService) then begin
    FExtendedEqualityComparer := TExtendedEqualityComparer<T>.Default(TExtendedHashFactoryClass(THashFactory));
    FEqualityComparer := IEqualityComparer<T>(FExtendedEqualityComparer);
  end
  else
    FEqualityComparer := TEqualityComparer<T>.Default(THashFactory);

Сразу же видим, что в условном операторе шаблон THashFactory проверяется на наследование от класса TExtendedHashService, однако далее выполняется приведение к типу TExtendedHashFactoryClass, который объявлен как TExtendedHashFactoryClass = class of TExtendedHashFactory. Но TExtendedHashFactory является наследником THashFactory, предком которого является TObject. Поэтому заменяем проверку в условном операторе

  if THashFactory.InheritsFrom(TExtendedHashFactory) then begin …

Интерфейс, сохраняемый в поле FExtendedEqualityComparer, получается в результате вызова цепочки функций, в которых происходит специализация интерфейса в соответствии с типами входных данных <T> и хешера <THashFactory>:

FExtendedEqualityComparer := TExtendedEqualityComparer<T>.Default(TExtendedHashFactoryClass(THashFactory));

class function TExtendedEqualityComparer<T>.Default(AExtenedHashFactoryClass: TExtendedHashFactoryClass): IExtendedEqualityComparer<T>;
Result := _LookupVtableInfoEx(giExtendedEqualityComparer, TypeInfo(T), SizeOf(T), AExtenedHashFactoryClass);

function _LookupVtableInfoEx(AGInterface: TDefaultGenericInterface; ATypeInfo: PTypeInfo; ASize: SizeInt; AFactory: THashFactoryClass): Pointer;
  case AGInterface of
    giExtendedEqualityComparer:
      begin
        if AFactory = nil then AFactory := TDelphiDoubleHashFactory;
        Exit(TExtendedHashServiceClass(AFactory.GetHashService).LookupExtendedEqualityComparer(ATypeInfo, ASize));

class function TExtendedHashService<T>.LookupExtendedEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer;

В функции class function TExtendedHashService<T>.LookupExtendedEqualityComparer выполняется окончательное определение интерфейса по внутренним таблицам класса на основании информации о типе входных данных, передаваемой параметром ATypeInfo. Внутренние таблицы класса TExtendedHashService<T: TExtendedHashFactory> формируются на основании специализации по типу хешера <T: TExtendedHashFactory> и инициализируются в его конструкторе class constructor TExtendedHashService<T>.Create;, который объявлен как конструктор класса.

То есть, чтобы в конструкторе класса TOrdinalComparer<T, THashFactory> были правильно проинициализированы поля FExtendedEqualityComparer и FEqualityComparer, нужно чтобы этот конструктор вызывался после конструктора класса TExtendedHashService<T: TExtendedHashFactory>.

Чтобы проверить очередность вызовов всех этих конструкторов, в них были вставлен вывод отладочной информации. И вот что мы получаем при тестовом прогоне:

<<<<<< TOrdinalComparer<T, THashFactory>.Create
    ClassName = TOrdinalComparer<System.AnsiString,Generics.Defaults.TDelphiQuadrupleHashFactory>
    T type -> AnsiString
    THashFactory type -> TDelphiQuadrupleHashFactory


    <<<<<< TExtendedEqualityComparer<T>.Default
        ClassName = TExtendedEqualityComparer<System.AnsiString>
        T type -> AnsiString
        AExtenedHashFactoryClass type -> TExtendedHashFactoryClass

        <<<<<< TExtendedHashService<T>.LookupExtendedEqualityComparer
            ClassName = TExtendedHashService<Generics.Defaults.TDelphiQuadrupleHashFactory>
            T type -> TDelphiQuadrupleHashFactory
            Self type name: TExtendedHashService<Generics.Defaults.TDelphiQuadrupleHashFactory>
            Result = 0x00000000
        TExtendedHashService<T>.LookupExtendedEqualityComparer >>>>>>

        Result = 0x00000000
        Result type -> IExtendedEqualityComparer$1$crcB76584A7
    TExtendedEqualityComparer<T>.Default >>>>>>

    FEqualityComparer         = 0x00000000
    FExtendedEqualityComparer = 0x00000000
TOrdinalComparer<T, THashFactory>.Create >>>>>>


<<<<<< TOrdinalComparer<T, THashFactory>.Create
    ClassName = TOrdinalComparer<System.UnicodeString,Generics.Defaults.TDelphiQuadrupleHashFactory>
    T type -> UnicodeString
    THashFactory type -> TDelphiQuadrupleHashFactory


    <<<<<< TExtendedEqualityComparer<T>.Default
        ClassName = TExtendedEqualityComparer<System.UnicodeString>
        T type -> UnicodeString
        AExtenedHashFactoryClass type -> TExtendedHashFactoryClass

        <<<<<< TExtendedHashService<T>.LookupExtendedEqualityComparer
            ClassName = TExtendedHashService<Generics.Defaults.TDelphiQuadrupleHashFactory>
            T type -> TDelphiQuadrupleHashFactory
            Self type name: TExtendedHashService<Generics.Defaults.TDelphiQuadrupleHashFactory>
            Result = 0x00000000
        TExtendedHashService<T>.LookupExtendedEqualityComparer >>>>>>

        Result = 0x00000000
        Result type -> IExtendedEqualityComparer$1$crcFF9B7487
    TExtendedEqualityComparer<T>.Default >>>>>>

    FEqualityComparer         = 0x00000000
    FExtendedEqualityComparer = 0x00000000
TOrdinalComparer<T, THashFactory>.Create >>>>>>


<<<<<< THashService<T>.Create;
    ClassName = THashService<Generics.Defaults.TDelphiHashFactory>
    T type -> TDelphiHashFactory
THashService<T>.Create; >>>>>>


<<<<<< THashService<T>.Create;
    ClassName = THashService<Generics.Defaults.TGenericsHashFactory>
    T type -> TGenericsHashFactory
THashService<T>.Create; >>>>>>


<<<<<< THashService<T>.Create;
    ClassName = THashService<Generics.Defaults.TxxHash32HashFactory>
    T type -> TxxHash32HashFactory
THashService<T>.Create; >>>>>>


<<<<<< THashService<T>.Create;
    ClassName = THashService<Generics.Defaults.TxxHash32PascalHashFactory>
    T type -> TxxHash32PascalHashFactory
THashService<T>.Create; >>>>>>


<<<<<< THashService<T>.Create;
    ClassName = THashService<Generics.Defaults.TAdler32HashFactory>
    T type -> TAdler32HashFactory
THashService<T>.Create; >>>>>>


<<<<<< THashService<T>.Create;
    ClassName = THashService<Generics.Defaults.TSdbmHashFactory>
    T type -> TSdbmHashFactory
THashService<T>.Create; >>>>>>


<<<<<< THashService<T>.Create;
    ClassName = THashService<Generics.Defaults.TSimpleChecksumFactory>
    T type -> TSimpleChecksumFactory
THashService<T>.Create; >>>>>>


<<<<<< TExtendedHashService<T>.Create
    ClassName = TExtendedHashService<Generics.Defaults.TDelphiDoubleHashFactory>
    T type -> TDelphiDoubleHashFactory
TExtendedHashService<T>.Create >>>>>>


<<<<<< TExtendedHashService<T>.Create
    ClassName = TExtendedHashService<Generics.Defaults.TDelphiQuadrupleHashFactory>
    T type -> TDelphiQuadrupleHashFactory
TExtendedHashService<T>.Create >>>>>>


<<<<<< TExtendedHashService<T>.Create
    ClassName = TExtendedHashService<Generics.Defaults.TDelphiSixfoldHashFactory>
    T type -> TDelphiSixfoldHashFactory
TExtendedHashService<T>.Create >>>>>>

-------------- PASCAL MAIN --------------

<<<<<< TGStringComparer<T, THashFactory>.Ordinal
    ClassName = TAnsiStringComparer
    T type -> AnsiString
    THashFactory type -> TDelphiQuadrupleHashFactory
    FEqualityComparer         = 0x00000000
    FExtendedEqualityComparer = 0x00000000

    FOrdinal = 0x000B3720
    FOrdinal type -> TCustomComparer$1$crcB76584A7
    FOrdinal ClassName -> TGOrdinalStringComparer<System.AnsiString,Generics.Defaults.TDelphiQuadrupleHashFactory>
TGStringComparer<T, THashFactory>.Ordinal >>>>>>


<<<<<< TGOrdinalStringComparer<T, THashFactory>.GetHashCode
    ClassName = TGOrdinalStringComparer<System.AnsiString,Generics.Defaults.TDelphiQuadrupleHashFactory>
    T type -> AnsiString
    THashFactory type -> TDelphiQuadrupleHashFactory
    FEqualityComparer         = 0x00000000
    FExtendedEqualityComparer = 0x00000000

Из отладочного листинга видно, что конструкторы класса TOrdinalComparer<T, THashFactory> вызывались до вызова конструкторов класса TExtendedHashService<T: TExtendedHashFactory>, то есть правильная работа всех классов–наследников TOrdinalComparer<T, THashFactory> в принципе невозможна при такой организации инициализации generic'ов.

Насколько я понимаю, последовательность вызовов конструкторов класса определяется компилятором, и ни в одном гайде по FPC я не видел возможности управлять этой последовательностью, если они описаны в одном модуле. Последовательность вызовов инициализации формируется в таблице InitFinalTable : TInitFinalTable;external name 'INITFINAL', которая формируется компиляторов и обрабатывается на этапе инициализации программы внутренней процедурой procedure fpc_InitializeUnits;[public,alias:'FPC_INITIALIZEUNITS']; compilerproc;.

Таблица INITFINAL

.section .data.n_INITFINAL,"d"
    .balign 4
.globl    INITFINAL
INITFINAL:
    .long    34,0
    .long    INIT$_$SYSTEM
    .long    0,0
    .long    FINALIZE$_$OBJPAS
    .long    INIT$_$LINEINFO
    .long    FINALIZE$_$LINEINFO
    .long    INIT$_$FPINTRES
    .long    0,0
    .long    FINALIZE$_$WINDIRS
    .long    SYSUTILS$_$TENCODING_$__$$_create
    .long    SYSUTILS$_$TENCODING_$__$$_destroy
    .long    INIT$_$SYSUTILS
    .long    FINALIZE$_$SYSUTILS
    .long    INIT$_$TYPINFO
    .long    FINALIZE$_$TYPINFO
    .long    INIT$_$CLASSES
    .long    FINALIZE$_$CLASSES
    .long    INIT$_$FPCADDS
    .long    0,0
    .long    FINALIZE$_$GETTEXT
    .long    INIT$_$LAZUTF8
    .long    FINALIZE$_$LAZUTF8
    .long    INIT$_$GENERICS.HASHES
    .long    0
    .long    INIT$_$VARIANTS
    .long    FINALIZE$_$VARIANTS
    .long    INIT$_$MYDEBUG
    .long    FINALIZE$_$MYDEBUG
    .long    GENERICS.DEFAULTS$_$TORDINALCOMPARER$2$CRC09680922_$__$$_create
    .long    0,0
    .long    GENERICS.DEFAULTS$_$TGSTRINGCOMPARER$2$CRC09680922_$__$$_destroy
    .long    GENERICS.DEFAULTS$_$TORDINALCOMPARER$2$CRC603AE4FA_$__$$_create
    .long    0,0
    .long    GENERICS.DEFAULTS$_$TGSTRINGCOMPARER$2$CRC603AE4FA_$__$$_destroy
    .long    0
    .long    GENERICS.DEFAULTS$_$TGISTRINGCOMPARER$2$CRC09680922_$__$$_destroy
    .long    0
    .long    GENERICS.DEFAULTS$_$TGISTRINGCOMPARER$2$CRC603AE4FA_$__$$_destroy
    .long    0
    .long    GENERICS.DEFAULTS$_$TGORDINALIUTF8STRINGCOMPARER$2$CRC09680922_$__$$_destroy
    .long    GENERICS.DEFAULTS$_$THASHSERVICE$1$CRC7AF4B9A0_$__$$_create
    .long    0
    .long    GENERICS.DEFAULTS$_$THASHSERVICE$1$CRCAF470C84_$__$$_create
    .long    0
    .long    GENERICS.DEFAULTS$_$THASHSERVICE$1$CRCDF087BA2_$__$$_create
    .long    0
    .long    GENERICS.DEFAULTS$_$THASHSERVICE$1$CRCD50C886D_$__$$_create
    .long    0
    .long    GENERICS.DEFAULTS$_$THASHSERVICE$1$CRC8900BCA3_$__$$_create
    .long    0
    .long    GENERICS.DEFAULTS$_$THASHSERVICE$1$CRCF6051FCB_$__$$_create
    .long    0
    .long    GENERICS.DEFAULTS$_$THASHSERVICE$1$CRC35C38E37_$__$$_create
    .long    0
    .long    GENERICS.DEFAULTS$_$TEXTENDEDHASHSERVICE$1$CRC39B9833B_$__$$_create
    .long    0
    .long    GENERICS.DEFAULTS$_$TEXTENDEDHASHSERVICE$1$CRCC50F5DF8_$__$$_create
    .long    0
    .long    GENERICS.DEFAULTS$_$TEXTENDEDHASHSERVICE$1$CRCBE4A9104_$__$$_create
    .long    0
    .long    INIT$_$GENERICS.DEFAULTS
    .long    FINALIZE$_$GENERICS.DEFAULTS
    .long    INIT$_$P$TESTGCM
    .long    FINALIZE$_$P$TESTGCM

Красным цветом в таблице отмечены конструкторы классов для generic'ов модуля Generics.Defaults, которые вызываются при инициализации программы. Из 26-ти вызовов процедур инициализации 12 — это вызовы данных конструкторов. В случае применения класса TExtendedEqualityComparer<T> (см. часть 1) таблица INITFINAL абсолютно идентична, приведенной выше.

Кроме того мне не очень нравится, что на этапе инициализации программы отрабатываются конструкторы классов для специализации ВСЕХ типов, описанных в модуле Generics.Defaults, даже тех, которые в программе не используются.

Один из путей исправления ситуации будет описан в следующей части.

Продолжение: часть 3.

 

К началу

Категория: FreePascal | Добавил: zoleg5763 (01.04.2019)
Просмотров: 214 | Рейтинг: 0.0/0
Всего комментариев: 0
avatar