Внутри FreePascal Generics.Collections library (часть 2) - FreePascal - Каталог статей - Программирование и анализ электрических цепей

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

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

В модуле 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

        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)

Просмотров: 210 | Рейтинг: 0.0/0

Всего комментариев: 0