mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-12 08:30:25 +02:00
dbc410de63
* symtable.pas:
+ add function "get_generic_in_hierarchy_by_name" which returns a def with the name of the symbol in the given object/record hierarchy (useful only in non-Delphi modes)
+ add function "return_specialization_of_generic" which returns the specialization def of a given class inside the given object/record hierarchy
* pexpr.pas, factor, factor_read_id: instead of checking whether the names of the found symbol and the current_structdef are equal, check whether the generic appears in hierarchy of current_structdef
* ptype.pas:
* id_type: check whether the found symbol is a generic dummy and we are currently parsing a generic then return the correct def of the generic instead of the dummy one
* single_type: when using the generic type without type parameters the def must resolve to the specialized def when specializing the class instead of the generic def which the dummy symbol points to
* read_named_type, expr_type: like in "single_type" we need to resolve the use of the parameterless type name to the correct specialization def instead of the generic def
* pdecobj.pas, object_dec: also set the typesym of the current_structdef as otherwise some assumptions about generics with the above mentioned changes aren't valid anymore (like the def the typesym is unset again afterwards)
+ add tests for both bug reports (the one for 19499 is slightly modified so that it does not contain any errors)
git-svn-id: trunk@21361 -
103 lines
1.7 KiB
ObjectPascal
103 lines
1.7 KiB
ObjectPascal
unit tw18688;
|
|
|
|
{$mode delphi}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils;
|
|
|
|
type
|
|
|
|
IValueHolder<T> = interface
|
|
function GetT:T;
|
|
procedure SetT(NewValue:T);
|
|
end;
|
|
|
|
TValueHolder <T> = class (TInterfacedObject, IValueHolder<T>)
|
|
private
|
|
FValue: T;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function GetT:T;
|
|
procedure SetT(NewValue:T);
|
|
end;
|
|
|
|
RValueHolder<T> = record
|
|
private
|
|
type
|
|
_IValueHolder = IValueHolder<T>;
|
|
_TValueHolder = TValueHolder<T>;
|
|
var
|
|
Ptr: _IValueHolder;
|
|
|
|
function GetImpl: _IValueHolder;
|
|
public
|
|
|
|
class operator Implicit (a:RValueHolder<T>):T; inline;
|
|
class operator Implicit (a:T):RValueHolder<T>; inline;
|
|
|
|
function GetValue:T; inline;
|
|
property V:T read GetValue;
|
|
end;
|
|
|
|
//TObjectValue = TValueHolder<TObject> ; // works if not commented
|
|
TObjectValue2 = RValueHolder<TObject> ;
|
|
|
|
|
|
implementation
|
|
|
|
constructor TValueHolder <T>.Create;
|
|
begin
|
|
FValue := nil
|
|
end;
|
|
|
|
destructor TValueHolder <T>.Destroy;
|
|
begin
|
|
FreeAndNil(FValue);
|
|
inherited;
|
|
end;
|
|
|
|
|
|
function TValueHolder <T>.GetT:T;
|
|
begin
|
|
Result := FValue;
|
|
end;
|
|
|
|
procedure TValueHolder <T>.SetT(NewValue:T);
|
|
begin
|
|
if FValue <> NewValue then
|
|
begin
|
|
FreeAndNil(FValue);
|
|
FValue := NewValue;
|
|
end;
|
|
end;
|
|
|
|
function RValueHolder<T>.GetImpl: _IValueHolder;
|
|
begin
|
|
if Pointer(Ptr) = nil then
|
|
begin
|
|
Ptr := _TValueHolder.Create;
|
|
end;
|
|
Result := Ptr;
|
|
end;
|
|
|
|
class operator RValueHolder<T>.Implicit (a:RValueHolder<T>):T;
|
|
begin
|
|
Result:=a.V;
|
|
end;
|
|
|
|
class operator RValueHolder<T>.Implicit (a:T):RValueHolder<T>;
|
|
begin
|
|
Result.GetImpl.SetT(a);
|
|
end;
|
|
|
|
function RValueHolder<T>.GetValue:T;
|
|
begin
|
|
Result := GetImpl.GetT;
|
|
end;
|
|
|
|
end.
|
|
|