Weird intermittent failure with TRTTIContext.FindType 1

[Griffyn]

Code snippet:

uses
  RTTI;

var
  ctx: TRTTIContext;
  rct: TRTTIType;
  cn: String;
begin
  // Lookup value and assign to cn;
  // ... snip ...
  rct := ctx.FindType(cn);
  Assert(Assigned(rct));
end;

The code above is run via TIdHTTPServer.OnCommandGet, so is running in a separate thread. It works most of the time, but during testing, I noticed these 404 errors come up that I traced back to rct=nil in the code above. Maybe once every 15 times. The thread is launched via a bunch of almost identical ajax calls (in my tests, the code above is being called 3 times almost at once), so I'm thinking that it's some multi-threading issue with the RTTI unit. But my understanding is that it's thread-safe.

Anyone else had trouble like this?

 

[Griffyn]

I should have tested further prior to posting. I can confirm that by using a TCriticalSection to prevent multi-threading during FindType, the issue goes away.

 

[whosrdaddy]

RTTI is known to be threadsafe.
Is that all your code you are showing?

/Daddy

-----------------------------------------------------
Helping people is my job...

 

[Griffyn]

There's obviously more around it, but the only change I made, and the code I have now is

// ... snip ...
FBlock.Acquire;    // TCriticalSection
try
  rct := ctx.FindType(cn);
finally
  FBlock.Release;
end;
// ... snip ...

And it hasn't faulted during testing. Using Delphi XE6.

 

[whosrdaddy]

Hi Griffyn,

I see, but you are not answering my question,
RTTI is known to be threadsafe, so ctx.FindType() always works.
That being said, the part where you lookup cn could not be threadsafe and this can lead to a wrong value in cn so that FindType fails.
That's why I asked you to provide all possible details

/Daddy



-----------------------------------------------------
Helping people is my job...

 

[Griffyn]

cn is a local variable. There are no class fields being used, all variables are local. In my tests, I added lots of logging, and could see that cn would always have the correct value, but rct would occasionally be nil after FindType.

Full method:

[b]procedure[/b] TNexusMaintenanceLogic.HTTPCatchAllRequestEvent(AIP: String;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo;
  [b]var[/b] AErrorNo: Integer);
[b]var[/b]
  up : TUserProfile;
  cn : String;
  fid : Integer;
  ctx : TRTTIContext;
  rct : TRTTIType;
  fpc : TFunctionPackageClass;
[b]begin[/b]
  up := TUserProfile.Create;
  [b]try[/b]
    [b]with[/b] Jet.CreateDBQuery(
      [teal]'SELECT F.id, U.validate, F.module_id, F.class '[/teal] +
      [teal]'FROM   urls U, functions F '[/teal] +
      [teal]'WHERE  U.function_id=F.id AND (U.url=:URL) AND (f.active=True)'[/teal]) [b]do[/b]
      [b]try[/b]
        Parameters.ParamByName([teal]'URL'[/teal]).Value := ARequestInfo.Document;
        Open;
        First;
        [b]if[/b] EOF [b]then[/b]
          exit;
        [b]if[/b] FieldByName([teal]'validate'[/teal]).AsBoolean
          [b]and[/b] ([b]not[/b] _IsValid(up, FieldByName([teal]'module_id'[/teal]).AsInteger, FieldByName([teal]'id'[/teal]).AsInteger)) [b]then[/b]
        [b]begin[/b]
          AErrorNo := [purple]403[/purple];
          exit;
        [b]end[/b];
        cn := FieldByName([teal]'class'[/teal]).AsString;
        fid := FieldByName([teal]'id'[/teal]).AsInteger;
      [b]finally[/b]
        Free;
      [b]end[/b];
    FRTTIBlock.Acquire;
    [b]try[/b]
      rct := ctx.FindType(cn);      [navy][i]// Removing the TCriticalSection around this line causes issues
[/i][/navy]    [b]finally[/b]
      FRTTIBlock.Release;
    [b]end[/b];
    [b]if[/b] (rct <> [b]nil[/b]) [b]and[/b] (rct [b]is[/b] TRTTIInstanceType) [b]then[/b]
    [b]begin[/b]
      fpc := TFunctionPackageClass(TRTTIInstanceType(rct).MetaclassType);
      [b]with[/b] fpc.Create(Jet, Nexus, Ragpip, BluecentralShared, FWeb.FileRoot, fid) [b]do[/b]
        [b]try[/b]
          UserProfile := up;
          ProcessURL(ARequestInfo, AResponseInfo);
          AErrorNo := AResponseInfo.ResponseNo;
        [b]finally[/b]
          Free;
        [b]end[/b];
    [b]end[/b];
  [b]finally[/b]
    up.Free;
  [b]end[/b];
[b]end[/b];

 

[whosrdaddy]

Well the only reason that FindType would return nil is that the line

cn := FieldByName('class').AsString;

returns an empty or invalid string.
Adding the CS apparently alleviates the problem but you don't want that because now you are serializing all your HTTP requests.

is Jet.CreateDBQuery() creating a new db connection? if not, you are violating COM marshalling rules.

/Daddy

-----------------------------------------------------
Helping people is my job...

 

[Griffyn]

cn is definitely never empty or invalid - logging shows that.

Jet.CreateDBQuery creates a new TADOQuery object and assigns to an existing and connected TADOConnection object. I only ever use one TADOConnection object throughout my service apps, and it remains connected all the time. I do this because it's thread-safe, and I haven't experienced any issues so far. I'm not familiar with COM marshalling rules.

I've created an isolation test you can run yourself. Create a new VCL project, drop a TMemo and a TButton, replace unit1 with below, and assign the Form1.OnCreate, Form1.OnDestroy and Button1.OnClick events. Adding in the Memo1 complicated the logging, so there's a few critical sections to ensure thread safety. The key CS is the GRTTIBlock in TTestThread.Execute. Currently disabled, I get between 3 and 5 failures when I run with 200 threads. Enabling the GRTTIBlock CS removes the failures.

[b]unit[/b] Unit1;

[b]interface[/b]

[b]uses[/b]
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, SyncObjs, Contnrs, RTTI;

[b]type[/b]
  TTestThread = [b]class[/b](TThread)
  [b]private[/b]
    FFailed: Boolean;
    FRan: Boolean;
    FId: Integer;
  [b]protected[/b]
    [b]procedure[/b] Execute; [b]override[/b];
  [b]public[/b]
    [b]property[/b] Failed: Boolean [b]read[/b] FFailed;
    [b]property[/b] Ran: Boolean [b]read[/b] FRan;
    [b]property[/b] Id: Integer [b]read[/b] FId [b]write[/b] FId;
  [b]end[/b];

  TForm1 = [b]class[/b](TForm)
    Memo1: TMemo;
    Button1: TButton;
    [b]procedure[/b] Button1Click(Sender: TObject);
    [b]procedure[/b] FormCreate(Sender: TObject);
    [b]procedure[/b] FormDestroy(Sender: TObject);
  [b]private[/b]
    FLogBlock: TCriticalSection;
    FThreadBlock: TCriticalSection;
    FMaxThreadCount: Integer;
    FThreadCount: Integer;
    FRanCount: Integer;
    FFailureCount: Integer;
    [b]procedure[/b] Log(AStr: String);
    [b]procedure[/b] ThreadFinished(Sender: TObject);
    [b]procedure[/b] LaunchThreads;
  [b]end[/b];

[b]var[/b]
  Form1: TForm1;

[b]implementation[/b]

[b]var[/b]
  GRTTIBlock: TCriticalSection;

[navy][i]{$R *.dfm}[/i][/navy]

[navy][i]{ TTestThread }[/i][/navy]

[b]procedure[/b] TTestThread.Execute;
[b]var[/b]
  ctx : TRTTIContext;
[b]begin[/b]
[navy][i]//  GRTTIBlock.Acquire;
[/i][/navy]  [b]try[/b]
    FFailed := [b]not[/b] Assigned(ctx.FindType([teal]'Unit1.TForm1'[/teal]));
    FRan := True;
  [b]finally[/b]
[navy][i]//    GRTTIBlock.Release;
[/i][/navy]  [b]end[/b];
[b]end[/b];

[navy][i]{ TForm1 }[/i][/navy]

[b]procedure[/b] TForm1.Button1Click(Sender: TObject);
[b]begin[/b]
  Randomize;
  LaunchThreads;
  Log(Format([teal]'Threads: %d, Ran: %d, Failures: %d'[/teal],
    [FMaxThreadCount, FRanCount, FFailureCount]));
[b]end[/b];

[b]procedure[/b] TForm1.FormCreate(Sender: TObject);
[b]begin[/b]
  FLogBlock := TCriticalSection.Create;
  FThreadBlock := TCriticalSection.Create;
[b]end[/b];

[b]procedure[/b] TForm1.FormDestroy(Sender: TObject);
[b]begin[/b]
  FThreadBlock.Free;
  FLogBlock.Free;
[b]end[/b];

[b]procedure[/b] TForm1.Log(AStr: String);
[b]begin[/b]
  FLogBlock.Acquire;
  [b]try[/b]
    Memo1.Lines.Add(AStr);
  [b]finally[/b]
    FLogBlock.Release;
  [b]end[/b];
[b]end[/b];

[b]procedure[/b] TForm1.ThreadFinished(Sender: TObject);
[b]var[/b]
  tt : TTestThread;
[b]begin[/b]
  tt := TTestThread(Sender);
  Log(Format([teal]'Thread %d finished'[/teal], [tt.Id]));
  FThreadBlock.Acquire;
  [b]try[/b]
    Dec(FThreadCount);
    [b]if[/b] tt.Failed [b]then[/b]
      Inc(FFailureCount);
    [b]if[/b] tt.Ran [b]then[/b]
      Inc(FRanCount);
  [b]finally[/b]
    FThreadBlock.Release;
  [b]end[/b];
[b]end[/b];

[b]procedure[/b] TForm1.LaunchThreads;
[b]var[/b]
  c : Integer;
  ol : TObjectList;
  t : TTestThread;
[b]begin[/b]
  FRanCount := [purple]0[/purple];
  FFailureCount := [purple]0[/purple];
  FMaxThreadCount := [purple]200[/purple];
  ol := TObjectList.Create(False);
  [b]try[/b]
    [navy][i]// get all the thread objects created and ready
[/i][/navy]    [b]for[/b] c := [purple]1[/purple] [b]to[/b] FMaxThreadCount [b]do[/b]
    [b]begin[/b]
      t := TTestThread.Create(True);
      t.FreeOnTerminate := True;
      t.OnTerminate := ThreadFinished;
      t.Id := c;
      ol.Add(t);
    [b]end[/b];
    FThreadCount := FMaxThreadCount;
    [navy][i]// start them all up
[/i][/navy]    [b]for[/b] c := [purple]0[/purple] [b]to[/b] ol.Count - [purple]1[/purple] [b]do[/b]
    [b]begin[/b]
      TTestThread(ol[c]).Start;
      Log(Format([teal]'Thread %d started'[/teal], [TTestThread(ol[c]).Id]));
    [b]end[/b];
    [b]repeat[/b]
      Application.ProcessMessages;
      FThreadBlock.Acquire;
      [b]try[/b]
        [b]if[/b] FThreadCount <= [purple]0[/purple] [b]then[/b]
          Break;
      [b]finally[/b]
        FThreadBlock.Release;
      [b]end[/b];
    [b]until[/b] False;
  [b]finally[/b]
    ol.Free;
  [b]end[/b];
[b]end[/b];

[b]initialization[/b]
  GRTTIBlock := TCriticalSection.Create;

[b]finalization[/b]
  GRTTIBlock.Free;

[b]end[/b].

 

[whosrdaddy]

Ok thank you very much for adding an MCVE, will check that out.
Just to inform you about the TADOConnection.
If the Query is not in the same thread as the connection, this will lead to issues and you need to follow COM Marshalling rules across threads.
The solution is simple, keep the connection and the query on the same thread, not abiding this rule will get you into trouble in multithreadingland.



-----------------------------------------------------
Helping people is my job...

 

[whosrdaddy]

Griffyn,

I ran your test project several times, but it never fails on my PC.
I must admit that I only have Delphi XE, I suppose you have a higher Delphi version?

Small nitpicks on the testproject:

- The FLogBlock CS is not needed since the OnTerminate procedure is synchronized with the main thread (and there is no logging code in the TThread.Execute method)
- You can use a Semaphore in conjunction with WaitForSingleObject for thread bookkeeping.
I will post an example how to this later.

Cheers,
Daddy


-----------------------------------------------------
Helping people is my job...

 

[Griffyn]

Thanks for taking a look. I use XE6, so perhaps it's an issue introduced since XE.

As you can tell, my understanding of threads is basic. Particularly waiting for them to finish tasks.

Thanks for the information about queries/connections across threads. I'll investigate that.

 

[whosrdaddy]

Giffyn,

Do you have an account on Stack Overflow?
I would pose your question over there, Maybe you hit a bug in XE6.
I searched Quality Central entries but found nothing related to your problem.

/Daddy

-----------------------------------------------------
Helping people is my job...

 

[Griffyn]

I do, and it's posted (my first)

http://stackoverflow.com/questions/27368556/trtticontext-multi-thread-issue

Thanks for your help on this whosrdaddy.

 

[whosrdaddy]

Sure no problem,
we're here to help each other out

/Daddy

-----------------------------------------------------
Helping people is my job...

 

[Griffyn]

Looks like the bug has been confirmed by others, and a QC has been raised with Embarcadero. A comment indicated it affects D2010 onwards, so not sure why you didn't experience any failure whosrdaddy.

Did you run my test project as is (with superfluous TCriticalSections), or did you clean it up first? I wonder if the speed and/or number of cores in your PC affected anything.

 

[whosrdaddy]

Yes,
I have the problem too once I removed all logging, for some reason the CS of the logging block prevented the problem from happening.
I rely heavily on RTTI in a bunch of projects, so I was quite surprised about this bug.
On the bright side, David Heffernan's fix is quite straightforward, so already modified my code base (though I never encountered this problem)

P.S: I have the same username on SO

/Daddy

-----------------------------------------------------
Helping people is my job...