Merge branch source:main into main

compiler/pstatmnt.pas

@@ -811,9 +811,9 @@ implementation
           end
          else
           begin
+            Message1(parser_e_false_with_expr,p.resultdef.GetTypeName);
             p.free;
             p := nil;
-            Message1(parser_e_false_with_expr,p.resultdef.GetTypeName);
             { try to recover from error }
             if try_to_consume(_COMMA) then
              begin

packages/fcl-md/src/markdown.elements.pas

@@ -206,10 +206,12 @@ Type
   private
     FFenced: boolean;
     FLang: AnsiString;
+    FIndent : Integer;
   public
     function WhiteSpaceMode : TWhitespaceMode; override;
     property Fenced : boolean read FFenced write FFenced;
     property Lang : AnsiString read FLang write FLang;
+    Property Indent : Integer Read FIndent Write FIndent;
   end;
 
 

packages/fcl-md/src/markdown.fpdocrender.pas

@@ -65,7 +65,6 @@ type
     procedure RenderToStream(aDocument : TMarkDownDocument; aStream : TStream);
     Procedure RenderDocument(aDocument : TMarkDownDocument); override;overload;
     Procedure RenderDocument(aDocument : TMarkDownDocument; aDest : TStrings); overload;
-    procedure RenderChildren(aBlock : TMarkDownContainerBlock; aAppendNewLine : Boolean); overload;
     function RenderFPDoc(aDocument : TMarkDownDocument) : string;
     Property PackageName : String read FPackageName Write FPackageName;
     Property FPDoc : String Read FFPDoc;
@@ -253,7 +252,7 @@ end;
 
 procedure TFPDocMarkDownBlockRenderer.CheckParent(const aParent, aChild: String);
 begin
-  if (Parent.NodeName<>aParent) then
+  if (UTF8Encode(Parent.NodeName)<>aParent) then
     Raise EFPDocRender.CreateFmt('Cannot have %s below %s',[aChild,aParent]);
 end;
 
@@ -333,10 +332,10 @@ end;
 
 function TMarkDownFPDocRenderer.Push(const aElementName: String; const aName: string): TDOMElement;
 begin
-  Result:=FDoc.CreateElement(aElementName);
+  Result:=FDoc.CreateElement(UTF8Decode(aElementName));
   PushElement(Result);
   if aName<>'' then
-    Result['name']:=aName;
+    Result['name']:=UTF8Decode(aName);
 end;
 
 procedure TMarkDownFPDocRenderer.PushElement(aElement: TDomElement);
@@ -364,7 +363,7 @@ end;
 
 procedure TMarkDownFPDocRenderer.AppendText(const aContent: String);
 begin
-  Parent.AppendChild(FDoc.CreateTextNode(aContent))
+  Parent.AppendChild(FDoc.CreateTextNode(UTF8Decode(aContent)));
 end;
 
 function TMarkDownFPDocRenderer.PushSection(aSection: TSectionType): TDomElement;
@@ -380,7 +379,7 @@ end;
 
 function TMarkDownFPDocRenderer.PopTill(const aElementName: string): TDomElement;
 begin
-  PopTill([aElementName]);
+  Result:=PopTill([aElementName]);
 end;
 
 
@@ -442,14 +441,6 @@ begin
   aDest.Text:=RenderFPDoc(aDocument);
 end;
 
-procedure TMarkDownFPDocRenderer.RenderChildren(aBlock: TMarkDownContainerBlock; aAppendNewLine: Boolean);
-var
-  i : integer;
-begin
-  for I:=0 to aBlock.Blocks.Count-1 do
-    RenderBlock(aBlock.Blocks[I]);
-end;
-
 function TMarkDownFPDocRenderer.RenderFPDoc(aDocument: TMarkDownDocument): string;
 begin
   RenderDocument(aDocument);
@@ -618,7 +609,7 @@ function TFPDocMarkDownTextRenderer.renderAttrs(aElement: TMarkDownTextNode): An
   begin
     lKey:=KeyAlias(aKey);
     if lKey<>'' then
-      FPDoc.Parent[lKey]:=aValue;
+      FPDoc.Parent[UTF8Decode(lKey)]:=UTF8Decode(aValue);
   end;
 
 var
@@ -756,7 +747,7 @@ begin
   fpDoc.Push('li');
   For lBlock in lItemBlock.Blocks do
     if IsPlainBlock(lBlock) then
-      FPDoc.RenderChildren(lPar,True)
+      FPDoc.RenderChildren(lPar)
     else
       Renderer.RenderBlock(lBlock);
   fpDoc.Pop;

packages/fcl-md/src/markdown.htmlrender.pas

@@ -658,10 +658,11 @@ var
   lLang : string;
 begin
   lLang:=lNode.Lang;
+  AppendNL('');
   if lLang<> '' then
-    Append('<pre><code class="language-'+lLang+'">')
+    AppendNl('<pre><code class="language-'+lLang+'">')
   else
-    Append('<pre><code>');
+    AppendNl('<pre><code>');
   for lBlock in LNode.Blocks do
     begin
     Renderer.RenderCodeBlock(LBlock,lLang);

packages/fcl-md/src/markdown.inlinetext.pas

@@ -848,6 +848,7 @@ begin
   Result:=False;
   S:=Scanner.PeekWhile(cEmailChars);
   lLen:=Length(S);
+  if lLen=0 then exit;
   cLast:=s[lLen];
   // Strip off _ or -
   if CharInSet(cLast,['_','-']) then

packages/fcl-md/src/markdown.latexrender.pas

@@ -23,7 +23,7 @@ uses
 {$IFDEF FPC_DOTTEDUNITS}
   System.Classes, System.SysUtils, System.StrUtils, System.Contnrs, 
 {$ELSE}
-  Classes, SysUtils, strutils, contnrs, 
+  Classes, SysUtils,  contnrs,
 {$ENDIF}  
   MarkDown.Elements, 
   MarkDown.Render, 
@@ -47,6 +47,7 @@ type
     Procedure Append(const aContent : String);
     Procedure AppendNL(const aContent : String = '');
     Property Builder : TStringBuilder Read FBuilder;
+    function EscapeLaTeX(const S: String): String;
   public
     constructor Create(aOwner : TComponent); override;
     destructor destroy; override;
@@ -54,7 +55,9 @@ type
     Procedure RenderDocument(aDocument : TMarkDownDocument; aDest : TStrings); overload;
     procedure RenderChildren(aBlock : TMarkDownContainerBlock; aAppendNewLine : Boolean); overload;
     function RenderLaTeX(aDocument : TMarkDownDocument) : string;
-    function EscapeLaTeX(const S: String): String;
+    Procedure RenderToFile(aDocument : TMarkDownDocument; aFileName : string);
+    class procedure FastRenderToFile(aDocument : TMarkDownDocument; const aFileName : string; aOptions : TLaTeXOptions = []; const aTitle : String = ''; const aAuthor : string = '');
+    class function FastRender(aDocument : TMarkDownDocument; aOptions : TLaTeXOptions = []; const aTitle : String = ''; const aAuthor : string = '') : string;
   published
     Property Options : TLaTeXOptions Read FOptions Write FOptions;
     property Title : String Read FTitle Write FTitle;
@@ -317,6 +320,53 @@ begin
   FLaTeX:='';
 end;
 
+procedure TMarkDownLaTeXRenderer.RenderToFile(aDocument: TMarkDownDocument; aFileName: string);
+var
+  lTeX : String;
+  lFile : THandle;
+begin
+  lTeX:=RenderLaTex(aDocument);
+  lFile:=FileCreate(aFileName);
+  try
+    if lTex<>'' then
+      FileWrite(lFile,lTex[1],Length(lTex)*SizeOf(Char));
+  finally
+    FileClose(lFile);
+  end;
+end;
+
+class procedure TMarkDownLaTeXRenderer.FastRenderToFile(aDocument: TMarkDownDocument; const aFileName: string; aOptions: TLaTeXOptions;
+  const aTitle: String; const aAuthor: string);
+var
+  lRender : TMarkDownLaTexRenderer;
+begin
+  lRender:=TMarkDownLaTexRenderer.Create(Nil);
+  try
+    lRender.Options:=aOptions;
+    lRender.Title:=aTitle;
+    lRender.Author:=aAuthor;
+    lRender.RenderToFile(aDocument,aFileName);
+  finally
+    lRender.Free;
+  end;
+end;
+
+class function TMarkDownLaTeXRenderer.FastRender(aDocument: TMarkDownDocument; aOptions: TLaTeXOptions; const aTitle: String;
+  const aAuthor: string): string;
+var
+  lRender : TMarkDownLaTexRenderer;
+begin
+  lRender:=TMarkDownLaTexRenderer.Create(Nil);
+  try
+    lRender.Options:=aOptions;
+    lRender.Title:=aTitle;
+    lRender.Author:=aAuthor;
+    Result:=lRender.RenderLatex(aDocument);
+  finally
+    lRender.Free;
+  end;
+end;
+
 function TMarkDownLaTeXRenderer.EscapeLaTeX(const S: String): String;
 var
   i: Integer;
@@ -788,4 +838,4 @@ initialization
   TLaTeXMarkDownTableRowBlockRenderer.RegisterRenderer(TMarkDownLaTeXRenderer);
   TLaTeXMarkDownDocumentRenderer.RegisterRenderer(TMarkDownLaTeXRenderer);
   TLaTeXMarkDownTextRenderer.RegisterRenderer(TMarkDownLaTeXRenderer);
-end.
+end.

packages/fcl-md/src/markdown.line.pas

@@ -51,7 +51,7 @@ type
     // Line is the text with initial tabs replaced by spaces.
     property Line : AnsiString Read FLine;
     property LineNo : integer Read FLineNo;
-
+    Property CursorPos : Integer Read FCursor;
   end;
   TMarkDownLineList = class (specialize TGFPObjectList<TMarkDownLine>);
 

packages/fcl-md/src/markdown.processors.pas

@@ -428,8 +428,11 @@ begin
   if (lBlock is TMarkDownListItemBlock) and (lBlock.Parent is TMarkDownListBlock) then
      lBlock:=lBlock.Parent as TMarkDownListBlock;
   if (lBlock is TMarkDownListBlock) then
-    if aLine.LeadingWhitespace>=lList.baseIndent then
-      Result:=False
+    if aLine.LeadingWhitespace>=lList.LastIndent then
+      begin
+      aLine.Advance(lList.LastIndent);
+      Result:=False;
+      end;
 end;
 
 function TUListProcessor.HandlesLine(aParent: TMarkDownContainerBlock; aLine: TMarkDownLine): boolean;
@@ -630,7 +633,10 @@ begin
      lBlock:=lBlock.Parent as TMarkDownListBlock;
   if (lBlock is TMarkDownListBlock) then
     if aLine.LeadingWhitespace>=lList.baseIndent then
+      begin
+      aLine.Advance(lList.LastIndent);
       Result:=False
+      end;
 end;
 
 
@@ -811,13 +817,15 @@ function TFencedCodeBlockProcessor.LineEndsBlock(aBlock: TMarkDownContainerBlock
 
 var
   s : String;
+  lBlock: TMarkdownCodeBlock absolute aBlock;
 
 begin
   Result:=(aLine=nil);
   if Result then
     Exit;
   // Ending may be preceded by 3 spaces
-  Result:=aLine.LeadingWhitespace>=4;
+
+  Result:=aLine.LeadingWhitespace>=4+lBlock.Indent;
   if Result then
     Exit;
   S:=aLine.Remainder.Trim;
@@ -829,27 +837,20 @@ function TFencedCodeBlockProcessor.processLine(aParent: TMarkDownContainerBlock;
 var
   lBlock : TMarkDownCodeBlock;
   s : String;
-  i : integer;
 
 begin
   lBlock:=TMarkDownCodeBlock.Create(aParent,aLine.LineNo);
   lBlock.fenced:=true;
   lBlock.lang:=Flang;
+  lBlock.Indent:=aLine.CursorPos;
   while Not LineEndsBlock(lBlock,PeekLine) do
     begin
     aLine:=NextLine;
+    if aLine.LeadingWhitespace>=lBlock.Indent then
+      aLine.Advance(lBlock.Indent)
+    else
+      aLine.Advance(aLine.LeadingWhitespace);
     s:=aLine.Remainder;
-    if (FIndent>0) then
-      begin
-      if FIndent>Length(S) then
-        FIndent:=Length(S);
-      I:=1;
-      while (I<=Findent) and (s[i]=' ') do
-        Inc(i);
-      if I>1 then
-        Delete(S,1,I-1);
-      aLine.advance(I-1);
-      end;
     TMarkDownTextBlock.Create(lBlock,aLine.LineNo,S);
     end;
   NextLine;

packages/fcl-md/src/markdown.render.pas

@@ -378,6 +378,7 @@ function TMarkDownElementRenderer.GetParentRenderers: TMarkDownElementRendererAr
 var
   i : integer;
 begin
+  Result:=[];
   SetLength(Result,Renderer.FRenderStack.Count);
   For I:=0 to Renderer.FRenderStack.Count-1 do
     Result[i]:=TMarkDownElementRenderer(Renderer.FRenderStack.items[i]);

packages/fcl-md/tests/testmd.lpi

@@ -41,6 +41,7 @@
       <Unit>
         <Filename Value="utest.markdown.utils.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="UTest.Markdown.Utils"/>
       </Unit>
       <Unit>
         <Filename Value="../src/markdown.elements.pas"/>
@@ -105,6 +106,7 @@
       <Unit>
         <Filename Value="utest.markdown.parser.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="UTest.Markdown.Parser"/>
       </Unit>
       <Unit>
         <Filename Value="../src/markdown.processors.pas"/>

packages/fcl-md/tests/utest.markdown.fpdocrender.pas

@@ -95,8 +95,7 @@ begin
 end;
 
 procedure TTestFPDocRender.StartDoc;
-var
-  l : TMarkDownBlock;
+
 begin
   CreateHeadingBlock('unit1',1);
   CreateHeadingBlock('a',2);

packages/fcl-md/tests/utest.markdown.parser.pas

@@ -61,6 +61,7 @@ type
     procedure TestIndentedCodeBlock;
     procedure TestFencedCodeBlock;
     procedure TestFencedCodeBlockWithInfoString;
+    procedure TestNestedCodeBlock;
   end;
 
   { TTestBlockQuotes }
@@ -237,6 +238,25 @@ begin
   AssertEquals('Language info string incorrect', 'pascal', Block.Lang);
 end;
 
+procedure TTestCodeBlocks.TestNestedCodeBlock;
+var
+  lList : TMarkDownListBlock;
+  lItem : TMarkDownListItemBlock;
+  Block: TMarkDownCodeBlock;
+
+begin
+  SetupParser('* List'#10'   ```'#10'code here'#10'```');
+  AssertEquals('Document should have 1 block', 1, Doc.Blocks.Count);
+  lList := GetBlock(0) as TMarkDownListBlock;
+  AssertEquals('List should have 1 blocks', 1, lList.Blocks.Count);
+  lItem := lList.Blocks[0] as TMarkDownListItemBlock;
+  AssertEquals('List item should have 2 blocks', 2, lItem.Blocks.Count);
+  AssertEquals('First list item is paragraph block', TMarkDownParagraphBlock, lItem.Blocks[0].ClassType);
+  AssertEquals('Second list item is code block', TMarkDownCodeBlock, lItem.Blocks[1].ClassType);
+  Block := lItem.Blocks[1] as TMarkDownCodeBlock;
+  AssertTrue('Should be a fenced code block', Block.Fenced);
+end;
+
 { TTestBlockQuotes }
 
 procedure TTestBlockQuotes.TestSimpleQuote;

packages/fcl-md/tests/utest.markdown.utils.pas

@@ -278,7 +278,7 @@ begin
   if Length(arr) = 3 then
   begin
     AssertEquals('First char should be a', 'a', arr[0]);
-    AssertEquals('Second char should be €','€', arr[1]);
+    AssertEquals('Second char should be €','€', UTF8Encode(arr[1]));
     AssertEquals('Third char should be b', 'b', arr[2]);
   end;
   AssertEquals('Array length for empty string', 0, Length(ToUnicodeChars('')));

rtl/inc/astrings.inc

@@ -200,40 +200,36 @@ begin
   if DestCp=CP_NONE then
     DestCP:=DefaultSystemCodePage;
   DestCP:=TranslatePlaceholderCP(DestCP);
-  { if codepages are different then concat using unicodestring,
-    but avoid conversions if either addend is empty (StringCodePage will return
-    DefaultSystemCodePage in that case, which may differ from other addend/dest) }
-  S1CP:=DestCP;
-  if Length(S1)<>0 then
-    S1CP:=TranslatePlaceholderCP(StringCodePage(S1));
-  S2CP:=S1CP; { So if S2 is empty, S2CP = S1CP. }
-  if Length(S2)<>0 then
-    S2CP:=TranslatePlaceholderCP(StringCodePage(S2));
-  { if the result is rawbytestring and both strings have the same code page,
-    keep that code page or keep the code page if the other string is empty }
-  if cp=CP_NONE then
-   if S1CP=S2CP then { Includes the case of empty S2. }
-     DestCP:=S1CP
-   else if Length(S1)=0 then
-     begin
-       DestCP:=S2CP;
-       S1CP:=S2CP;
-     end;
-  if (S1CP<>DestCP) or (S2CP<>DestCP) then
+  if (Pointer(S1)=nil) or (Pointer(S2)=nil) then
     begin
-      ansistr_concat_complex(DestS,S1,S2,DestCP);
-      exit;
-    end;
-  { only assign if s1 or s2 is empty }
-  if (Length(S1)=0) then
-    begin
-      DestS:=s2;
+      Src:=Pointer(S1);
+      if Src=nil then
+        Src:=Pointer(S2); { Src = the only nonempty string, if any. }
+      DestS:=RawByteString(Src); { ...And maybe convert :) }
+      if (Src<>nil) and (cp<>CP_NONE) then
+        begin
+          S1CP:=PAnsiRec(Src-AnsiFirstOff)^.CodePage;
+          if (DestCP<>S1CP) and (cp<>S1CP) and { Attempt to skip TranslatePlaceholderCP. }
+            (DestCP<>TranslatePlaceholderCP(S1CP)) then
+            SetCodePage(DestS,DestCP,True);
+        end;
       exit;
     end;
-  if (Length(S2)=0) then
+  S1CP:=PAnsiRec(Pointer(S1)-AnsiFirstOff)^.CodePage;
+  S2CP:=PAnsiRec(Pointer(S2)-AnsiFirstOff)^.CodePage;
+  { Attempt to skip TranslatePlaceholderCPs: codepages are usually already equal to cp or DestCP. }
+  if (DestCP<>S1CP) and (cp<>S1CP) or (cp<>S2CP) and (DestCP<>S2CP) then
     begin
-      DestS:=s1;
-      exit;
+      S1CP:=TranslatePlaceholderCP(S1CP);
+      { if codepages are different then concat using unicodestring;
+        but if the result is rawbytestring and both strings have the same code page, keep that code page }
+      if (S1CP<>TranslatePlaceholderCP(S2CP)) or (cp<>CP_NONE) and (DestCP<>S1CP) then
+        begin
+          ansistr_concat_complex(DestS,S1,S2,DestCP);
+          exit;
+        end;
+      if cp=CP_NONE then
+        DestCP:=S1CP;
     end;
   S1Len:=PAnsiRec(Pointer(S1)-AnsiFirstOff)^.Len;
   S2Len:=PAnsiRec(Pointer(S2)-AnsiFirstOff)^.Len;
@@ -287,7 +283,7 @@ procedure fpc_AnsiStr_Concat_multi (var DestS:RawByteString;const sarr:array of
 Var
   lowstart,i,Size,NewLen : SizeInt;
   p,pc,olddestp,newdestp,realdestp : pointer;
-  DestCP,tmpCP : TSystemCodePage;
+  DestCP,tmpCP,tmpCPuntrans,ithCP : TSystemCodePage;
 begin
   DestCP:=cp;
   if DestCp=CP_NONE then
@@ -302,28 +298,38 @@ begin
       DestS:=''; { All source strings empty }
       exit;
     end;
+  tmpCPuntrans:=DestCP;
   DestCP:=TranslatePlaceholderCP(DestCP);
-  tmpCP:=TranslatePlaceholderCP(StringCodePage(sarr[lowstart]));
-  for i:=lowstart+1 to high(sarr) do
+  tmpCP:=DestCP;
+  NewLen:=0;
+  for i:=lowstart to high(sarr) do
     begin
-      { ignore the code page of empty strings, it will always be
-        DefaultSystemCodePage but it doesn't matter for the outcome }
-      if (length(sarr[i])<>0) and
-         (tmpCP<>TranslatePlaceholderCP(StringCodePage(sarr[i]))) then
+      p:=pointer(sarr[i]);
+      if not assigned(p) then
+        continue;
+      inc(NewLen,PAnsiRec(p-AnsiFirstOff)^.Len);
+      ithCP:=PAnsiRec(p-AnsiFirstOff)^.CodePage;
+      if (ithCP=tmpCP) or (ithCP=tmpCPuntrans) then { Attempt to skip TranslatePlaceholderCP. }
+        continue;
+      ithCP:=TranslatePlaceholderCP(ithCP);
+      if ithCP=tmpCP then
+        continue;
+      { On the first iteration, tmpCP = DestCP (to reuse the checks above), and mismatches just adjust tmpCP instead of falling back to concat_multi_complex.
+        Without further mismatches, the concatenated contents will be converted to DestCP by the final SetCodePage. }
+      if i<>lowstart then
         begin
+          if cp=CP_NONE then
+            DestCP:=DefaultSystemCodePage; { Revert “DestCP:=tmpCP” below (no-op if it was never performed). }
           AnsiStr_Concat_multi_complex(DestS,sarr,DestCP);
           exit;
         end;
+      tmpCPuntrans:=ithCP; { Isn’t really “untrans(lated)” from now on, just neutralizes the “ithCP=tmpCPuntrans” check. }
+      tmpCP:=ithCP;
+      { if the result is rawbytestring and all strings have the same code page, keep that code page.
+        Gets reverted back to DefaultSystemCodePage in the concat_multi_complex branch. (This way the check is kept out of the common path.) }
+      if cp=CP_NONE then
+        DestCP:=tmpCP;
     end;
-  { if the result is rawbytestring and all strings have the same code page,
-    keep that code page }
-  if cp=CP_NONE then
-    DestCP:=tmpCP;
-  { Calculate size of the result so we can do
-    a single call to SetLength() }
-  NewLen:=0;
-  for i:=lowstart to high(sarr) do
-    inc(NewLen,length(sarr[i]));
   { In the case of the only nonempty string, either return it directly (if SetCodePage has nothing to do) or skip 1 allocation. }
   if NewLen=PAnsiRec(Pointer(sarr[lowstart])-AnsiFirstOff)^.Len then
     DestS:=sarr[lowstart]

tests/webtbf/tw40118.pp

@@ -1,3 +1,4 @@
+{ %opt=-Sg }
 { %fail }
 program helloWorld;
  label