I’ve discovered that a service derived from another service will not have the relationship defined correctly in the dynamically Code First generated RODL. The reason is that in TRORTTIRODLReader.DoProcess the base service comes later in the list generated by FindAllROTypes. Then TRORTTIRODLReader.GenerateService will not find the base service.
Is this a known issue? Any reason to try the latest beta?
This is on latest official Delphi version.
BTW. In FindAllRoTypes a lpossibleTypes variable is declared and constructed but never used as far I can see.
I’ve made a small test application, but there it doesn’t occur. So I’m not able to reproduce just now. But it’s certainly a problem in our application, and I’m trying to figure out if RTTI types are ordered or not. One should believe that the unit initialization order was used. Then the base class would come before derived classes.
To test I added a RTTI dispatcher on my service and it clearly shows that you can’t trust that the classes comes in “correct” order from the RTTI context. So then your Code First RODL generation can eventually in detecting inheritance on services (and perhaps complex types as well).
I’ve not been able to reproduce this behaviour in a test case, and I can’t think of a way to modify the order of classes that comes from the RTTI context.
If you like I can send you the complete list of RTTI information from our server in XML format.
I’m not either able to reproduce in a small test project similar to yours. But by experience in our application, it’s a fact that you it can’t be trusted that the classes returned from RTTI is sorted so that parent classes always comes before derived. And if they don’t, your code will fail.
I’ve solved the problem by using av function that returns instances types sorted by inheritance. I changed the uRoRTTIServerSupport.FindAllROTypes to use it (and guess what - the dangling lpossibleTypes variable mentioned before came to use). This should be optimized a bit, but for now it solves our problem.
function GetSortedRTTIInstances(const aTypes: TArray<TRTTIType>): TList<TRttiInstanceType>;
var
vInstance: TRttiInstanceType;
vSortList: TStringList;
vType: TRttiType;
I: Integer;
function _GetSortPath(const aInstance: TRttiInstanceType):string;
var
vTxt: string;
begin
if Assigned(aInstance) then
begin
vTxt := _GetSortPath(aInstance.BaseType);
if vTxt > '' then
result := vTxt + '|' + aInstance.QualifiedName
else
result :=aInstance.QualifiedName;
end
else
result := '';
end;
begin
vSortList := TStringList.Create;
try
for vType in aTypes do
begin
if not vType.IsInstance then continue;
// Todo: Filter RoClasses
vInstance := vType.AsInstance;
vSortList.AddObject(_GetSortPath(vInstance),vInstance);
end;
vSortList.Sort;
Result := TList<TRttiInstanceType>.Create;
for I := 0 to vSortList.Count-1 do
Result.Add(TRttiInstanceType(vSortlist.Objects[i]));
finally
vSortList.Free;
end;
end;
function FindAllROTypes: TArray<TRttiType>;
procedure CheckForType(aType: TRTTIType; aList: TList<TRttiType>); forward;
procedure AddType(aType: TRTTIType; aList: TList<TRttiType>);
begin
if __CheckForClassAndOrdinal(aType) then
if not aList.Contains(aType) then begin
aList.Add(aType);
CheckForType(aType, aList);
end;
end;
procedure CheckForType(aType: TRTTIType; aList: TList<TRttiType>);
var
l1 : TRttiType;
lt: TRttiInstanceType;
pt: TRttiProperty;
ip: TRttiIndexedProperty;
begin
if aType.IsInstance then begin
lt := aType.AsInstance;
{$IFDEF DELPHI10UP}{$REGION 'array'}{$ENDIF}
if isROArray(lt.MetaclassType) then begin
if Assigned(aType.ROGetAttribute<ROSkipAttribute>()) then exit;
ip:= lt.GetIndexedProperty('Items');
if Assigned(ip) then
l1 := ip.PropertyType
else
l1 := g_ctx.GetType(TROArrayClass(lt.MetaclassType).GetItemType);
AddType(l1, alist);
end
{$IFDEF DELPHI10UP}{$ENDREGION}{$ENDIF}
{$IFDEF DELPHI10UP}{$REGION 'complex type & exceptions'}{$ENDIF}
else if isROCompexType(lt.MetaclassType) or
isROException(lt.MetaclassType) then begin
if Assigned(aType.ROGetAttribute<ROSkipAttribute>()) then exit;
for pt in lt.GetProperties do
if CanProcessProperty(pt) then
AddType(pt.PropertyType, aList);
end;
{$IFDEF DELPHI10UP}{$ENDREGION}{$ENDIF}
end;
end;
var
l,l1: TRttiType;
s: TList<TRttiType>;
m: TRttiMethod;
par: TRttiParameter;
lpossibleTypes: TList<TRttiInstanceType>;
li: TRttiInstanceType;
begin
s := TList<TRttiType>.Create;
lpossibleTypes := GetSortedRTTIInstances(g_ctx.GetTypes);//TList<TRttiInstanceType>.Create;
try
for li in lpossibleTypes do begin
l := li; // TODO:
if l.IsInstance then begin
//li := l.AsInstance;
if __CheckForService(li) then begin
if Assigned(l.ROGetAttribute<ROSkipAttribute>()) then Continue;
s.Add(l);
// check for classes used in methods of RTTI service
for m in FindROServiceMethods(li,False) do begin
// parameters
for par in m.GetParameters do AddType(par.ParamType, s);
// result
if Assigned(m.ReturnType) then AddType(m.ReturnType, s);
end;
end
else if __CheckForRODLService(li) then begin
if Assigned(l.ROGetAttribute<ROSkipAttribute>()) then Continue;
// check for classes used in methods of RODL service
for m in FindROServiceMethods(li,False) do begin
// parameters
for par in m.GetParameters do AddType(par.ParamType, s);
// result
if Assigned(m.ReturnType) then AddType(m.ReturnType, s);
end;
end
else if isROServerException(li.MetaclassType) {or isROCompexType(li.MetaclassType)} then
if not Assigned(l.ROGetAttribute<ROSkipAttribute>()) then AddType(li, s);
end
else if (l is TRttiInterfaceType) then begin
if isROEventSink(l as TRttiInterfaceType) then begin
if Assigned(l.ROGetAttribute<ROSkipAttribute>()) then Continue;
s.Add(l);
for m in l.GetMethods do begin
// parameters
for par in m.GetParameters do AddType(par.ParamType, s);
// result
if Assigned(m.ReturnType) then AddType(m.ReturnType, s);
end;
end;
end;
end;
for li in lpossibleTypes do begin
l := li;
if (l.IsInstance) and isROCompexType(l.AsInstance.MetaclassType) and not isROArray(l.AsInstance.MetaclassType) then begin
for l1 in s do
if l1.IsInstance then
if isROCompexType(l1.AsInstance.MetaclassType) then
if l1.AsInstance.MetaclassType.InheritsFrom(l.AsInstance.MetaclassType) or
l.AsInstance.MetaclassType.InheritsFrom(l1.AsInstance.MetaclassType) then AddType(l,s);
end;
end;
SetLength(Result, s.Count);
result := s.ToArray;
finally
s.Free;
lpossibleTypes.Free;
end;
end;