codetools: started parsing delphi 12 multiline string literals

components/codetools/linkscanner.pas

@@ -640,6 +640,7 @@ type
     FDirectiveCleanPos: integer;
     FDirectivesStored: boolean;
     FDirectoryCachePool: TCTDirectoryCachePool;
+    FIsDelphiMode: boolean;
     FMacrosOn: boolean;
     FMissingIncludeFiles: TMissingIncludeFiles;
     FIncludeStack: TFPList; // list of TSourceLink
@@ -853,6 +854,7 @@ type
     property CompilerModeSwitches: TCompilerModeSwitches
                          read FCompilerModeSwitches write FCompilerModeSwitches;
     property PascalCompiler: TPascalCompiler read FPascalCompiler write SetPascalCompiler;
+    property IsDelphiMode: boolean read FIsDelphiMode;
     property ScanTill: TLinkScannerRange read FScanTill write SetScanTill;
         
     procedure Clear;
@@ -4582,6 +4584,33 @@ procedure TLinkScanner.SkipTillEndifElse(SkippingUntil: TLSSkippingDirective);
       +' New='+dbgs(ord(SkippingUntil)));
   end;
 
+  procedure SkipDelphiMultiLineLiteral(var p: PChar);
+  var
+    lvl, i: Integer;
+  begin
+    inc(p,2);
+    lvl:=3;
+    while (p^='''') do begin
+      inc(p);
+      inc(lvl);
+    end;
+    if lvl and 1=0 then
+      exit; // even amount are apostrophs in string literal, e.g. ''''
+
+    while p^<>#0 do begin
+      if (p^='''') and (p[1]='''') then begin
+        i:=2;
+        inc(p,2);
+        while p^='''' do begin
+          inc(i);
+          if i=lvl then
+            exit;
+        end;
+      end else
+        inc(p);
+    end;
+  end;
+
 var
   p: PChar;
 begin
@@ -4632,15 +4661,19 @@ begin
           inc(p);
       '''':
         begin
-          // skip string constant
+          // skip string literal
           inc(p);
+          if IsDelphiMode and (p^='''') and (p[1]='''') then begin
+            SkipDelphiMultiLineLiteral(p);
+          end else begin
             while not (p^ in ['''',#0,#10,#13]) do inc(p);
             if p^='''' then
               inc(p);
           end;
+        end;
       '`':
         begin
-          // skip multiline string constant
+          // skip multiline string literal
           inc(p);
           while not (p^ in ['`',#0]) do inc(p);
           if p^='`' then
@@ -4685,10 +4718,12 @@ begin
   FCompilerMode:=AValue;
   OldModeSwitches:=FCompilerModeSwitches;
   FCompilerModeSwitches:=DefaultCompilerModeSwitches[CompilerMode];
-  if FPascalCompiler=pcPas2js then
+  case FPascalCompiler of
-    FCompilerModeSwitches:=FCompilerModeSwitches+Pas2jsFixedModeswitches;
+  pcPas2js: FCompilerModeSwitches:=FCompilerModeSwitches+Pas2jsFixedModeswitches;
+  end;
   FNestedComments:=cmsNested_comment in CompilerModeSwitches;
   Values.Variables[CompilerModeVars[FCompilerMode]]:='1';
+  FIsDelphiMode:=AValue in [cmDELPHI, cmDELPHIUNICODE];
 
   EnabledModeSwitches:=FCompilerModeSwitches-OldModeSwitches;
   DisabledModeSwitches:=OldModeSwitches-FCompilerModeSwitches;
@@ -4706,6 +4741,7 @@ begin
   if FPascalCompiler=AValue then Exit;
   FPascalCompiler:=AValue;
   case PascalCompiler of
+  pcDelphi: FIsDelphiMode:=true;
   pcPas2js: ;
   end;
 end;

components/codetools/tests/testpascalparser.pas

@@ -56,7 +56,8 @@ type
     procedure TestParseProcAnoArg;
     procedure TestParseProcAnoArgSubFunc;
     procedure TestParseThreadVar;
-    procedure TestParseMultilineString;
+    procedure TestParseMultilineStringFPC;
+    procedure TestParseMultilineStringDelphi;
     procedure TestParseUnderscoreIsSeparator;
     procedure TestParseDirective_IF_SizeOf_Char;
   end;
@@ -617,7 +618,7 @@ begin
   ParseModule;
 end;
 
-procedure TTestPascalParser.TestParseMultilineString;
+procedure TTestPascalParser.TestParseMultilineStringFPC;
 begin
   Add([
   'program test1;',
@@ -636,6 +637,24 @@ begin
   ParseModule;
 end;
 
+procedure TTestPascalParser.TestParseMultilineStringDelphi;
+begin
+  Add([
+  'program test1;',
+  '{$TEXTBLOCK Native comment: could be native/cr/lf/crlf}',
+  'const',
+  '  s = ''''''First',
+  '    Second''Lit', // skip single apostroph
+  '    Third''''Lit', // skip double apostroph
+  '    '''''';', // last line defines ignored indentation. here: cut 4
+  '  a = ''''''OneLine'''''';',
+  '  b = ''''; // empty string literal',
+  '  c = ''''''''; // string literal in string literal',
+  'begin',
+  '']);
+  ParseModule;
+end;
+
 procedure TTestPascalParser.TestParseUnderscoreIsSeparator;
 begin
   Add([