Browse Source

* Initial commit from patch in mantis issue #35827

Michaël Van Canneyt 1 week ago
parent
commit
2c1fa9e94f

+ 10 - 0
compiler/globals.pas

@@ -201,6 +201,13 @@ Const
 
 
          { WARNING: this pointer cannot be written as such in record token }
          { WARNING: this pointer cannot be written as such in record token }
          pmessage : pmessagestaterecord;
          pmessage : pmessagestaterecord;
+
+         lineendingtype : tlineendingtype;
+
+         whitespacetrimcount : word;
+         
+         whitespacetrimauto : boolean;
+         
 {$if defined(generic_cpu)}
 {$if defined(generic_cpu)}
          case byte of
          case byte of
 {$endif}
 {$endif}
@@ -674,6 +681,9 @@ Const
         tlsmodel : tlsm_none;
         tlsmodel : tlsm_none;
         controllertype : ct_none;
         controllertype : ct_none;
         pmessage : nil;
         pmessage : nil;
+        lineendingtype : le_platform;
+        whitespacetrimcount : 0;
+        whitespacetrimauto : false;
 {$if defined(i8086) or defined(GENERIC_CPU)}
 {$if defined(i8086) or defined(GENERIC_CPU)}
         x86memorymodel : mm_small;
         x86memorymodel : mm_small;
 {$endif defined(i8086) or defined(GENERIC_CPU)}
 {$endif defined(i8086) or defined(GENERIC_CPU)}

+ 16 - 3
compiler/globtype.pas

@@ -555,7 +555,8 @@ interface
          m_underscoreisseparator,{ _ can be used as separator to group digits in numbers }
          m_underscoreisseparator,{ _ can be used as separator to group digits in numbers }
          m_implicit_function_specialization,    { attempt to specialize generic function by inferring types from parameters }
          m_implicit_function_specialization,    { attempt to specialize generic function by inferring types from parameters }
          m_function_references, { enable Delphi-style function references }
          m_function_references, { enable Delphi-style function references }
-         m_anonymous_functions  { enable Delphi-style anonymous functions }
+         m_anonymous_functions,  { enable Delphi-style anonymous functions }
+         m_multiline_strings    { multi-line strings denoted with '`' are enabled and valid }
        );
        );
        tmodeswitches = set of tmodeswitch;
        tmodeswitches = set of tmodeswitch;
 
 
@@ -669,7 +670,18 @@ interface
          pocall_vectorcall
          pocall_vectorcall
        );
        );
        tproccalloptions = set of tproccalloption;
        tproccalloptions = set of tproccalloption;
-
+       
+       tlineendingtype = ({Carriage return, aka #13}
+                          le_cr,
+                          {Carriage return + line feed, aka #13#10}
+                          le_crlf,
+                          {Line feed, aka #10}
+                          le_lf,
+                          {Use the platform default}
+                          le_platform,
+                          {Use whatever is in the file}
+                          le_source);
+                          
      const
      const
        proccalloptionStr : array[tproccalloption] of string[16]=('',
        proccalloptionStr : array[tproccalloption] of string[16]=('',
            'CDecl',
            'CDecl',
@@ -751,7 +763,8 @@ interface
          'UNDERSCOREISSEPARATOR',
          'UNDERSCOREISSEPARATOR',
          'IMPLICITFUNCTIONSPECIALIZATION',
          'IMPLICITFUNCTIONSPECIALIZATION',
          'FUNCTIONREFERENCES',
          'FUNCTIONREFERENCES',
-         'ANONYMOUSFUNCTIONS'
+         'ANONYMOUSFUNCTIONS',
+         'MULTILINESTRINGS'
          );
          );
 
 
 
 

+ 9 - 1
compiler/msg/errore.msg

@@ -481,7 +481,15 @@ scan_e_duplicate_rtti_option=02112_E_A Duplicate RTTI option "$1"
 scan_e_misplaced_rtti_directive=02113_E_A The RTTI directive cannot be used here
 scan_e_misplaced_rtti_directive=02113_E_A The RTTI directive cannot be used here
 % The \var{\$RTTI} directive can not be used in this location (e.g. before the \var{PROGRAM}
 % The \var{\$RTTI} directive can not be used in this location (e.g. before the \var{PROGRAM}
 % or \var{UNIT} headers).
 % or \var{UNIT} headers).
-% \end{description}
+scan_e_unknown_lineending_type=02116_E_Unknown line ending type specified. Valid options are CR, CRLF, LF, PLATFORM, or SOURCE.
+% The line ending type that was specified is not one of CR, CRLF, LF, PLATFORM, or SOURCE.
+scan_e_trimcount_out_of_range=02117_E_The value of MULTILINESTRINGTRIMLEFT cannot be less than 0 or greater than 65535.
+% MULTILINESTRINGTRIMLEFT is stored in a "word" field, and thus is restricted to the range 0..65535.
+scan_e_illegal_directive=02118_E_Illegal compiler directive "$1"
+% You have specified a compiler directive that cannot (for one of several possible reasons) currently be used.
+scan_f_unterminated_multiline_string=02119_F_Unterminated multi-line string beginning at line $1, column $2.
+% The file contains an "unbalanced" number of multi-line string denoting backtick characters.
+%\end{description}
 #
 #
 # Parser
 # Parser
 #
 #

+ 16 - 5
compiler/pbase.pas

@@ -153,10 +153,16 @@ implementation
 
 
     begin
     begin
         if (token<>i) and (idtoken<>i) then
         if (token<>i) and (idtoken<>i) then
-          if token=_id then
-            Message2(scan_f_syn_expected,tokeninfo^[i].str,'identifier '+pattern)
-          else
-            Message2(scan_f_syn_expected,tokeninfo^[i].str,tokeninfo^[token].str)
+          begin
+            if current_scanner.had_multiline_string then
+              Message2(scan_f_unterminated_multiline_string,
+                       tostr(current_scanner.multiline_start_line),
+                       tostr(current_scanner.multiline_start_column))
+            else if token=_id then
+              Message2(scan_f_syn_expected,tokeninfo^[i].str,'identifier '+pattern)
+            else
+              Message2(scan_f_syn_expected,tokeninfo^[i].str,tokeninfo^[token].str);
+          end
         else
         else
           begin
           begin
             if token=_END then
             if token=_END then
@@ -200,7 +206,12 @@ implementation
             if token=_EOF then
             if token=_EOF then
              begin
              begin
                Consume(atoken);
                Consume(atoken);
-               Message(scan_f_end_of_file);
+               if current_scanner.had_multiline_string then
+                 Message2(scan_f_unterminated_multiline_string,
+                          tostr(current_scanner.multiline_start_line),
+                          tostr(current_scanner.multiline_start_column))
+               else
+                 Message(scan_f_end_of_file);
                exit;
                exit;
              end;
              end;
           end;
           end;

+ 6 - 1
compiler/pstatmnt.pas

@@ -1443,7 +1443,12 @@ implementation
                code:=tp_inline_statement;
                code:=tp_inline_statement;
              end;
              end;
            _EOF :
            _EOF :
-             Message(scan_f_end_of_file);
+             if current_scanner.had_multiline_string then
+               Message2(scan_f_unterminated_multiline_string,
+                        tostr(current_scanner.multiline_start_line),
+                        tostr(current_scanner.multiline_start_column))
+             else
+               Message(scan_f_end_of_file);
          else
          else
            begin
            begin
              { don't typecheck yet, because that will also simplify, which may
              { don't typecheck yet, because that will also simplify, which may

+ 63 - 0
compiler/scandir.pas

@@ -1008,6 +1008,67 @@ unit scandir;
       current_module.mode_switch_allowed:= false;
       current_module.mode_switch_allowed:= false;
     end;
     end;
 
 
+    procedure dir_multilinestringlineending;
+      var
+        s : string;
+      begin
+        if not (m_multiline_strings in current_settings.modeswitches) then
+          Message1(scan_e_illegal_directive,'MULTILINESTRINGLINEENDING');
+        current_scanner.skipspace;
+        s:=current_scanner.readid;
+        if (s='CR') then
+          current_settings.lineendingtype:=le_cr
+        else if (s='CRLF') then
+          current_settings.lineendingtype:=le_crlf
+        else if (s='LF') then
+          current_settings.lineendingtype:=le_lf
+        else if (s='PLATFORM') then
+          current_settings.lineendingtype:=le_platform
+        else if (s='SOURCE') then
+          current_settings.lineendingtype:=le_source
+        else
+          Message(scan_e_unknown_lineending_type);
+      end;
+
+    procedure dir_multilinestringtrimleft;
+      var
+        count : longint;
+        s : string;
+      begin
+        if not (m_multiline_strings in current_settings.modeswitches) then
+          Message1(scan_e_illegal_directive,'MULTILINESTRINGTRIMLEFT');
+        current_scanner.skipspace;
+        if (c in ['0'..'9']) then
+          begin
+            count:=current_scanner.readval;
+            if (count<0) or (count>high(word)) then
+              Message(scan_e_trimcount_out_of_range)
+            else
+              begin
+                current_settings.whitespacetrimcount:=count;
+                current_settings.whitespacetrimauto:=false;
+              end;
+          end
+        else
+          begin
+            s:=current_scanner.readid;
+            if s='ALL' then
+              begin
+                current_settings.whitespacetrimcount:=high(word);
+                current_settings.whitespacetrimauto:=false;
+              end
+            else if s='AUTO' then
+              begin
+                current_settings.whitespacetrimcount:=0;
+                current_settings.whitespacetrimauto:=true;
+              end
+            else
+              begin
+                current_settings.whitespacetrimcount:=0;
+                current_settings.whitespacetrimauto:=false;
+              end;
+          end;
+      end;
 
 
     procedure dir_modeswitch;
     procedure dir_modeswitch;
       var
       var
@@ -2171,6 +2232,8 @@ unit scandir;
         AddDirective('MMX',directive_all, @dir_mmx);
         AddDirective('MMX',directive_all, @dir_mmx);
         AddDirective('MODE',directive_all, @dir_mode);
         AddDirective('MODE',directive_all, @dir_mode);
         AddDirective('MODESWITCH',directive_all, @dir_modeswitch);
         AddDirective('MODESWITCH',directive_all, @dir_modeswitch);
+        AddDirective('MULTILINESTRINGLINEENDING',directive_all, @dir_multilinestringlineending);
+        AddDirective('MULTILINESTRINGTRIMLEFT',directive_all, @dir_multilinestringtrimleft);
         AddDirective('NAMESPACE',directive_all, @dir_namespace);
         AddDirective('NAMESPACE',directive_all, @dir_namespace);
         AddDirective('NAMESPACES',directive_all, @dir_namespaces);
         AddDirective('NAMESPACES',directive_all, @dir_namespaces);
         AddDirective('NODEFINE',directive_all, @dir_nodefine);
         AddDirective('NODEFINE',directive_all, @dir_nodefine);

+ 286 - 58
compiler/scanner.pas

@@ -180,6 +180,12 @@ interface
           { hack to allow reading generic generated identifiers IDs}
           { hack to allow reading generic generated identifiers IDs}
           allowgenericid : boolean;
           allowgenericid : boolean;
 
 
+          { Having these tracked in the scanner class itself versus local variables allows for
+            informative error handling that would be impossible otherwise }
+          in_multiline_string, had_multiline_string : boolean;
+          multiline_start_line : longint;
+          multiline_start_column : word;
+
           constructor Create(const fn:string; is_macro: boolean = false);
           constructor Create(const fn:string; is_macro: boolean = false);
           destructor Destroy;override;
           destructor Destroy;override;
         { File buffer things }
         { File buffer things }
@@ -221,6 +227,7 @@ interface
           procedure tokenwritesizeint(val : asizeint);
           procedure tokenwritesizeint(val : asizeint);
           procedure tokenwritelongint(val : longint);
           procedure tokenwritelongint(val : longint);
           procedure tokenwritelongword(val : longword);
           procedure tokenwritelongword(val : longword);
+          procedure tokenwritebyte(val : byte);
           procedure tokenwriteword(val : word);
           procedure tokenwriteword(val : word);
           procedure tokenwriteshortint(val : shortint);
           procedure tokenwriteshortint(val : shortint);
           procedure tokenwriteset(var b;size : longint);
           procedure tokenwriteset(var b;size : longint);
@@ -3297,6 +3304,14 @@ type
         recordtokenbuf.write(val,sizeof(shortint));
         recordtokenbuf.write(val,sizeof(shortint));
       end;
       end;
 
 
+    procedure tscannerfile.tokenwritebyte(val : byte);
+      begin
+{$ifdef FPC_BIG_ENDIAN}
+        val:=swapendian(val);
+{$endif}
+        recordtokenbuf.write(val,sizeof(byte));
+      end;
+
     procedure tscannerfile.tokenwriteword(val : word);
     procedure tscannerfile.tokenwriteword(val : word);
       begin
       begin
         recordtokenbuf.write(val,sizeof(word));
         recordtokenbuf.write(val,sizeof(word));
@@ -3482,6 +3497,9 @@ type
             else
             else
              ControllerType:=ct_none;
              ControllerType:=ct_none;
 {$POP}
 {$POP}
+            lineendingtype:=tlineendingtype(tokenreadenum(sizeof(tlineendingtype)));
+            whitespacetrimcount:=tokenreadword;
+            whitespacetrimauto:=boolean(tokenreadbyte);
            endpos:=replaytokenbuf.pos;
            endpos:=replaytokenbuf.pos;
            if endpos-startpos<>expected_size then
            if endpos-startpos<>expected_size then
              Comment(V_Error,'Wrong size of Settings read-in');
              Comment(V_Error,'Wrong size of Settings read-in');
@@ -3561,6 +3579,9 @@ type
             if ControllerSupport then
             if ControllerSupport then
               tokenwriteenum(controllertype,sizeof(tcontrollertype));
               tokenwriteenum(controllertype,sizeof(tcontrollertype));
 {$POP}
 {$POP}
+            tokenwriteenum(lineendingtype,sizeof(tlineendingtype));
+            tokenwriteword(whitespacetrimcount);
+            tokenwritebyte(byte(whitespacetrimauto));
            endpos:=recordtokenbuf.pos;
            endpos:=recordtokenbuf.pos;
            size:=endpos-startpos;
            size:=endpos-startpos;
            recordtokenbuf.seek(sizepos);
            recordtokenbuf.seek(sizepos);
@@ -4268,7 +4289,10 @@ type
     procedure tscannerfile.end_of_file;
     procedure tscannerfile.end_of_file;
       begin
       begin
         checkpreprocstack;
         checkpreprocstack;
-        Message(scan_f_end_of_file);
+        if in_multiline_string then
+          Message2(scan_f_unterminated_multiline_string, tostr(multiline_start_line), tostr(multiline_start_column))
+        else
+          Message(scan_f_end_of_file);
       end;
       end;
 
 
   {-------------------------------------------
   {-------------------------------------------
@@ -4810,21 +4834,44 @@ type
       begin
       begin
         i:=0;
         i:=0;
         msgwritten:=false;
         msgwritten:=false;
-        if (c='''') then
+        if (c in ['''','`']) then
           begin
           begin
+            had_multiline_string:=in_multiline_string;
+            in_multiline_string:=(c='`');
+            if in_multiline_string and (not (m_multiline_strings in current_settings.modeswitches)) then
+              begin
+                result[0]:=chr(0);
+                Illegal_Char(c);
+              end;
             repeat
             repeat
               readchar;
               readchar;
               case c of
               case c of
                 #26 :
                 #26 :
                   end_of_file;
                   end_of_file;
                 #10,#13 :
                 #10,#13 :
-                  Message(scan_f_string_exceeds_line);
+                  if not in_multiline_string then
+                    begin
+                      if had_multiline_string then
+                        Message2(scan_f_unterminated_multiline_string,
+                                 tostr(multiline_start_line),
+                                 tostr(multiline_start_column))
+                      else
+                        Message(scan_f_string_exceeds_line);
+                    end;
                 '''' :
                 '''' :
-                  begin
-                    readchar;
-                    if c<>'''' then
-                     break;
-                  end;
+                  if not in_multiline_string then
+                    begin
+                      readchar;
+                      if c<>'''' then
+                       break;
+                    end;
+                '`' :
+                  if in_multiline_string then
+                    begin
+                      readchar;
+                      if c<>'`' then
+                       break;
+                    end;
               end;
               end;
               if i<255 then
               if i<255 then
                 begin
                 begin
@@ -5130,28 +5177,44 @@ type
                  if found=1 then
                  if found=1 then
                   found:=2;
                   found:=2;
                end;
                end;
-             '''' :
+             '''','`' :
                if (current_commentstyle=comment_none) then
                if (current_commentstyle=comment_none) then
-                begin
-                  repeat
-                    readchar;
-                    case c of
-                      #26 :
-                        end_of_file;
-                      #10,#13 :
-                        break;
-                      '''' :
-                        begin
-                          readchar;
-                          if c<>'''' then
+                 begin
+                   had_multiline_string:=in_multiline_string;
+                   in_multiline_string:=(c='`');
+                   if in_multiline_string and (not (m_multiline_strings in current_settings.modeswitches)) then
+                     Illegal_Char(c);
+                   repeat
+                     readchar;
+                     case c of
+                       #26 :
+                         end_of_file;
+                       #10,#13 :
+                         if not in_multiline_string then
+                           break;
+                       '''' :
+                         if not in_multiline_string then
                            begin
                            begin
-                             next_char_loaded:=true;
-                             break;
+                             readchar;
+                             if c<>'''' then
+                              begin
+                                next_char_loaded:=true;
+                                break;
+                              end;
                            end;
                            end;
-                        end;
-                    end;
-                  until false;
-                end;
+                       '`' :
+                         if in_multiline_string then
+                           begin
+                             readchar;
+                             if c<>'`' then
+                              begin
+                                next_char_loaded:=true;
+                                break;
+                              end;
+                           end;
+                     end;
+                   until false;
+                 end;
              '(' :
              '(' :
                begin
                begin
                  if (current_commentstyle=comment_none) then
                  if (current_commentstyle=comment_none) then
@@ -5367,9 +5430,15 @@ type
         mac     : tmacro;
         mac     : tmacro;
         asciinr : string[33];
         asciinr : string[33];
         iswidestring , firstdigitread: boolean;
         iswidestring , firstdigitread: boolean;
-      label
-         exit_label;
+        had_newline,first_multiline : boolean;
+        trimcount : word;
+        last_c : char;
+label
+         quote_label, exit_label;
       begin
       begin
+        had_newline:=false;
+        first_multiline:=false;
+        last_c:=#0;
         flushpendingswitchesstate;
         flushpendingswitchesstate;
 
 
         { record tokens? }
         { record tokens? }
@@ -5815,8 +5884,20 @@ type
                  goto exit_label;
                  goto exit_label;
                end;
                end;
 
 
-             '''','#','^' :
+             '''','#','^','`' :
                begin
                begin
+                 had_multiline_string:=in_multiline_string;
+                 in_multiline_string:=(c='`');
+                 if in_multiline_string then
+                   begin
+                     if not (m_multiline_strings in current_settings.modeswitches) then
+                       Illegal_Char(c)
+                     else
+                       begin
+                         multiline_start_line:=current_filepos.line;
+                         multiline_start_column:=current_filepos.column;
+                       end;
+                   end;
                  len:=0;
                  len:=0;
                  cstringpattern:='';
                  cstringpattern:='';
                  iswidestring:=false;
                  iswidestring:=false;
@@ -5923,26 +6004,65 @@ type
                            begin
                            begin
                              if len>=length(cstringpattern) then
                              if len>=length(cstringpattern) then
                                setlength(cstringpattern,length(cstringpattern)+256);
                                setlength(cstringpattern,length(cstringpattern)+256);
-                              inc(len);
-                              cstringpattern[len]:=chr(m);
+                             inc(len);
+                             cstringpattern[len]:=chr(m);
                            end;
                            end;
                        end;
                        end;
-                     '''' :
+                     '''','`' :
                        begin
                        begin
+                         had_multiline_string:=in_multiline_string;
+                         in_multiline_string:=(c='`');
+                         first_multiline:=in_multiline_string and (last_c in [#0,#32,#61]);
                          repeat
                          repeat
                            readchar;
                            readchar;
-                           case c of
-                             #26 :
-                               end_of_file;
-                             #10,#13 :
-                               Message(scan_f_string_exceeds_line);
-                             '''' :
-                               begin
-                                 readchar;
-                                 if c<>'''' then
-                                  break;
-                               end;
-                           end;
+                           quote_label:
+                             case c of
+                               #26 :
+                                 end_of_file;
+                               #32,#9,#11 :
+                                 if (had_newline or first_multiline) and
+                                    (current_settings.whitespacetrimauto or
+                                    (current_settings.whitespacetrimcount>0)) then
+                                   begin
+                                     if current_settings.whitespacetrimauto then
+                                       trimcount:=multiline_start_column
+                                     else
+                                       trimcount:=current_settings.whitespacetrimcount;
+                                     while (c in [#32,#9,#11]) and (trimcount>0) do
+                                       begin
+                                         readchar;
+                                         dec(trimcount);
+                                       end;
+                                     had_newline:=false;
+                                     first_multiline:=false;
+                                     goto quote_label;
+                                   end;
+                               #10,#13 :
+                                 if not in_multiline_string then
+                                   begin
+                                     if had_multiline_string then
+                                       Message2(scan_f_unterminated_multiline_string,
+                                                tostr(multiline_start_line),
+                                                tostr(multiline_start_column))
+                                     else
+                                       Message(scan_f_string_exceeds_line);
+                                   end;
+                               '''' :
+                                 if not in_multiline_string then
+                                   begin
+                                     readchar;
+                                     if c<>'''' then
+                                      break;
+                                   end;
+                               '`' :
+                                 if in_multiline_string then
+                                   begin
+                                     readchar;
+                                     if c<>'`' then
+                                      break;
+                                   end;
+                             end;
+                           first_multiline:=false;
                            { interpret as utf-8 string? }
                            { interpret as utf-8 string? }
                            if (ord(c)>=$80) and (current_settings.sourcecodepage=CP_UTF8) then
                            if (ord(c)>=$80) and (current_settings.sourcecodepage=CP_UTF8) then
                              begin
                              begin
@@ -6017,18 +6137,119 @@ type
                              end
                              end
                            else if iswidestring then
                            else if iswidestring then
                              begin
                              begin
-                               if current_settings.sourcecodepage=CP_UTF8 then
-                                 concatwidestringchar(patternw,ord(c))
-                               else
-                                 concatwidestringchar(patternw,asciichar2unicode(c))
+                               if in_multiline_string and (c in [#10,#13]) and (not ((c=#10) and (last_c=#13))) then
+                                 begin
+                                   if current_settings.sourcecodepage=CP_UTF8 then
+                                     begin
+                                       case current_settings.lineendingtype of
+                                         le_cr :
+                                           concatwidestringchar(patternw,ord(#13));
+                                         le_crlf :
+                                           begin
+                                             concatwidestringchar(patternw,ord(#13));
+                                             concatwidestringchar(patternw,ord(#10));
+                                           end;
+                                         le_lf :
+                                           concatwidestringchar(patternw,ord(#10));
+                                         le_platform :
+                                           begin
+                                             if target_info.newline=#13 then
+                                               concatwidestringchar(patternw,ord(#13))
+                                             else if target_info.newline=#13#10 then
+                                               begin
+                                                 concatwidestringchar(patternw,ord(#13));
+                                                 concatwidestringchar(patternw,ord(#10));
+                                               end
+                                             else if target_info.newline=#10 then
+                                               concatwidestringchar(patternw,ord(#10));
+                                           end;
+                                         le_source :
+                                           concatwidestringchar(patternw,ord(c));
+                                       end;
+                                     end
+                                   else
+                                     case current_settings.lineendingtype of
+                                       le_cr :
+                                         concatwidestringchar(patternw,asciichar2unicode(#13));
+                                       le_crlf :
+                                         begin
+                                           concatwidestringchar(patternw,asciichar2unicode(#13));
+                                           concatwidestringchar(patternw,asciichar2unicode(#10));
+                                         end;
+                                       le_lf :
+                                         concatwidestringchar(patternw,asciichar2unicode(#10));
+                                       le_platform :
+                                         begin
+                                           if target_info.newline=#13 then
+                                             concatwidestringchar(patternw,asciichar2unicode(#13))
+                                           else if target_info.newline=#13#10 then
+                                             begin
+                                               concatwidestringchar(patternw,asciichar2unicode(#13));
+                                               concatwidestringchar(patternw,asciichar2unicode(#10));
+                                             end
+                                           else if target_info.newline=#10 then
+                                             concatwidestringchar(patternw,asciichar2unicode(#10));
+                                         end;
+                                       le_source :
+                                         concatwidestringchar(patternw,asciichar2unicode(c));
+                                     end;
+                                   had_newline:=true;
+                                   inc(line_no);
+                                 end
+                               else if not (in_multiline_string and (c in [#10,#13])) then
+                                 begin
+                                   if current_settings.sourcecodepage=CP_UTF8 then
+                                     concatwidestringchar(patternw,ord(c))
+                                   else
+                                     concatwidestringchar(patternw,asciichar2unicode(c));
+                                 end;
                              end
                              end
                            else
                            else
                              begin
                              begin
-                               if len>=length(cstringpattern) then
-                                 setlength(cstringpattern,length(cstringpattern)+256);
-                                inc(len);
-                                cstringpattern[len]:=c;
+                                if in_multiline_string and (c in [#10,#13]) and (not ((c=#10) and (last_c=#13))) then
+                                  begin
+                                    if len>=length(cstringpattern) then
+                                      setlength(cstringpattern,length(cstringpattern)+256);
+                                    inc(len);
+                                    case current_settings.lineendingtype of
+                                      le_cr :
+                                        cstringpattern[len]:=#13;
+                                      le_crlf :
+                                        begin
+                                          cstringpattern[len]:=#13;
+                                          inc(len);
+                                          cstringpattern[len]:=#10;
+                                        end;
+                                      le_lf :
+                                        cstringpattern[len]:=#10;
+                                      le_platform :
+                                        begin
+                                          if target_info.newline=#13 then
+                                            cstringpattern[len]:=#13
+                                          else if target_info.newline=#13#10 then
+                                            begin
+                                              cstringpattern[len]:=#13;
+                                              inc(len);
+                                              cstringpattern[len]:=#10;
+                                            end
+                                          else if target_info.newline=#10 then
+                                            cstringpattern[len]:=#10;
+                                        end;
+                                      le_source :
+                                        cstringpattern[len]:=c;
+                                    end;
+                                    had_newline:=true;
+                                    inc(line_no);
+                                  end
+                                else if not (in_multiline_string and (c in [#10,#13])) then
+                                  begin
+                                    if len>=length(cstringpattern) then
+                                      setlength(cstringpattern,length(cstringpattern)+256);
+                                    inc(len);
+                                    cstringpattern[len]:=c;
+                                  end;
                              end;
                              end;
+                         last_c:=c;
                          until false;
                          until false;
                        end;
                        end;
                      '^' :
                      '^' :
@@ -6055,6 +6276,7 @@ type
                      else
                      else
                       break;
                       break;
                    end;
                    end;
+                 last_c:=c;
                  until false;
                  until false;
                  { strings with length 1 become const chars }
                  { strings with length 1 become const chars }
                  if iswidestring then
                  if iswidestring then
@@ -6168,6 +6390,10 @@ exit_label:
         low,high,mid: longint;
         low,high,mid: longint;
         optoken: ttoken;
         optoken: ttoken;
       begin
       begin
+         { Added the assignment to NOTOKEN below because I got a DFA uninitialized result
+           warning when building the compiler with -O3, which broke compilation with -Sew.
+           - Akira1364 }
+         readpreproc:=NOTOKEN;
          skipspace;
          skipspace;
          case c of
          case c of
            '_',
            '_',
@@ -6203,11 +6429,13 @@ exit_label:
                current_scanner.preproc_pattern:=pattern;
                current_scanner.preproc_pattern:=pattern;
                readpreproc:=optoken;
                readpreproc:=optoken;
              end;
              end;
-           '''' :
-             begin
-               current_scanner.preproc_pattern:=readquotedstring;
-               readpreproc:=_CSTRING;
-             end;
+           '''','`' :
+             if not ((c='`') and (not (m_multiline_strings in current_settings.modeswitches))) then
+               begin
+                 readquotedstring;
+                 current_scanner.preproc_pattern:=cstringpattern;
+                 readpreproc:=_CSTRING;
+               end;
            '0'..'9' :
            '0'..'9' :
              begin
              begin
                readnumber;
                readnumber;

+ 5 - 1
compiler/utils/ppuutils/ppudump.pp

@@ -2178,6 +2178,9 @@ var
              controllertype:=tcontrollertype(tokenreadenum(sizeof(tcontrollertype)))
              controllertype:=tcontrollertype(tokenreadenum(sizeof(tcontrollertype)))
             else
             else
              ControllerType:=ct_none;
              ControllerType:=ct_none;
+            lineendingtype:=tlineendingtype(tokenreadenum(sizeof(tlineendingtype)));
+            whitespacetrimcount:=gettokenbufword;
+            whitespacetrimauto:=boolean(gettokenbufbyte);
 {$POP}
 {$POP}
            endpos:=tbi;
            endpos:=tbi;
            if endpos-startpos<>expected_size then
            if endpos-startpos<>expected_size then
@@ -2484,7 +2487,8 @@ const
          'm_underscoreisseparator',{ _ can be used as separator to group digits in numbers }
          'm_underscoreisseparator',{ _ can be used as separator to group digits in numbers }
          'm_implicit_function_specialization', { attempt to specialize generic function by inferring types from parameters }
          'm_implicit_function_specialization', { attempt to specialize generic function by inferring types from parameters }
          'm_function_references', { enable Delphi-style function references }
          'm_function_references', { enable Delphi-style function references }
-         'm_anonymous_functions'  { enable Delphi-style anonymous functions }
+         'm_anonymous_functions',  { enable Delphi-style anonymous functions }
+         'm_multiline_strings'    { multi-line strings denoted with '`' are enabled and valid }
        );
        );
        { optimizer }
        { optimizer }
        optimizerswitchname : array[toptimizerswitch] of string[50] =
        optimizerswitchname : array[toptimizerswitch] of string[50] =

+ 14 - 0
tests/test/tmultilinestring1.pp

@@ -0,0 +1,14 @@
+program tmultilinestring1;
+
+{$modeswitch MultiLineStrings}
+
+const MyString =
+`
+Hey
+Hey
+Hey
+`;
+
+begin
+  Write(MyString);
+end.

+ 9 - 0
tests/test/tmultilinestring10.pp

@@ -0,0 +1,9 @@
+program tmultilinestring10;
+
+{ Test the use of multiline strings from units in programs }
+
+uses umultilinestring1;
+
+begin
+  Write(Long);
+end.

File diff suppressed because it is too large
+ 11 - 0
tests/test/tmultilinestring11.pp


+ 18 - 0
tests/test/tmultilinestring12.pp

@@ -0,0 +1,18 @@
+program tmultilinestring12;
+
+{$modeswitch MultiLineStrings}
+{$MultiLineStringTrimLeft 4}
+
+procedure TakesAString(const S: String);
+begin
+  Write(S);
+end;
+
+begin
+  TakesAString(`
+    This
+    works
+    just
+    fine!
+  `);
+end.

+ 18 - 0
tests/test/tmultilinestring13.pp

@@ -0,0 +1,18 @@
+program tmultilinestring13;
+
+{$modeswitch MultiLineStrings}
+
+const A =
+`
+``a``
+`;
+
+const B =
+`
+'a'
+`;
+
+begin
+  Write(A);
+  Write(B);
+end.

+ 40 - 0
tests/test/tmultilinestring14.pp

@@ -0,0 +1,40 @@
+program tmultilinestring14;
+
+{$modeswitch MultiLineStrings}
+
+{$MultiLineStringTrimLeft 2}
+
+const A = `
+  A
+  B
+  C
+  D
+`;
+
+{$MultiLineStringTrimLeft 4}
+
+const B = `
+    A
+    B
+    C
+    D
+`;
+
+begin
+  Write(A);
+  Write(B);
+
+  { The number-to-trim being larger, (even much larger) than the amount of whitespace is not a problem,
+    as it stops immediately when it is no longer actually *in* whitespace regardless. }
+
+  {$MultiLineStringTrimLeft 10000}
+
+  { Non-leading whitespace is preserved properly, of course. }
+
+  Write(`
+        sdfs
+        sd fs fs
+        sd  fsfs  sdfd sfdf
+        sdfs fsd
+  `);
+end.

+ 37 - 0
tests/test/tmultilinestring15.pp

@@ -0,0 +1,37 @@
+program tmultilinestring15;
+
+{$modeswitch MultiLineStrings}
+{$MultiLineStringTrimLeft 2}
+
+const X = `
+  Hello
+  every
+  body!
+`;
+
+const Y = `
+    Goodbye
+    every
+    body!
+    
+`;
+
+{ Test some wacky concatentation }
+
+begin
+  Write(X + Y);
+  Write(Concat(X, Y));
+  Write(
+    '  Single line string ' +
+    `
+    and
+    ` +
+    `
+    Multi
+    line
+    string
+    ` +
+    Y +
+    X
+  );
+end.

+ 30 - 0
tests/test/tmultilinestring16.pp

@@ -0,0 +1,30 @@
+program tmultilinestring16;
+
+{$modeswitch MultiLineStrings}
+{$MultiLineStringTrimLeft 6}
+
+procedure TakesAnArray(constref A: array of String);
+var S: String;
+begin
+  for S in A do Write(S);
+end;
+
+begin
+  TakesAnArray([
+    ` Multi
+      line
+      one!`,
+    `
+      Multi
+      line
+      two!`,
+    `
+      Multi
+      line
+      three!
+    `,
+    'Single line one!' + sLineBreak +
+    'Single line two!' + sLineBreak +
+    'Single line three!'
+  ]);
+end.

+ 39 - 0
tests/test/tmultilinestring17.pp

@@ -0,0 +1,39 @@
+program tmultilinestring17;
+
+{$mode ObjFPC}
+{$modeswitch MultiLineStrings}
+{$MultiLineStringTrimLeft 6}
+
+type
+  TMessage = record
+    Msg: String;
+  end;
+
+  TMyClass = class
+  public
+    procedure MyMessage(var Msg: TMessage); message `
+      Multi
+      Line
+      Message!
+    `;
+  end;
+
+  procedure TMyClass.MyMessage(var Msg: TMessage);
+  begin
+    WriteLn('Ok!');
+  end;
+
+  const M: TMessage = (
+    Msg: `
+      Multi
+      Line
+      Message!
+    `
+  );
+
+begin
+  with TMyClass.Create() do begin
+    DispatchStr(M);
+    Free();
+  end;
+end.

+ 19 - 0
tests/test/tmultilinestring18.pp

@@ -0,0 +1,19 @@
+program tmultilinestring18;
+
+{$modeswitch MultiLineStrings}
+{$MultiLineStringTrimLeft 2}
+{$Warnings On}
+
+procedure IsDeprecated; deprecated
+`
+  Multi
+  line
+  deprecation
+  message!
+`;
+begin
+end;
+
+begin
+  IsDeprecated;
+end.

+ 15 - 0
tests/test/tmultilinestring19.pp

@@ -0,0 +1,15 @@
+program tmultilinestring19;
+
+{$modeswitch MultiLineStrings}
+{$MultiLineStringTrimLeft 2}
+
+{ This is extremely unlikely, but it needs to work properly... }
+
+procedure Bloop; external name `
+  Actually
+  Called
+  Bloop
+`;
+
+begin
+end.

+ 22 - 0
tests/test/tmultilinestring2.pp

@@ -0,0 +1,22 @@
+program tmultilinestring2;
+
+{$modeswitch MultiLineStrings}
+
+var MyStringV: AnsiString =
+`
+Hey
+Hey
+Hey
+`;
+
+const MyStringC: AnsiString =
+`
+Hey
+Hey
+Hey
+`;
+
+begin
+  Write(MyStringV);
+  Write(MyStringC);
+end.

+ 10 - 0
tests/test/tmultilinestring20.pp

@@ -0,0 +1,10 @@
+program tmultilinestring20;
+
+{$modeswitch MultiLineStrings}
+{$MultiLineStringTrimLeft 2}
+
+uses umultilinestring2;
+
+begin
+  DoIt;
+end.

+ 16 - 0
tests/test/tmultilinestring21.pp

@@ -0,0 +1,16 @@
+{ %FAIL }
+
+program tmultilinestring21;
+
+{$modeswitch MultiLineStrings}
+{$MultiLineStringTrimLeft 2000000}
+
+const S = `
+  A
+  B
+  C
+`;
+
+begin
+  WriteLn(S);
+end.

+ 12 - 0
tests/test/tmultilinestring22.pp

@@ -0,0 +1,12 @@
+program tmultilinestring22;
+
+{$modeswitch MultiLineStrings}
+{$MultiLineStringTrimLeft 5}
+
+{ ↓↓↓ the point here being that it no longer disappears }
+
+const Test = ` ThisSpace>>>>     <<<<disappeared`;
+
+begin
+  Write(Test);
+end.

+ 50 - 0
tests/test/tmultilinestring23.pp

@@ -0,0 +1,50 @@
+program tmultilinestring23;
+
+{$mode ObjFPC}{$H+}
+{$modeswitch PrefixedAttributes}
+{$modeswitch MultiLineStrings}
+{$MultiLineStringTrimLeft Auto}
+
+uses RTTI;
+
+type
+  TMultiLineAttribute = class(TCustomAttribute)
+  private
+    FString: String;
+  public
+    constructor Create(const S: String);
+    property StringValue: String read FString;
+  end;
+
+  constructor TMultiLineAttribute.Create(const S: String);
+  begin
+    FString := S;
+  end;
+
+type
+  [TMultiLineAttribute(
+    `This is my
+     pretty cool
+     multi-line string
+     attribute!`
+  )]
+  [TMultiLineAttribute(
+    `This is my
+     even cooler
+     multi-line string
+     attribute!`
+  )]
+  TMyClass = class
+  end;
+
+var
+  A: TMultiLineAttribute;
+
+begin
+  with TRTTIType.Create(TypeInfo(TMyClass)) do
+  begin
+    for TCustomAttribute(A) in GetAttributes() do
+      WriteLn(A.StringValue);
+    Free();
+  end;
+end.

+ 62 - 0
tests/test/tmultilinestring24.pp

@@ -0,0 +1,62 @@
+program tmultilinestring24;
+
+{ engkin's bug example }
+
+{$mode objfpc}
+{$modeswitch MultiLineStrings}
+{$MultiLineStringTrimLeft 15}
+{$MultiLineStringLineEnding Platform}
+
+var
+{$MultiLineStringLineEnding CR}
+  a: array[0..3] of string = (
+``
+,
+`
+`
+,
+`
+
+`
+,
+`
+
+
+`);
+
+  {$MultiLineStringLineEnding CRLF}
+b: array[0..3] of string = (
+`1`
+,
+`1
+2`
+,
+`1
+2
+3`
+,
+`1
+2
+3
+4`);
+
+procedure Test(constref StrArray:array of string);
+var
+  s,sHex: string;
+  c: char;
+begin
+  for s in StrArray do
+  begin
+    WriteLn('Length: ',Length(s));
+    sHex := '';
+    for c in s do
+      sHex := sHex+'$'+hexStr(ord(c),2);
+    WriteLn(sHex);
+  end;
+  WriteLn('---------------');
+end;
+
+begin
+  Test(a);
+  Test(b);
+end.

+ 26 - 0
tests/test/tmultilinestring25.pp

@@ -0,0 +1,26 @@
+program tmultilinestring25;
+
+{$modeswitch MultiLineStrings}
+{$MultiLineStringTrimLeft Auto}
+
+const
+  Str1 = `SELECT o.*, C.Company
+          from Orders O
+          join Customer C
+            on o.CustNo=C.ID
+          where
+            O.saledate=DATE '2001.03.20'`;
+
+const
+  Str2 =
+    `SELECT o.*, C.Company
+     from Orders O
+     join Customer C
+       on o.CustNo=C.ID
+     where
+       O.saledate=DATE '2001.03.20'`;
+
+begin
+  WriteLn(Str1);
+  WriteLn(Str2);
+end.

+ 24 - 0
tests/test/tmultilinestring26.pp

@@ -0,0 +1,24 @@
+program tmultilinestring26;
+
+{$modeswitch MultiLineStrings}
+{$MultiLineStringTrimLeft 5}
+
+const middleSpaceBug: array[0..5] of string = (
+#$41` `#$42   //<--- Original bug, now fixed: "this becomes #$41#$42 instead of #$41#$20#$42"
+,
+#$41` - `#$42 //<--- Original bug, now fixed: "this becomes #$41#$2D#$20#$42 instead of #$41#$20#$2D#$20#$42"
+,
+#$41`      -      `#$42  //<--- Original bug, now fixed: "one space left instead of six spaces"
+,
+#$41`      -      `#$42`  --  `  //<---- Original bug, now fixed: "the same bug twice"
+,
+'  '#$41` `#$42   //<--- Original bug, now fixed: "the space between backticks disappears: #$20#$20#$41#$42"
+,
+^T' e s'` t`  //<--- Original bug, now fixed: "last two: $73$74 instead of $73$20$74"
+);
+
+var S: String;
+
+begin
+  for S in middleSpaceBug do WriteLn(S);
+end.

+ 16 - 0
tests/test/tmultilinestring27.pp

@@ -0,0 +1,16 @@
+program tmultilinestring27;
+
+{$modeswitch MultiLineStrings}
+{$MultiLineStringTrimLeft Auto}
+
+resourcestring S =
+    `This
+       is
+     a
+       multi-line
+     resource
+       string`;
+
+begin
+  Write(S);
+end.

+ 24 - 0
tests/test/tmultilinestring28.pp

@@ -0,0 +1,24 @@
+{ %FAIL }
+
+{ Will show: 
+  tmultilinestring28.pp(20,1) Fatal: Unterminated multi-line string beginning at line 11, column 7. }
+
+program tmultilinestring28;
+
+{$modeswitch MultiLineStrings}
+
+const
+  a = `this will be unterminated
+with some
+lines in it.
+
+var
+  B : String;
+
+begin
+  B:=`
+again
+something
+end backticked`;
+
+end.

+ 22 - 0
tests/test/tmultilinestring3.pp

@@ -0,0 +1,22 @@
+program tmultilinestring3;
+
+{$modeswitch MultiLineStrings}
+
+var MyStringV: ShortString =
+`
+Hey
+Hey
+Hey
+`;
+
+const MyStringC: ShortString =
+`
+Hey
+Hey
+Hey
+`;
+
+begin
+  Write(MyStringV);
+  Write(MyStringC);
+end.

+ 22 - 0
tests/test/tmultilinestring4.pp

@@ -0,0 +1,22 @@
+program tmultilinestring4;
+
+{$modeswitch MultiLineStrings}
+
+var MyStringV: WideString =
+`
+Hey
+Hey
+Hey
+`;
+
+const MyStringC: WideString =
+`
+Hey
+Hey
+Hey
+`;
+
+begin
+  Write(MyStringV);
+  Write(MyStringC);
+end.

+ 22 - 0
tests/test/tmultilinestring5.pp

@@ -0,0 +1,22 @@
+program tmultilinestring5;
+
+{$modeswitch MultiLineStrings}
+
+var MyStringV: UnicodeString =
+`
+Hey
+Hey
+Hey
+`;
+
+const MyStringC: UnicodeString =
+`
+Hey
+Hey
+Hey
+`;
+
+begin
+  Write(MyStringV);
+  Write(MyStringC);
+end.

+ 65 - 0
tests/test/tmultilinestring6.pp

@@ -0,0 +1,65 @@
+program tmultilinestring6;
+
+{$modeswitch MultiLineStrings}
+{$MultiLineStringLineEnding CR}
+
+const A =
+`
+😊
+😊
+😊
+😊
+😊
+`;
+
+{$MultiLineStringLineEnding CRLF}
+
+const B =
+`
+😊
+😊
+😊
+😊
+😊
+`;
+
+{$MultiLineStringLineEnding LF}
+
+const C =
+`
+😊
+😊
+😊
+😊
+😊
+`;
+
+{$MultiLineStringLineEnding PLATFORM}
+
+const D =
+`
+😊
+😊
+😊
+😊
+😊
+`;
+
+{$MultiLineStringLineEnding SOURCE}
+
+const E =
+`
+😊
+😊
+😊
+😊
+😊
+`;
+
+begin
+  Write(A);
+  Write(B);
+  Write(C);
+  Write(D);
+  Write(E);
+end.

+ 17 - 0
tests/test/tmultilinestring7.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tmultilinestring7;
+
+{$modeswitch MultiLineStrings}
+{$MultiLineStringLineEnding DOESNOTEXIST}
+
+const Blah =
+`
+A
+B
+C
+`;
+
+begin
+  Write(Blah);
+end.

+ 38 - 0
tests/test/tmultilinestring8.pp

@@ -0,0 +1,38 @@
+{ %FAIL }
+
+program tmultilinestring8;
+
+{ Ryan's example from the mailing list }
+
+{$modeswitch MultiLineStrings}
+
+const lines: ansistring = `
+  #version 150
+
+  uniform sampler2D textures[8];
+  in vec2 vertexTexCoord;
+  in vec4 vertexColor;
+  in float vertexUVMap;
+  out vec4 fragColor;
+
+  void main()
+  {
+    if (vertexUVMap == 255) {
+      fragColor = vertexColor;
+    } else {
+      fragColor = texture(textures[int(vertexUVMap)], vertexTexCoord.st);
+      if (vertexColor.a < fragColor.a) {
+        fragColor.a = vertexColor.a;
+      }
+    }
+
+    // TODO: testing
+    fragColor = vec4(1,0,0,1);
+  }
+`;
+
+var
+  s: ansistring = lines;
+begin
+  writeln(b);
+end.

+ 13 - 0
tests/test/tmultilinestring9.pp

@@ -0,0 +1,13 @@
+{ %FAIL }
+
+program tmultilinestring9;
+
+{ "Forget" to set the modeswitch... }
+
+const NotAllowed = `
+Oh
+no!
+`;
+
+begin
+end.

Some files were not shown because too many files changed in this diff