Release Version 3.1.12

build/windows-full-release.bat

@@ -25,9 +25,9 @@ call build\windows-fhirserver.bat %tmp%
 
 pause
 
-rem exec\64\fhirserver.exe -tests -test-settings exec\64\fhir-tests.ini
+exec\64\fhirserver.exe -tests -test-settings exec\64\fhir-tests.ini -mode brief
 
-rem if errorlevel 1 goto Quit
+if errorlevel 1 goto Quit
 
 pause
 

install/install-tk.iss

@@ -3,11 +3,11 @@
 ; AppID can never be changed as subsequent installations require the same installation ID each time
 AppID=FHIRToolkit
 AppName=Health Intersections FHIR Toolkit
-AppVerName=FHIRToolkit v3.1.11
+AppVerName=FHIRToolkit v3.1.12
 
 ; compilation control
 OutputDir=..\install\build
-OutputBaseFilename=fhirtoolkit-win64-3.1.11
+OutputBaseFilename=fhirtoolkit-win64-3.1.12
 Compression=lzma2/ultra64
 
 ; 64 bit
@@ -32,11 +32,11 @@ UninstallFilesDir={app}\uninstall
 ; win2000+ add/remove programs support
 AppPublisher=Health Intersections P/L
 AppPublisherURL=http://www.healthintersections.com.au
-AppVersion=3.1.11
+AppVersion=3.1.12
 AppSupportURL=https://github.com/grahamegrieve/fhirserver
 AppUpdatesURL=https://github.com/grahamegrieve/fhirserver
 AppCopyright=Copyright (c) Health Intersections Pty Ltd 2020+
-VersionInfoVersion=3.1.11.0
+VersionInfoVersion=3.1.12.0
 
 ; dialog support
 LicenseFile=..\license

install/install.iss

@@ -3,11 +3,11 @@
 ; AppID can never be changed as subsequent installations require the same installation ID each time
 AppID=FHIRServer
 AppName=Health Intersections FHIR Server
-AppVerName=FHIRServer v3.1.11
+AppVerName=FHIRServer v3.1.12
 
 ; compilation control
 OutputDir=..\install\build
-OutputBaseFilename=fhirserver-win64-3.1.11
+OutputBaseFilename=fhirserver-win64-3.1.12
 Compression=lzma2/ultra64
 
 ; 64 bit
@@ -34,11 +34,11 @@ UninstallFilesDir={app}\uninstall
 ; win2000+ add/remove programs support
 AppPublisher=Health Intersections P/L
 AppPublisherURL=http://www.healthintersections.com.au
-AppVersion=3.1.11
+AppVersion=3.1.12
 AppSupportURL=https://github.com/grahamegrieve/fhirserver
 AppUpdatesURL=https://github.com/grahamegrieve/fhirserver
 AppCopyright=Copyright (c) Health Intersections Pty Ltd 2011+
-VersionInfoVersion=3.1.11.0
+VersionInfoVersion=3.1.12.0
 
 ; dialog support
 LicenseFile=..\license

library/fhir-dev.inc

@@ -6,9 +6,21 @@
 
 // do not make changes in the file fhir-status.inc - it is overwritten by either fhir-dev.inc or fhir-prod.inc by the build scripts 
 
+// THIS IS DEVELOPMENT MODE
+
 {$C+} // assertions on - this is the important one - turns object tracking on and off consistently
 {$I+} // IO checking on - though this is probably useless?
 {$Q-} // overflow checking off - these are always off; doesn't run with them on
 {$R-} // range checking off - these are always off; doesn't run with them on
-{$OPTIMIZATION OFF} // all optimizations off for production
+{$OPTIMIZATION OFF} // all optimizations off for development
 {$D+} // debugging info on for development
+
+{
+The base class TFslObject can track all instantiated objects.
+Doing so is useful for leak hunting in production, but is also a little costly.
+Enable it with this define
+}
+{$DEFINE OBJECT_TRACKING}
+
+
+

library/fhir-prod.inc

@@ -6,9 +6,18 @@
 
 // do not make changes in the file fhir-status.inc - it is overwritten by either fhir-dev.inc or fhir-prod.inc by the build scripts 
 
+// THIS IS PRODUCTION MODE
+
 {$C-} // assertions off - this is the important one - turns object tracking off consistently
 {$I-} // IO checking off 
 {$Q-} // overflow checking off - these are always off; doesn't run with them on
 {$R-} // range checking off - these are always off; doesn't run with them on
 {$OPTIMIZATION LEVEL3} // level 3 optimizations for production
 {$D-} // debugging info off for production
+
+{
+The base class TFslObject can track all instantiated objects.
+Doing so is useful for leak hunting in production, but is also a little costly.
+Enable it with this define
+}
+{.$.DEFINE OBJECT_TRACKING}       

library/fhir-status.inc

@@ -6,9 +6,18 @@
 
 // do not make changes in the file fhir-status.inc - it is overwritten by either fhir-dev.inc or fhir-prod.inc by the build scripts 
 
+// THIS IS PRODUCTION MODE
+
 {$C-} // assertions off - this is the important one - turns object tracking off consistently
 {$I-} // IO checking off 
 {$Q-} // overflow checking off - these are always off; doesn't run with them on
 {$R-} // range checking off - these are always off; doesn't run with them on
 {$OPTIMIZATION LEVEL3} // level 3 optimizations for production
 {$D-} // debugging info off for production
+
+{
+The base class TFslObject can track all instantiated objects.
+Doing so is useful for leak hunting in production, but is also a little costly.
+Enable it with this define
+}
+{.$.DEFINE OBJECT_TRACKING}       

library/fhir.inc

@@ -65,14 +65,6 @@ Or in the case of FPC compiled applications, statically bound
 }
 {$DEFINE STATICLOAD_OPENSSL}
 
-{$I fhir-status.inc}  // see notes there
+{$i fhir-status.inc}  // see notes there
 
-{
-The base class TFslObject can track all instantiated objects.
-Doing so is useful for leak hunting in production, but is also a little costly.
-Enable it with this define
-}
-{$IFOPT D+}
-{$DEFINE OBJECT_TRACKING}
-{$ENDIF}
 

library/fhir4b/fhir4b_profiles.pas

@@ -1676,7 +1676,7 @@ function TBaseWorkerContextR4B.getStructure(ns, name: String): TFHIRStructureDef
   list : TFslList<TFhirStructureDefinition>;
   sd : TFhirStructureDefinition;
   sns : String;
-  url : string;
+  url, u : string;
 begin
   list := TFslList<TFhirStructureDefinition>.Create;
   try
@@ -1687,7 +1687,8 @@ function TBaseWorkerContextR4B.getStructure(ns, name: String): TFHIRStructureDef
       url := 'http://hl7.org/fhir/StructureDefinition/'+name;
       for sd in list do
       begin
-        if (sd.url = url) then
+        u := sd.url;
+        if (u = url) then
           exit(sd);
       end;
     end;

library/fsl/fsl_base.pas

@@ -44,9 +44,7 @@ interface
   {$ENDIF}
   EMPTY_HASH = -1;
 
-{.$.DEFINE TRACK_CLASSES }
-
-{$IFDEF TRACK_CLASSES}
+{$IFDEF OBJECT_TRACKING}
 const
   CLASS_NAME_OF_INTEREST = 'TFhirString';
   ID_OF_INTEREST = -1;
@@ -171,19 +169,15 @@   EJsonException = class (EFslException); // error reading or writing Json
     FTagObject : TObject;
     FOwningThread : TThreadId;
     FMagic : integer;
-    {$IFDEF TRACK_CLASSES}
-    FNamedInstance : string;
-    {$ENDIF}
-    {$IFOPT D+}
+    {$IFDEF OBJECT_TRACKING}
     // This is a workaround for the delphi debugger not showing the actual class of an object that is polymorphic
     // It's sole purpose is to be visible in the debugger. No other functionality should depend on it
     FNamedClass : TNameString;
     FDebugInfo : String;
-    {$ENDIF}
-    {$IFDEF OBJECT_TRACKING}
     FSerial : integer;
     FNext, FPrev : TFslObject; // same class type
     FThreadName : String;
+    FNamedInstance : string;
     {$ENDIF}
 
     function ObjectCrossesThreads : boolean;
@@ -214,7 +208,7 @@   EJsonException = class (EFslException); // error reading or writing Json
     Function ErrorClass : EFslExceptionClass; Overload; Virtual;
 
     function sizeInBytesV(magic : integer) : cardinal; virtual;
-    {$IFDEF TRACK_CLASSES}
+    {$IFDEF OBJECT_TRACKING}
     procedure freeNotification(done : boolean); virtual;
     {$ENDIF}
   Public
@@ -244,13 +238,9 @@   EJsonException = class (EFslException); // error reading or writing Json
 
     Property FslObjectReferenceCount : TFslReferenceCount Read FFslObjectReferenceCount;
     property TagObject : TObject read FTagObject write FTagObject; // no ownership....
-    {$IFDEF TRACK_CLASSES}
+    {$IFDEF OBJECT_TRACKING}
     property NamedInstance : string read FNamedInstance write FNamedInstance;
-    {$ENDIF}
-    {$IFOPT D+}
     property NamedClass : TNameString read FNamedClass;
-    {$ENDIF}
-    {$IFDEF OBJECT_TRACKING}
     property SerialNumber : integer read FSerial;
     {$ENDIF}
     function debugInfo : String; virtual; // what's visible to the debugger
@@ -1047,17 +1037,13 @@ constructor TFslObject.Create;
   {$ENDIF}
 Begin
   Inherited;
-  {$IFOPT D+}
-  FNamedClass := copy(ClassName, 1, 16);
-  {$ENDIF}
   FOwningThread := GetCurrentThreadId;
 
-  {$IFDEF TRACK_CLASSES}
+  {$IFDEF OBJECT_TRACKING}
   if (className = CLASS_NAME_OF_INTEREST) then
     freeNotification(false);
-  {$ENDIF}
 
-  {$IFDEF OBJECT_TRACKING}
+  FNamedClass := copy(ClassName, 1, 16);
   if not GInited then
     initUnit;
   if Assigned(GetThreadNameStatusDelegate) then
@@ -1079,7 +1065,7 @@ constructor TFslObject.Create;
     inc(t.deltaCount);
     inc(t.serial);
     FSerial := t.serial;
-    {$IFDEF TRACK_CLASSES}
+    {$IFDEF OBJECT_TRACKING}
     if (t.serial = ID_OF_INTEREST) and (className = CLASS_NAME_OF_INTEREST) then
       NamedInstance := '!';
     {$ENDIF}
@@ -1207,7 +1193,7 @@ procedure TFslObject.Free;
       clsName := 'n/a';
       nmCls  := 'n/a';
       try
-        {$IFOPT D+}
+        {$IFDEF OBJECT_TRACKING}
         nmCls := FNamedClass;
         {$ENDIF}
       except
@@ -1235,7 +1221,7 @@         clsName := className;
       dec(FFslObjectReferenceCount);
       done := FFslObjectReferenceCount < 0;
     end;
-    {$IFDEF TRACK_CLASSES}
+    {$IFDEF OBJECT_TRACKING}
     if (classname = CLASS_NAME_OF_INTEREST) then
       self.freeNotification(done);
     {$ENDIF}
@@ -1352,7 +1338,7 @@ function TFslObject.Link: TFslObject;
       InterlockedIncrement(FFslObjectReferenceCount)
     else
       inc(FFslObjectReferenceCount);
-    {$IFDEF TRACK_CLASSES}
+    {$IFDEF OBJECT_TRACKING}
     if self.classname = CLASS_NAME_OF_INTEREST then
       freeNotification(false);
     {$ENDIF}
@@ -1525,7 +1511,7 @@ function TFslObject.debugInfo: String;
 
 procedure TFslObject.updateDebugInfo;
 begin
-  {$IFOPT D+}
+  {$IFDEF OBJECT_TRACKING}
   FDebugInfo := debugInfo;
   {$ENDIF}
 end;
@@ -1548,19 +1534,16 @@ function TFslObject.ObjectCrossesThreads: boolean;
 function TFslObject.dumpSummary: String;
 begin
   result := inttostr(FFslObjectReferenceCount+1);
-  {$IFDEF TRACK_CLASSES}
+  {$IFDEF OBJECT_TRACKING}
   if FNamedInstance <> '' then
     result := result + FNamedInstance
-  {$ELSE}
-  if false then
-  {$ENDIF}
-  {$IFDEF OBJECT_TRACKING}
   else if (updatedDebugInfo <> '?') then
     result := result +'(^'+FDebugInfo+')'
   else if (FSerial > 0) then
     result := result +'(#'+inttostr(FSerial)+')'
+  else
   {$ENDIF}
-  else if FMagic <> 0 then
+  if FMagic <> 0 then
     result := result +'($'+inttostr(FMagic)+')';
 end;
 
@@ -1570,7 +1553,7 @@ function TFslObject.updatedDebugInfo: String;
     updateDebugInfo;
   except
   end;
-  result := {$IFOPT D+}FDebugInfo{$ELSE}''{$ENDIF};
+  result := {$IFDEF OBJECT_TRACKING}FDebugInfo{$ELSE}''{$ENDIF};
 end;
 
 function TFslObject.CheckCondition(bCorrect: Boolean; const sMethod, sMessage: String): Boolean;
@@ -1652,15 +1635,13 @@ function TFslObject.sizeInBytes(magic : integer) : cardinal;
 function TFslObject.sizeInBytesV(magic : integer) : cardinal;
 begin
   result := sizeof(self);
-  {$IFOPT D+}
-  inc(result, (length(FNamedClass))+2);
-  {$ENDIF}
   {$IFDEF OBJECT_TRACKING}
+  inc(result, (length(FNamedClass))+2);
   inc(result, length(FThreadName)+12);
   {$ENDIF}
 end;
 
-{$IFDEF TRACK_CLASSES}
+{$IFDEF OBJECT_TRACKING}
 procedure noop(done : boolean);
 begin
   // nothing;

library/fsl/fsl_collections.pas

@@ -29,6 +29,7 @@
 }
 {$I fhir.inc}
 
+
 Interface
 
 
@@ -1750,7 +1751,6 @@   TFslObjectListIterator = class(TFslObjectIterator)
 uses
   fsl_stream;
 
-
 Procedure TFslCollection.BeforeDestruction;
 Begin
   InternalClear;
@@ -5525,7 +5525,6 @@ function TFslObjectList.ExistsByDefault(oValue: TFslObject): boolean;
   Result := ExistsByIndex(IndexByDefault(oValue));
 end;
 
-
 function TFslObjectList.Add(oValue: TFslObject): integer;
 begin
   Assert(ValidateItem('Add', oValue, 'oValue'));

library/fsl/tests/fsl_tests.pas

@@ -5137,8 +5137,11 @@ procedure TFslCollectionsTests.testAdd;
 end;
 
 procedure TFslCollectionsTests.executeFail(context : TObject);
+var
+  o : TFslTestObjectList;
 begin
-  list.Add(TFslTestObjectList.create);
+  o:= TFslTestObjectList.create;
+  list.Add(o);
 end;
 
 procedure TFslCollectionsTests.testAddFail;

library/version.inc

@@ -1,3 +1,3 @@
- FHIR_CODE_FULL_VERSION = '3.1.11';
+ FHIR_CODE_FULL_VERSION = '3.1.12';
  FHIR_CODE_RELEASE_DATE = '2024-03-09';
- FHIR_CODE_RELEASE_DATETIME = '20240309051040.707Z';
+ FHIR_CODE_RELEASE_DATETIME = '20240309120644.755Z';