From 53e4c5b5fbcfe0c0078591a736ecb8108a6a3309 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Micha=C3=ABl=20Van=20Canneyt?= <michael@freepascal.org>
Date: Wed, 29 Jan 2025 21:25:19 +0100
Subject: [PATCH] * Fix by Simone Tacconi to fix with..do writing. Fixes issue
 #41124

---
 packages/fcl-passrc/src/paswrite.pp      | 32 ++++++++++++++++++++++++
 packages/fcl-passrc/tests/testpassrc.lpr |  2 +-
 2 files changed, 33 insertions(+), 1 deletion(-)

diff --git a/packages/fcl-passrc/src/paswrite.pp b/packages/fcl-passrc/src/paswrite.pp
index 1fecc5849d..52cb8a1e98 100644
--- a/packages/fcl-passrc/src/paswrite.pp
+++ b/packages/fcl-passrc/src/paswrite.pp
@@ -73,6 +73,7 @@ type
     procedure SetForwardClasses(AValue: TStrings);
     procedure SetIndentSize(AValue: Integer);
     function CheckUnitAlias(const AUnitName : String) : String;
+    procedure WriteImplWithDo(aWith: TPasImplWithDo);
   protected
     procedure DisableHintsWarnings;
     procedure PrepareDeclSectionInStruct(const ADeclSection: string);
@@ -1239,6 +1240,8 @@ begin
     WriteImplSimple(TPasImplSimple(aElement))
   else if AElement.InheritsFrom(TPasImplExceptOn) then
     WriteImplExceptOn(TPasImplExceptOn(aElement))
+  else if AElement.InheritsFrom(TPasImplWithDo) then
+      WriteImplWithDo(TPasImplWithDo(aElement))
   else
     raise EPasWriter.CreateFmt('Writing not yet implemented for %s implementation elements',[AElement.ClassName]);
 end;
@@ -1248,6 +1251,35 @@ begin
   Add(ACommand.Command);
 end;
 
+procedure TPasWriter.WriteImplWithDo(aWith: TPasImplWithDo);
+var
+  ind : integer;
+  Expr : string;
+begin
+  With aWith do
+    begin
+    for ind:=0 to Expressions.Count-1 do
+      begin
+        Expr:=Expr+GetExpr(TPasExpr(Expressions[ind]));
+        if ind<Expressions.Count-1 then
+          Expr:=Expr+',';
+      end;
+    Add('With %s do',[Expr]);
+    if assigned(Body) then
+      begin
+        AddLn;
+        IncIndent;
+        WriteImplElement(Body, True);
+        DecIndent;
+        if (Body.InheritsFrom(TPasImplBlock)) and
+           (Body.InheritsFrom(TPasImplCommands)) then
+          AddLn(';');
+      end
+    else
+      AddLn(';');
+    end;
+end;
+
 procedure TPasWriter.WriteImplCommands(ACommands: TPasImplCommands);
 var
   i: Integer;
diff --git a/packages/fcl-passrc/tests/testpassrc.lpr b/packages/fcl-passrc/tests/testpassrc.lpr
index d02fe12e14..0d69463ef0 100644
--- a/packages/fcl-passrc/tests/testpassrc.lpr
+++ b/packages/fcl-passrc/tests/testpassrc.lpr
@@ -7,7 +7,7 @@ uses
   cwstring,
 {$ENDIF}
   //MemCheck,
-  Classes, consoletestrunner, tcscanner,  tctypeparser, tcstatements,
+  Classes, consoletestrunner, tcscanner,  tctypeparser, tcstatements, paswrite,
   tcbaseparser, tcmoduleparser, tconstparser, tcvarparser, tcclasstype,
   tcexprparser, tcprocfunc, tcpassrcutil, TCGenerics,
   TCResolver, TCResolveGenerics, TCResolveMultiErrors,