فهرست منبع

fcl-passrc: delphi multiline strings as separate TPasExprKind pekStringMultiLine

mattias 1 سال پیش
والد
کامیت
0566580f15

+ 67 - 50
packages/fcl-passrc/src/pasresolveeval.pas

@@ -760,6 +760,7 @@ type
     function EvalSetExpr(Expr: TPasExpr; ExprArray: TPasExprArray; Flags: TResEvalFlags): TResEvalSet;
     function EvalSetExpr(Expr: TPasExpr; ExprArray: TPasExprArray; Flags: TResEvalFlags): TResEvalSet;
     function EvalArrayValuesExpr(Expr: TArrayValues; Flags: TResEvalFlags): TResEvalSet;
     function EvalArrayValuesExpr(Expr: TArrayValues; Flags: TResEvalFlags): TResEvalSet;
     function EvalPrimitiveExprString(Expr: TPrimitiveExpr): TResEvalValue; virtual;
     function EvalPrimitiveExprString(Expr: TPrimitiveExpr): TResEvalValue; virtual;
+    function EvalPrimitiveExprStringMultiLine(Expr: TPrimitiveExpr): TResEvalValue; virtual;
     procedure PredBool(Value: TResEvalBool; ErrorEl: TPasElement);
     procedure PredBool(Value: TResEvalBool; ErrorEl: TPasElement);
     procedure SuccBool(Value: TResEvalBool; ErrorEl: TPasElement);
     procedure SuccBool(Value: TResEvalBool; ErrorEl: TPasElement);
     procedure PredInt(Value: TResEvalInt; ErrorEl: TPasElement);
     procedure PredInt(Value: TResEvalInt; ErrorEl: TPasElement);
@@ -4508,66 +4509,77 @@ begin
   {$else}
   {$else}
   Value:=TResEvalUTF16.Create;
   Value:=TResEvalUTF16.Create;
   {$endif}
   {$endif}
-  p:=1;
-  //writeln('TResExprEvaluator.EvalPrimitiveExprString ',GetObjPath(Expr),' ',Expr.SourceFilename,' ',Expr.SourceLinenumber div 2048,' S=[',S,']');
-  while p<=l do
-    case S[p] of
-    {$ifdef UsePChar}
-    #0: break;
-    {$endif}
-    '''':
-      begin
-      inc(p);
-      StartP:=p;
-      repeat
+  try
+    p:=1;
+    //writeln('TResExprEvaluator.EvalPrimitiveExprString ',GetObjPath(Expr),' ',Expr.SourceFilename,' ',Expr.SourceLinenumber div 2048,' S=[',S,']');
+    while p<=l do
+      case S[p] of
+      {$ifdef UsePChar}
+      #0: break;
+      {$endif}
+      '''':
+        begin
+        inc(p);
+        StartP:=p;
+        repeat
+          if p>l then
+            RaiseInternalError(20170523113938);
+          c:=S[p];
+          case c of
+          '''':
+            begin
+            if p>StartP then
+              AddSrc(copy(S,StartP,p-StartP));
+            inc(p);
+            StartP:=p;
+            if (p>l) or (S[p]<>'''') then
+              break;
+            AddSrc('''');
+            inc(p);
+            StartP:=p;
+            end;
+          else
+            inc(p);
+          end;
+        until false;
+        if p>StartP then
+          AddSrc(copy(S,StartP,p-StartP));
+        end;
+      '#':
+        p:=ReadHash(S,p,l);
+      '^':
+        begin
+        // ^A is #1
+        inc(p);
         if p>l then
         if p>l then
-          RaiseInternalError(20170523113938);
+          RaiseInternalError(20181016121520);
         c:=S[p];
         c:=S[p];
         case c of
         case c of
-        '''':
-          begin
-          if p>StartP then
-            AddSrc(copy(S,StartP,p-StartP));
-          inc(p);
-          StartP:=p;
-          if (p>l) or (S[p]<>'''') then
-            break;
-          AddSrc('''');
-          inc(p);
-          StartP:=p;
-          end;
-        else
-          inc(p);
+        'a'..'z': AddHash(ord(c)-ord('a')+1);
+        'A'..'Z': AddHash(ord(c)-ord('A')+1);
+        else RaiseInternalError(20170523123809);
         end;
         end;
-      until false;
-      if p>StartP then
-        AddSrc(copy(S,StartP,p-StartP));
-      end;
-    '#':
-      p:=ReadHash(S,p,l);
-    '^':
-      begin
-      // ^A is #1
-      inc(p);
-      if p>l then
-        RaiseInternalError(20181016121520);
-      c:=S[p];
-      case c of
-      'a'..'z': AddHash(ord(c)-ord('a')+1);
-      'A'..'Z': AddHash(ord(c)-ord('A')+1);
-      else RaiseInternalError(20170523123809);
-      end;
-      inc(p);
+        inc(p);
+        end;
+      else
+        RaiseNotYetImplemented(20170523123815,Expr,'ord='+IntToStr(ord(S[p])));
       end;
       end;
-    else
-      RaiseNotYetImplemented(20170523123815,Expr,'ord='+IntToStr(ord(S[p])));
-    end;
-  Result:=Value;
+    Result:=Value;
+    Value:=nil;
+  finally
+    Value.Free;
+  end;
   {$IFDEF VerbosePasResEval}
   {$IFDEF VerbosePasResEval}
   //writeln('TResExprEvaluator.EvalPrimitiveExprString Result=',Result.AsString);
   //writeln('TResExprEvaluator.EvalPrimitiveExprString Result=',Result.AsString);
   {$ENDIF}
   {$ENDIF}
 end;
 end;
 
 
+function TResExprEvaluator.EvalPrimitiveExprStringMultiLine(Expr: TPrimitiveExpr
+  ): TResEvalValue;
+begin
+  Result:=TResEvalUTF16.CreateValue(GetUnicodeStr(Expr.Value,Expr));
+end;
+
 function TResExprEvaluator.CreateResEvalInt(UInt: TMaxPrecUInt): TResEvalValue;
 function TResExprEvaluator.CreateResEvalInt(UInt: TMaxPrecUInt): TResEvalValue;
 begin
 begin
   if UInt<=HighIntAsUInt then
   if UInt<=HighIntAsUInt then
@@ -4673,6 +4685,11 @@ begin
         Result:=EvalPrimitiveExprString(TPrimitiveExpr(Expr));
         Result:=EvalPrimitiveExprString(TPrimitiveExpr(Expr));
         exit;
         exit;
         end;
         end;
+      pekStringMultiLine:
+        begin
+        Result:=EvalPrimitiveExprStringMultiLine(TPrimitiveExpr(Expr));
+        exit;
+        end;
     else
     else
       RaiseNotYetImplemented(20170518200951,Expr);
       RaiseNotYetImplemented(20170518200951,Expr);
     end;
     end;

+ 11 - 2
packages/fcl-passrc/src/pasresolver.pp

@@ -10213,7 +10213,7 @@ begin
     case Primitive.Kind of
     case Primitive.Kind of
     pekIdent: ResolveNameExpr(El,Primitive.Value,Access);
     pekIdent: ResolveNameExpr(El,Primitive.Value,Access);
     pekNumber: ;
     pekNumber: ;
-    pekString: ;
+    pekString,pekStringMultiLine: ;
     pekNil,pekBoolConst: ;
     pekNil,pekBoolConst: ;
     else
     else
       RaiseNotYetImplemented(20160922163451,El);
       RaiseNotYetImplemented(20160922163451,El);
@@ -28016,6 +28016,15 @@ begin
                                FBaseTypes[btString],FBaseTypes[btString],
                                FBaseTypes[btString],FBaseTypes[btString],
                                TPrimitiveExpr(El),[rrfReadable]);
                                TPrimitiveExpr(El),[rrfReadable]);
         end;
         end;
+      pekStringMultiLine:
+        begin
+        {$IFDEF VerbosePasResolver}
+        writeln('TPasResolver.ComputeElement pekStringMultiLine Value="',LeftStr(TPrimitiveExpr(El).Value,1,500),'"');
+        {$ENDIF}
+        SetResolverValueExpr(ResolvedEl,btString,
+                             FBaseTypes[btString],FBaseTypes[btString],
+                             TPrimitiveExpr(El),[rrfReadable]);
+        end;
       pekNil:
       pekNil:
         SetResolverValueExpr(ResolvedEl,btNil,FBaseTypes[btNil],FBaseTypes[btNil],
         SetResolverValueExpr(ResolvedEl,btNil,FBaseTypes[btNil],FBaseTypes[btNil],
                              TPrimitiveExpr(El),[rrfReadable]);
                              TPrimitiveExpr(El),[rrfReadable]);
@@ -28458,7 +28467,7 @@ begin
   Expr:=ResolvedEl.ExprEl;
   Expr:=ResolvedEl.ExprEl;
   if Expr<>nil then
   if Expr<>nil then
     begin
     begin
-    if Expr.Kind in [pekNumber,pekString,pekNil,pekBoolConst] then
+    if Expr.Kind in [pekNumber,pekString,pekStringMultiLine,pekNil,pekBoolConst] then
       exit(true)
       exit(true)
     else
     else
       exit(false);
       exit(false);

+ 4 - 2
packages/fcl-passrc/src/pastree.pp

@@ -193,7 +193,8 @@ type
     {$endif}
     {$endif}
   end;
   end;
 
 
-  TPasExprKind = (pekIdent, pekNumber, pekString, pekSet, pekNil, pekBoolConst,
+  TPasExprKind = (pekIdent, pekNumber, pekString, pekStringMultiLine, pekSet,
+     pekNil, pekBoolConst,
      pekRange, pekUnary, pekBinary, pekFuncParams, pekArrayParams, pekListOfExp,
      pekRange, pekUnary, pekBinary, pekFuncParams, pekArrayParams, pekListOfExp,
      pekInherited, pekSelf, pekSpecialize, pekProcedure);
      pekInherited, pekSelf, pekSpecialize, pekProcedure);
 
 
@@ -1754,7 +1755,8 @@ const
   ExprKindNames : Array[TPasExprKind] of TPasTreeString = (
   ExprKindNames : Array[TPasExprKind] of TPasTreeString = (
       'Ident',
       'Ident',
       'Number',
       'Number',
-      'TPasTreeString',
+      'String',
+      'StringMultiLine',
       'Set',
       'Set',
       'Nil',
       'Nil',
       'BoolConst',
       'BoolConst',

+ 4 - 3
packages/fcl-passrc/src/pparser.pp

@@ -1284,7 +1284,7 @@ end;
 function TPasParser.CurTokenText: String;
 function TPasParser.CurTokenText: String;
 begin
 begin
   case CurToken of
   case CurToken of
-    tkIdentifier, tkString, tkNumber, tkChar:
+    tkIdentifier, tkString, tkStringMultiLine, tkNumber, tkChar:
       Result := FCurTokenString;
       Result := FCurTokenString;
     else
     else
       Result := TokenInfos[CurToken];
       Result := TokenInfos[CurToken];
@@ -1707,7 +1707,7 @@ begin
       if (h=hDeprecated) then
       if (h=hDeprecated) then
         begin
         begin
         NextToken;
         NextToken;
-        if (Curtoken<>tkString) then
+        if (CurToken<>tkString) then
           UnGetToken
           UnGetToken
         else if assigned(Element) then
         else if assigned(Element) then
           Element.HintMessage:=CurTokenString;
           Element.HintMessage:=CurTokenString;
@@ -2647,8 +2647,9 @@ begin
   CanSpecialize:=aCannot;
   CanSpecialize:=aCannot;
   aName:='';
   aName:='';
   case CurToken of
   case CurToken of
+    tkChar:   Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenString);
     tkString: Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenString);
     tkString: Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenString);
-    tkChar:   Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenText);
+    tkStringMultiLine: Last:=CreatePrimitiveExpr(AParent,pekStringMultiLine,CurTokenString);
     tkNumber: Last:=CreatePrimitiveExpr(AParent,pekNumber,CurTokenString);
     tkNumber: Last:=CreatePrimitiveExpr(AParent,pekNumber,CurTokenString);
     tkIdentifier:
     tkIdentifier:
       begin
       begin

+ 97 - 51
packages/fcl-passrc/src/pscanner.pp

@@ -85,6 +85,7 @@ const
   nErrInvalidMultiLineLineEnding = 1035;
   nErrInvalidMultiLineLineEnding = 1035;
   nWarnIgnoringLinkLib = 1036;
   nWarnIgnoringLinkLib = 1036;
   nErrInvalidIndent = 1037;
   nErrInvalidIndent = 1037;
+  nErrMultilineNonWhiteSpaceBeforeClosing = 1038;
 
 
 // resourcestring patterns of messages
 // resourcestring patterns of messages
 resourcestring
 resourcestring
@@ -127,6 +128,7 @@ resourcestring
   SErrInvalidMultiLineLineEnding = 'Invalid multilinestring line ending type: use one of CR/LF/CRLF/SOURCE/PLATFORM' ;
   SErrInvalidMultiLineLineEnding = 'Invalid multilinestring line ending type: use one of CR/LF/CRLF/SOURCE/PLATFORM' ;
   SWarnIgnoringLinkLib = 'Ignoring LINKLIB directive %s -> %s (Options: %s)';
   SWarnIgnoringLinkLib = 'Ignoring LINKLIB directive %s -> %s (Options: %s)';
   SErrInvalidIndent = ' Inconsistent indent characters';
   SErrInvalidIndent = ' Inconsistent indent characters';
+  SErrMultilineNonWhiteSpaceBeforeClosing = 'There should be no white-space characters before closing quotes of the text block';
 
 
 type
 type
   {$IFDEF PAS2JS}
   {$IFDEF PAS2JS}
@@ -164,7 +166,8 @@ type
     tkWhitespace,
     tkWhitespace,
     tkComment,
     tkComment,
     tkIdentifier,
     tkIdentifier,
-    tkString,
+    tkString, // string literal including quotes, e.g. 'a'#13^M''''
+    tkStringMultiLine, // string literal in raw format
     tkNumber,
     tkNumber,
     tkChar, // ^A .. ^Z
     tkChar, // ^A .. ^Z
     // Simple (one-character) tokens
     // Simple (one-character) tokens
@@ -908,7 +911,7 @@ type
     procedure PopStackItem; virtual;
     procedure PopStackItem; virtual;
     function DoFetchTextToken: TToken; // including quotes
     function DoFetchTextToken: TToken; // including quotes
     function DoFetchMultilineTextToken: TToken; // back ticks are converted to apostrophs, unindented
     function DoFetchMultilineTextToken: TToken; // back ticks are converted to apostrophs, unindented
-    function DoFetchDelphiMultiLineTextToken(quotelen: Integer): TToken;
+    function DoFetchDelphiMultiLineTextToken(QuoteLen: Integer): TToken;
     function DoFetchToken: TToken;
     function DoFetchToken: TToken;
     procedure ClearFiles;
     procedure ClearFiles;
     Procedure ClearMacros;
     Procedure ClearMacros;
@@ -1012,7 +1015,8 @@ const
     'Whitespace',
     'Whitespace',
     'Comment',
     'Comment',
     'Identifier',
     'Identifier',
-    'TPasScannerString',
+    'String',
+    'StringMultiLine',
     'Number',
     'Number',
     'Character',
     'Character',
     '(',
     '(',
@@ -4145,18 +4149,15 @@ begin
   until false;
   until false;
 end;
 end;
 
 
-function TPascalScanner.DoFetchDelphiMultiLineTextToken(quotelen : Integer): TToken;
+function TPascalScanner.DoFetchDelphiMultiLineTextToken(QuoteLen : Integer): TToken;
 // works similar to DoFetchTextToken, except changes indentation
 // works similar to DoFetchTextToken, except changes indentation
 
 
 var
 var
-  TokenStart: {$ifdef UsePChar}PAnsiChar{$else}integer{$endif};
-  {$ifndef UsePChar}
   s: TPasScannerString;
   s: TPasScannerString;
-  l: integer;
-  {$endif}
   CurLF : TPasScannerString;
   CurLF : TPasScannerString;
   Lines : Array of String;
   Lines : Array of String;
-  I,SpaceCount,QuoteCount,WhiteSpaces,CurLines : Integer;
+  l, I, SpaceCount, QuoteCount, WhiteSpaces, CurLineCount , Cnt: Integer;
+  HasNonWhiteSpace: Boolean;
 
 
   Procedure AddToLines;
   Procedure AddToLines;
 
 
@@ -4165,10 +4166,10 @@ var
 
 
   begin
   begin
     L:=Length(Lines);
     L:=Length(Lines);
-    if CurLines=L then
-      SetLength(Lines,L+10);
-    Lines[CurLines]:=FCurLine;
-    Inc(CurLines);
+    if CurLineCount=L then
+      SetLength(Lines,L*2+10);
+    Lines[CurLineCount]:=FCurLine;
+    Inc(CurLineCount);
   end;
   end;
 
 
   Function LocalFetchLine : Boolean;
   Function LocalFetchLine : Boolean;
@@ -4185,12 +4186,11 @@ var
     s:=FCurLine;
     s:=FCurLine;
     l:=length(s);
     l:=length(s);
     {$ENDIF}
     {$ENDIF}
-    TokenStart:=FTokenPos;
   end;
   end;
 
 
 begin
 begin
   Lines:=[];
   Lines:=[];
-  CurLines:=0;
+  CurLineCount:=0;
   Result:=tkEOF;
   Result:=tkEOF;
   FCurTokenString := '';
   FCurTokenString := '';
   // On entry, we know that the current position is the start of the multiline quoted string.
   // On entry, we know that the current position is the start of the multiline quoted string.
@@ -4200,7 +4200,7 @@ begin
     WhiteSpaces:=0;
     WhiteSpaces:=0;
     if not LocalFetchLine then
     if not LocalFetchLine then
       exit(tkEOF);
       exit(tkEOF);
-    // Skip whitespace, but count.
+    // Skip whitespace, but count, as the last line defines the unindented WhiteSpaces.
     {$IFDEF USEPCHAR}
     {$IFDEF USEPCHAR}
     While (FTokenPos[0]=' ') do
     While (FTokenPos[0]=' ') do
     {$ELSE}
     {$ELSE}
@@ -4210,49 +4210,95 @@ begin
       Inc(FTokenPos);
       Inc(FTokenPos);
       Inc(WhiteSpaces);
       Inc(WhiteSpaces);
       end;
       end;
-    // Count quotes
-    {$IFDEF USEPCHAR}
-    While (FTokenPos[0]=SingleQuote) and (QuoteCount<QuoteLen) do
-    {$ELSE}
-    While  (QuoteCount<QuoteLen) and (FTokenPos<=l) and (s[FTokenPos]=SingleQuote) do
-    {$ENDIF}
-      begin
-      Inc(FTokenPos);
-      Inc(QuoteCount);
+    // check for the end sequence of quotes
+    HasNonWhiteSpace:=false;
+    repeat
+      {$IFDEF USEPCHAR}
+      case FTokenPos[0] of
+      #0:
+        break;
+      {$ELSE}
+      if FTokenPos>l then
+        break;
+      case s[FTokenPos] of
+      {$ENDIF}
+      SingleQuote:
+        begin
+          repeat
+            inc(FTokenPos);
+            inc(QuoteCount);
+          {$IFDEF UsePChar}
+          until (FTokenPos[0]<>SingleQuote) or (QuoteCount=QuoteLen);
+          {$ELSE}
+          until (FTokenPos>l) or (s[FTokenPos]<>SingleQuote) or (QuoteCount=QuoteLen);
+          {$ENDIF}
+          if QuoteCount=QuoteLen then
+            begin
+            if HasNonWhiteSpace then
+              Error(nErrMultilineNonWhiteSpaceBeforeClosing,sErrMultilineNonWhiteSpaceBeforeClosing);
+            break;
+            end;
+          HasNonWhiteSpace:=true;
+        end;
+      else
+        HasNonWhiteSpace:=true;
+        inc(FTokenPos);
       end;
       end;
-    // End of multiline detected ?
+    until false;
     if QuoteCount<>QuoteLen then
     if QuoteCount<>QuoteLen then
-      AddToLines;
-  Until QuoteCount=QuoteLen;
-  if (QuoteCount=0) then
-    Exit(tkEOF);
-  // Final string Construction
-  FCurTokenString:=SingleQuote;
+      AddToLines // another multiline
+    else
+      break;
+  Until false;
+  // Note: the last line defines the needed whitespaces of all lines
+
   CurLF:=GetMultiLineStringLineEnd(FCurSourceFile);
   CurLF:=GetMultiLineStringLineEnd(FCurSourceFile);
-  For I:=0 to CurLines-1 do
+
+  // unindent
+  Cnt:=0;
+  For I:=0 to CurLineCount-1 do
     begin
     begin
+    // cut whitespaces
+    s:=Lines[I];
+    SpaceCount:=0;
+    l:=length(s);
+    while (SpaceCount<l) and (s[SpaceCount+1]=' ') do
+      inc(SpaceCount);
+    if SpaceCount=l then
+      begin
+      // empty line
+      s:='';
+      end
+    else if SpaceCount<WhiteSpaces then
+      ErrorAt(nErrInvalidIndent,SErrInvalidIndent,CurRow-CurLineCount+I,SpaceCount)
+    else
+      s:=copy(s,WhiteSpaces+1,l);
+    Lines[I]:=s;
     if I>0 then
     if I>0 then
-      FCurTokenString:=FCurTokenString+CurLf;
-    If Lines[I]<>'' then
+      inc(Cnt,length(CurLF));
+    inc(Cnt,length(s));
+    end;
+
+  // build final string
+  SetLength(FCurTokenString,Cnt);
+  Cnt:=0;
+  For I:=0 to CurLineCount-1 do
+    begin
+    s:=Lines[I];
+    l:=length(s);
+    if l>0 then
       begin
       begin
-      {$IFDEF USEPCHAR}
-      TokenStart:=@Lines[I][1];
-      SpaceCount:=0;
-      While (TokenStart[0]=' ') and (SpaceCount<WhiteSpaces) do
-      {$ELSE}
-      While (S[TokenStart]=' ') and (SpaceCount<WhiteSpaces) do
-      {$ENDIF}
-        begin
-        Inc(SpaceCount);
-        Inc(TokenStart);
-        end;
-      if SpaceCount<WhiteSpaces then
-        ErrorAt(nErrInvalidIndent,SErrInvalidIndent,CurRow-CurLines+I,SpaceCount);
-      FCurTokenString:=FCurTokenString+Copy(Lines[i],SpaceCount+1,Length(Lines[i])-SpaceCount);
+      System.Move(s[1],FCurTokenString[Cnt+1],l);
+      inc(Cnt,l);
+      end;
+    if I<CurLineCount-1 then
+      begin
+      l:=length(CurLF);
+      System.Move(CurLF[1],FCurTokenString[Cnt+1],l);
+      inc(Cnt,l);
       end;
       end;
     end;
     end;
-  FCurTokenString:=FCurTokenString+SingleQuote;
-  Result:=tkString;
+  Result:=tkStringMultiLine;
 end;
 end;
 
 
 procedure TPascalScanner.PushStackItem;
 procedure TPascalScanner.PushStackItem;

+ 45 - 16
packages/fcl-passrc/tests/tcscanner.pas

@@ -146,8 +146,10 @@ type
     procedure TestDelphiMultiLineTrailingGarbage1;
     procedure TestDelphiMultiLineTrailingGarbage1;
     procedure TestDelphiMultiLineTrailingGarbage2;
     procedure TestDelphiMultiLineTrailingGarbage2;
     procedure TestDelphiMultiLineTrailingGarbage3;
     procedure TestDelphiMultiLineTrailingGarbage3;
+    procedure TestDelphiMultiLineTrailingPlusLit;
     procedure TestDelphiMultiLineEmbeddedQuotes;
     procedure TestDelphiMultiLineEmbeddedQuotes;
     procedure TestDelphiMultiLineInDelphiMode;
     procedure TestDelphiMultiLineInDelphiMode;
+    procedure TestDelphiMultiLineFailNonWhiteSpaceBeforeClosing;
     Procedure TestTextBlockDirective;
     Procedure TestTextBlockDirective;
     procedure TestNumber;
     procedure TestNumber;
     procedure TestChar;
     procedure TestChar;
@@ -625,10 +627,14 @@ begin
     begin
     begin
     tk:=FScanner.FetchToken;
     tk:=FScanner.FetchToken;
     AssertEquals(Format('Read token %d equals expected token.',[i]),t[i],tk);
     AssertEquals(Format('Read token %d equals expected token.',[i]),t[i],tk);
-    if tk=tkIdentifier then
-      LastIdentifier:=FScanner.CurtokenString
-    else if tk=tkString then
+    case tk of
+    tkIdentifier:
+      LastIdentifier:=FScanner.CurtokenString;
+    tkString:
       fTestTokenString:=FScanner.CurTokenString;
       fTestTokenString:=FScanner.CurTokenString;
+    tkStringMultiLine:
+      fTestTokenString:=FScanner.CurTokenString;
+    end;
     end;
     end;
   if CheckEOF then
   if CheckEOF then
     begin
     begin
@@ -923,7 +929,7 @@ end;
 procedure TTestScanner.DoTestDelphiMultiLineString;
 procedure TTestScanner.DoTestDelphiMultiLineString;
 
 
 begin
 begin
-  TestTokens([pscanner.tkWhitespace,pscanner.tkString],FMultiLine);
+  TestTokens([pscanner.tkWhitespace,pscanner.tkStringMultiLine],FMultiLine);
 end;
 end;
 
 
 procedure TTestScanner.DoTestDelphiMultiLine;
 procedure TTestScanner.DoTestDelphiMultiLine;
@@ -971,7 +977,7 @@ begin
   FMultiLine:=CreateDelphiMultiLine([S1,S2]);
   FMultiLine:=CreateDelphiMultiLine([S1,S2]);
   Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings];
   Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings];
   DoTestDelphiMultiLineString;
   DoTestDelphiMultiLineString;
-  AssertEquals('Correct string',SingleQuote+S1+sLineBreak+S2+SingleQuote,TestTokenString);
+  AssertEquals('Correct string',S1+sLineBreak+S2,TestTokenString);
 end;
 end;
 
 
 procedure TTestScanner.TestDelphiMultiLineSpecial2;
 procedure TTestScanner.TestDelphiMultiLineSpecial2;
@@ -984,7 +990,7 @@ begin
   FMultiLine:=CreateDelphiMultiLine([S1,S2]);
   FMultiLine:=CreateDelphiMultiLine([S1,S2]);
   Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings];
   Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings];
   DoTestDelphiMultiLineString;
   DoTestDelphiMultiLineString;
-  AssertEquals('Correct string',SingleQuote+S1+sLineBreak+S2+SingleQuote,TestTokenString);
+  AssertEquals('Correct string',S1+sLineBreak+S2,TestTokenString);
 end;
 end;
 
 
 procedure TTestScanner.TestDelphiMultiLineTrailingGarbage1;
 procedure TTestScanner.TestDelphiMultiLineTrailingGarbage1;
@@ -1028,6 +1034,19 @@ begin
   AssertException('Trailing garbage leads to error',EAssertionFailedError,@DoTestDelphiMultiLineString,'"Wrong character, expected lineending." expected: <tkLineEnding> but was: <tkChar>');
   AssertException('Trailing garbage leads to error',EAssertionFailedError,@DoTestDelphiMultiLineString,'"Wrong character, expected lineending." expected: <tkLineEnding> but was: <tkChar>');
 end;
 end;
 
 
+procedure TTestScanner.TestDelphiMultiLineTrailingPlusLit;
+var
+  S1,S2 : String;
+
+begin
+  S1:='Line 1 ';
+  S2:='Line 2';
+  FMultiLine:=CreateDelphiMultiLine([S1,S2],2,'+''abc'';');
+  Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings];
+  TestTokens([pscanner.tkWhitespace,pscanner.tkStringMultiLine,pscanner.tkPlus,pscanner.tkString,pscanner.tkSemicolon],FMultiLine);
+  AssertEquals('Correct string','''abc''',TestTokenString);
+end;
+
 procedure TTestScanner.TestDelphiMultiLineEmbeddedQuotes;
 procedure TTestScanner.TestDelphiMultiLineEmbeddedQuotes;
 var
 var
   S1,S2,S3 : String;
   S1,S2,S3 : String;
@@ -1039,22 +1058,32 @@ begin
   FMultiLine:=CreateDelphiMultiLine([S1,S2,S3],2,'',5);
   FMultiLine:=CreateDelphiMultiLine([S1,S2,S3],2,'',5);
   Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings];
   Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings];
   DoTestDelphiMultiLineString;
   DoTestDelphiMultiLineString;
-  AssertEquals('Correct string',SingleQuote+S1+sLineBreak+S2+sLineBreak+S3+SingleQuote,TestTokenString);
+  AssertEquals('Correct string',S1+sLineBreak+S2+sLineBreak+S3,TestTokenString);
 end;
 end;
 
 
 procedure TTestScanner.TestDelphiMultiLineInDelphiMode;
 procedure TTestScanner.TestDelphiMultiLineInDelphiMode;
 
 
-  var
-    S1,S2 : String;
+var
+  S1,S2 : String;
 
 
-  begin
-    S1:='Line 1';
-    S2:='Line 2';
-    FMultiLine:='{$mode delphi}'+sLineBreak+CreateDelphiMultiLine([S1,S2]);
-    TestTokens([pscanner.tkComment, pscanner.tkLineEnding,pscanner.tkWhitespace,pscanner.tkString],FMultiLine);
+begin
+  S1:='Line 1';
+  S2:='Line 2';
+  FMultiLine:='{$mode delphi}'+sLineBreak+CreateDelphiMultiLine([S1,S2]);
+  TestTokens([pscanner.tkComment, pscanner.tkLineEnding,pscanner.tkWhitespace,pscanner.tkStringMultiLine],FMultiLine);
 
 
-    AssertEquals('Correct string',SingleQuote+S1+sLineBreak+S2+SingleQuote,TestTokenString);
+  AssertEquals('Correct string',S1+sLineBreak+S2,TestTokenString);
+end;
 
 
+procedure TTestScanner.TestDelphiMultiLineFailNonWhiteSpaceBeforeClosing;
+var
+  S1, S2: String;
+begin
+  S1:='Line1';
+  S2:='Line''''''''2';
+  FMultiLine:=CreateDelphiMultiLine([S1,S2],2,'');
+  Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings];
+  AssertException('Non Whitespace chars before closing',EScannerError,@DoTestDelphiMultiLineString,'afile.pp(3,10) Error: '+SErrMultilineNonWhiteSpaceBeforeClosing);
 end;
 end;
 
 
 
 
@@ -1069,7 +1098,7 @@ begin
   FMultiLine:=CreateDelphiMultiLine([S1,S2]);
   FMultiLine:=CreateDelphiMultiLine([S1,S2]);
   Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings];
   Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msDelphiMultiLineStrings];
   DoTestDelphiMultiLineString;
   DoTestDelphiMultiLineString;
-  AssertEquals('Correct string',SingleQuote+S1+sLineBreak+S2+SingleQuote,TestTokenString);
+  AssertEquals('Correct string',S1+sLineBreak+S2,TestTokenString);
 end;
 end;
 
 
 procedure TTestScanner.TestCharString;
 procedure TTestScanner.TestCharString;

+ 13 - 3
packages/pastojs/src/fppas2js.pp

@@ -8815,7 +8815,7 @@ begin
     Case El.Kind of
     Case El.Kind of
       pekIdent : Result:=GetPasIdentValueType(El.Name,AContext);
       pekIdent : Result:=GetPasIdentValueType(El.Name,AContext);
       pekNumber : Result:=jstNumber;
       pekNumber : Result:=jstNumber;
-      pekString : Result:=jstString;
+      pekString,pekStringMultiLine : Result:=jstString;
       pekSet : Result:=jstUNDEFINED;
       pekSet : Result:=jstUNDEFINED;
       pekNil : Result:=jstNull;
       pekNil : Result:=jstNull;
       pekBoolConst : Result:=jstBoolean;
       pekBoolConst : Result:=jstBoolean;
@@ -8862,10 +8862,15 @@ begin
     if Expr is TPrimitiveExpr then
     if Expr is TPrimitiveExpr then
       begin
       begin
       Prim:=TPrimitiveExpr(Expr);
       Prim:=TPrimitiveExpr(Expr);
-      if Prim.Kind=pekString then
-        Result:=Prim.Value
+      case Prim.Kind of
+      pekString:
+        begin
+        Result:=Prim.Value;
+        Result:={$IFDEF pas2js}DeQuoteString{$ELSE}AnsiDequotedStr{$ENDIF}(Result,'''');
+        end;
       else
       else
         RaiseNotSupported(Prim,AContext,20170215124733);
         RaiseNotSupported(Prim,AContext,20170215124733);
+      end;
       end
       end
     else
     else
       RaiseNotSupported(Expr,AContext,20170322121331);
       RaiseNotSupported(Expr,AContext,20170322121331);
@@ -10347,6 +10352,11 @@ begin
         end;
         end;
       //writeln('TPasToJSConverter.ConvertPrimitiveExpression Result="',TJSLiteral(Result).Value.AsString,'" ',GetObjName(AContext.Resolver));
       //writeln('TPasToJSConverter.ConvertPrimitiveExpression Result="',TJSLiteral(Result).Value.AsString,'" ',GetObjName(AContext.Resolver));
       end;
       end;
+    pekStringMultiLine:
+      begin
+      Result:=CreateLiteralJSString(El,StrToJSString(El.Value));
+      //writeln('TPasToJSConverter.ConvertPrimitiveExpression Result="',TJSLiteral(Result).Value.AsString,'" ',GetObjName(AContext.Resolver));
+      end;
     pekNumber:
     pekNumber:
       begin
       begin
       case El.Value[1] of
       case El.Value[1] of

+ 1 - 0
packages/pastojs/src/pas2jsfiler.pp

@@ -354,6 +354,7 @@ const
     'Ident',
     'Ident',
     'Number',
     'Number',
     'String',
     'String',
+    'StringMultiLine',
     'Set',
     'Set',
     'Nil',
     'Nil',
     'Bool',
     'Bool',

+ 49 - 0
packages/pastojs/tests/tcmodules.pas

@@ -534,6 +534,7 @@ type
     Procedure TestRecord_Const;
     Procedure TestRecord_Const;
     Procedure TestRecord_TypecastFail;
     Procedure TestRecord_TypecastFail;
     Procedure TestRecord_InFunction;
     Procedure TestRecord_InFunction;
+    Procedure TestRecord_ArrayConstMultiline;
 
 
     // anonymous record
     // anonymous record
     Procedure TestRecordAnonym_Field;
     Procedure TestRecordAnonym_Field;
@@ -13166,6 +13167,54 @@ begin
     '']));
     '']));
 end;
 end;
 
 
+procedure TTestModule.TestRecord_ArrayConstMultiline;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TBird = record Wing: string; end;',
+  'const',
+  '  Birds: array[1..2] of TBird = (',
+  '    (Wing: ''''''',
+  '      First',
+  '      Second',
+  '      Third',
+  '    ''''''),',
+  '    (Wing: ''''''',
+  '      Value:=''Im in quotes''; ',
+  '    '''''')',
+  '  );',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestRecord_ArrayConstMultiline',
+    LinesToStr([ // statements
+    'rtl.recNewT(this, "TBird", function () {',
+    '  this.Wing = "";',
+    '  this.$eq = function (b) {',
+    '    return this.Wing === b.Wing;',
+    '  };',
+    '  this.$assign = function (s) {',
+    '    this.Wing = s.Wing;',
+    '    return this;',
+    '  };',
+    '});',
+    'this.Birds$a$clone = function (a) {',
+    '  var b = [];',
+    '  b.length = 2;',
+    '  for (var c = 0; c < 2; c++) b[c] = $mod.TBird.$clone(a[c]);',
+    '  return b;',
+    '};',
+    'this.Birds = [this.TBird.$clone({',
+    '  Wing: "  First\n  Second\n  Third"',
+    '}), this.TBird.$clone({',
+    '  Wing: "  Value:=''Im in quotes''; "',
+    '})];',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestModule.TestRecordAnonym_Field;
 procedure TTestModule.TestRecordAnonym_Field;
 begin
 begin
   StartProgram(false);
   StartProgram(false);