* Fix by Simone Tacconi to fix with..do writing. Fixes issue #41124

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;

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,