fix double object destruction expanding R5 value sets

HealthIntersections · Mar 29, 2024 · fba4ca8 · fba4ca8
1 parent ad7084e
commit fba4ca8
Show file tree

Hide file tree

Showing 3 changed files with 16 additions and 17 deletions.
diff --git a/library/fdb/fdb_manager.pas b/library/fdb/fdb_manager.pas
@@ -1375,7 +1375,7 @@ destructor TFDBManager.Destroy;
 
 function TFDBManager.GetCurrentCount: Integer;
 begin
- FLock.Enter;
+ FLock.Enter('GetCurrentCount');
  try
  result := FConnections.Count;
  finally
@@ -1387,7 +1387,7 @@ procedure TFDBManager.CheckWait;
 begin
  if FWaitCreate then
  begin
- FLock.Lock;
+ FLock.Lock('CheckWait1');
  try
  inc(FThreadWaitCount);
  finally
@@ -1397,7 +1397,7 @@ procedure TFDBManager.CheckWait;
  if FSemaphore.WaitFor(DEFAULT_CONNECTION_WAIT_LENGTH) = wrError then
  raise EDBException.Create('['+Name+'] fdb_manager Wait Failed' {$IFDEF WINDOWS}+' - '+ ErrorAsString(GetLastError){$ENDIF});
  finally
- FLock.Lock;
+ FLock.Lock('CheckWait2');
  try
  dec(FThreadWaitCount);
  finally
@@ -1425,7 +1425,7 @@ function TFDBManager.GetConnection(const AUsage: String): TFDBConnection;
  except
  on e:exception do
  begin
- FLock.Enter;
+ FLock.Enter('getConnection1');
  Try
  FServerIsAvailable := False;
  FLastServerError := e.message;
@@ -1436,7 +1436,7 @@ function TFDBManager.GetConnection(const AUsage: String): TFDBConnection;
  raise;
  end;
  end;
- FLock.Enter;
+ FLock.Enter('getConnection2');
  Try
  FConnections.Add(result);
  FServerIsAvailable := true;
@@ -1446,7 +1446,7 @@ function TFDBManager.GetConnection(const AUsage: String): TFDBConnection;
  End;
 
  result.FNoFree := true;
- FLock.Enter;
+ FLock.Enter('getConnection3');
  try
  FWaitCreate := (FMaxConnCount > 0) and (FConnections.Count = FMaxConnCount);
  finally
@@ -1460,7 +1460,7 @@ function TFDBManager.GetConnection(const AUsage: String): TFDBConnection;
  raise EDBException.Create('No Database Connections Available for "'+AUsage+'" (used: '+GetConnSummary+')');
  end;
  end;
- FLock.Enter; // lock this because of debugger
+ FLock.Enter('getConnection4'); // lock this because of debugger
  try
  result.FUsage := AUsage;
  result.FUsed := now;
@@ -1502,7 +1502,7 @@ procedure TFDBManager.Release(AConn : TFDBConnection);
  raise EDBException.Create('Attempt to release ODBC connection twice');
  AConn.FCurrentlyInUse := false;
  FDBLogger.RecordUsage(AConn.Usage, AConn.FUsed, AConn.FRowCount, AConn.FPrepareCount, nil, '');
- FLock.Enter; // must lock because of the debugger
+ FLock.Enter('release'); // must lock because of the debugger
  try
  LDispose := (FConnections.count > FMaxConnCount) and (FMaxConnCount > 0);
  LIndex := FInUse.IndexOf(AConn);
@@ -1561,7 +1561,7 @@ procedure TFDBManager.Error(AConn : TFDBConnection; AException: Exception; AErrM
 
  FDBLogger.RecordUsage(AConn.Usage, AConn.FUsed, AConn.FRowCount, AConn.FPrepareCount, AException, AErrMsg);
 
- FLock.Enter; // must lock because of the debugger
+ FLock.Enter('error'); // must lock because of the debugger
  try
  LIndex := FInUse.IndexOf(AConn);
  if LIndex > -1 then
@@ -1594,7 +1594,7 @@ function TFDBManager.GetConnSummary: String;
  i : integer;
 begin
  result := '';
- FLock.Enter;
+ FLock.Enter('GetConnSummary');
  try
  for i := 0 to FInUse.Count - 1 do
  begin
@@ -1615,7 +1615,7 @@ function TFDBManager.GetConnSummary: String;
 
 function TFDBManager.GetCurrentUse: Integer;
 begin
- FLock.Enter;
+ FLock.Enter('GetCurrentUse');
  try
  result := FInUse.Count;
  finally
@@ -1630,7 +1630,7 @@ function TFDBManager.Link: TFDBManager;
 
 function TFDBManager.PopAvail: TFDBConnection;
 begin
- FLock.Enter;
+ FLock.Enter('PopAvail');
  try
  if FAvail.Count > 0 then
  begin
@@ -1718,7 +1718,7 @@ function DescribeType(AColType: TFDBColumnType): String;
 
 procedure TFDBManager.SetMaxConnCount(const Value: Integer);
 begin
- FLock.Enter;
+ FLock.Enter('SetMaxConnCount');
  try
  FMaxConnCount := Value;
  finally
@@ -2098,7 +2098,7 @@ function TFDBMetaData.sizeInBytesV(magic : integer) : cardinal;
 
 function TFDBManager.ServerErrorStatus: String;
 Begin
- FLock.Enter;
+ FLock.Enter('ServerErrorStatus');
  try
  if ServerIsAvailable then
  result := ''

diff --git a/library/fhir5/fhir5_common.pas b/library/fhir5/fhir5_common.pas
@@ -4278,10 +4278,10 @@ procedure TFhirValueSetExpansion5.defineProperty(focus: TFhirValueSetExpansionCo
  begin
  pdv := ((focus as TFhirValueSetExpansionContains5).element as TFhirValueSetExpansionContains).property_list.append;
  pdv.code := code;
- pdv.value := value as TFHIRDataType;
+ pdv.value := (value as TFHIRDataType).link;
  end
  else
- pdv.value := value as TFHIRDataType;
+ pdv.value := (value as TFHIRDataType).link;
  finally
  value.free;
  end;

diff --git a/server/web_cache.pas b/server/web_cache.pas
@@ -221,7 +221,6 @@ procedure THTTPCacheManager.Trim(callback : TFhirServerMaintenanceThreadTaskCall
 
  if FSize > FMaxSize then
  FCache.clear;
- end;
  finally
  FLock.Unlock;
  end;