TRORttiClientCache.GetProperties_OriginalSort still incorrectly works

Hello

Our testing of the new BETA (RO_VERSION = ‘9.5.0.1367’) shown that the TRORttiClientCache.GetProperties_OriginalSort method still incorrectly works (our initial topic is here).

Please, look at the attached patch GetProperties_OriginalSort.pas (2.8 KB). It solves the issue.

We hope that it will help you.

regards

Hi,

Can you create a simple testcase that shows that somethings works incorrectly, pls?

Hi,

to face the bug it’s need to have simultaneously two kinds of clients. The first SOAP client uses “strictOrder=true” and the second one is REST and uses “strictOrder=false” (in our case C# and Angular).

This workflow leads to the problem:

  1. Run client (1) -> a strict set of properties is put in fProperties_strict
  2. Run client (2) -> the SAME strict set from fProperties_strict is sorted and its reference is added to fProperties.
  3. Run client (1) again -> fProperties_strict contains the SORTED set of properties = BUG.

regards

Hi,

can you test this code in your environment, pls?
it should fix this issue.

TRORttiClientCache.GetProperties_OriginalSort
function TRORttiClientCache.GetProperties_OriginalSort(const aType: TRttiType;
  const aStrictOrder: Boolean): TArray<TRttiProperty>;
var
  flat: TArray<TArray<TRttiProperty>>;
  t: TRttiType;
  depth: Integer;
  dc: TDelegatedComparer<TRttiProperty>;
  ah: TList<TRttiProperty>;
  p: TRttiProperty;
  lResult: TArray<TRttiProperty>;
begin
  Result := nil;
  BeginRead;
  try
    if aStrictOrder then begin
      if fProperties_strict.TryGetValue(aType, result) then exit;
    end
    else begin
      if fProperties.TryGetValue(aType, result) then exit;
    end;

    if not fProperties_strict.TryGetValue(aType, result) then begin
      BeginWrite;
      try
        if not fProperties_strict.TryGetValue(aType, result) then begin
          t := aType;
          depth := 0;
          while t <> nil do
          begin
            Inc(depth);
            t := t.BaseType;
          end;

          SetLength(flat, depth);
          t := aType;
          while t <> nil do
          begin
            flat[depth-1] := t.GetDeclaredProperties;
            Dec(depth);
            t := t.BaseType;
          end;

          Result := TArrayHelper.Concat<TRttiProperty>(flat);
          ah := TList<TRttiProperty>.Create;
          try
            for p in result do
              if CanProcessProperty(p) then ah.Add(p);
            Result := ah.ToArray;
          finally
            ah.Free;
          end;
          fProperties_strict.Add(aType,result);
        end;
      finally
        EndWrite;
      end;
    end;

    if not aStrictOrder then begin
      BeginWrite;
      try
        if not fProperties.TryGetValue(aType, lResult) then begin
          dc := TDelegatedComparer<TRttiProperty>.Create(
            function (const Left, Right: TRttiProperty): Integer
            begin
              Result := CompareText(Left.Name, Right.Name);
            end);
          try
            SetLength(lResult, Length(result));
            if Length(result) > 0 then 
              TArray.Copy<TRttiProperty>(result, lResult, Length(result));
            result := lResult;
            TArray.Sort<TRttiProperty>(result, dc);
          finally
            dc.Free;
          end;
          fProperties.Add(aType,result);
        end
        else
          result := lResult;
      finally
        EndWrite;
      end;
    end;
  finally
    EndRead;
  end;
end;

I think there must be a check for Length(result) > 0 before doing the Copy. I get OutOfRange exception on a Exception class if not.

thx, will add

@apustotin: can you retest this fix in your environment, pls?

Hi Evgeny

I will be able to test this patch for next two days. I will inform you on results.

regards

I have checked our use cases and they properly work.
I assume that the patched code above will be part of the next version as it is, right?

regards

you are right. it will be in next beta