View Issue Details

IDProjectCategoryView StatusLast Update
0025536FPCCompilerpublic2019-07-04 08:04
ReporterDennis FehrAssigned To 
PrioritynormalSeverityminorReproducibilityN/A
Status newResolutionopen 
Product Version2.7.1Product Build 
Target VersionFixed in Version 
Summary0025536: Patch for {$INCLUDESTRINGFILE file}
DescriptionThis is a patch to include {$INCLUDESTRINGFILE file} directive.
TagsNo tags attached.
Fixed in Revision
FPCOldBugId
FPCTarget-
Attached Files
  • scanner.diff (4,590 bytes)
    Index: compiler/scanner.pas
    ===================================================================
    --- compiler/scanner.pas	(revision 26407)
    +++ compiler/scanner.pas	(working copy)
    @@ -2271,41 +2271,40 @@
             mac.is_used:=true;
           end;
     
    -    procedure dir_include;
    +    function findincludefile(const path,name:TCmdStr;var foundfile:TCmdStr):boolean;
    +    var
    +      found  : boolean;
    +      hpath  : TCmdStr;
    +    begin
    +      (* look for the include file
    +       If path was absolute and specified as part of {$I } then
    +        1. specified path
    +       else
    +        1. path of current inputfile,current dir
    +        2. local includepath
    +        3. global includepath
     
    -        function findincludefile(const path,name:TCmdStr;var foundfile:TCmdStr):boolean;
    -        var
    -          found  : boolean;
    -          hpath  : TCmdStr;
    -        begin
    -          (* look for the include file
    -           If path was absolute and specified as part of {$I } then
    -            1. specified path
    -           else
    -            1. path of current inputfile,current dir
    -            2. local includepath
    -            3. global includepath
    +        -- Check mantis #13461 before changing this *)
    +       found:=false;
    +       foundfile:='';
    +       hpath:='';
    +       if path_absolute(path) then
    +         begin
    +           found:=FindFile(name,path,true,foundfile);
    +         end
    +       else
    +         begin
    +           hpath:=current_scanner.inputfile.path+';'+CurDirRelPath(source_info);
    +           found:=FindFile(path+name, hpath,true,foundfile);
    +           if not found then
    +             found:=current_module.localincludesearchpath.FindFile(path+name,true,foundfile);
    +           if not found  then
    +             found:=includesearchpath.FindFile(path+name,true,foundfile);
    +         end;
    +       result:=found;
    +    end;
     
    -            -- Check mantis #13461 before changing this *)
    -           found:=false;
    -           foundfile:='';
    -           hpath:='';
    -           if path_absolute(path) then
    -             begin
    -               found:=FindFile(name,path,true,foundfile);
    -             end
    -           else
    -             begin
    -               hpath:=current_scanner.inputfile.path+';'+CurDirRelPath(source_info);
    -               found:=FindFile(path+name, hpath,true,foundfile);
    -               if not found then
    -                 found:=current_module.localincludesearchpath.FindFile(path+name,true,foundfile);
    -               if not found  then
    -                 found:=includesearchpath.FindFile(path+name,true,foundfile);
    -             end;
    -           result:=found;
    -        end;
    -
    +    procedure dir_include;
           var
             foundfile : TCmdStr;
             path,
    @@ -2422,7 +2421,38 @@
              end;
           end;
     
    +    procedure dir_includestringfile;
    +      var
    +        path : ansistring;
    +        fname : ansistring;
    +        f : file;
    +      begin
     
    +        Current_scanner.skipspace;
    +
    +        path := current_scanner.readcomment;
    +
    +        if not findincludefile(ExtractFilePath(path), ExtractFileName(path), fname) then
    +          Message1(scan_f_cannot_open_includefile, path)
    +        else
    +         begin
    +
    +           assign(f, fname);
    +           reset(f, 1);
    +
    +           setlength(cstringpattern, filesize(f) - 1);
    +           blockread(f, cstringpattern[1], length(cstringpattern) );
    +
    +           cstringpattern[length(cstringpattern) + 1] := #0;
    +           token := _CSTRING;
    +
    +           close(f);
    +
    +         end;
    +
    +      end;
    +
    +
     {*****************************************************************************
                                 Preprocessor writing
     *****************************************************************************}
    @@ -4439,6 +4469,8 @@
                goto exit_label;
              end;
     
    +        token := NOTOKEN; // Clear Token
    +
           { Skip all spaces and comments }
             repeat
               case c of
    @@ -4468,6 +4500,10 @@
               end;
             until false;
     
    +      { Was a token set from a Directive or elsewhere at this point? }
    +        if token <> NOTOKEN then
    +          goto exit_label;
    +
           { Save current token position, for EOF its already loaded }
             if c<>#26 then
               gettokenpos;
    @@ -5490,6 +5526,7 @@
             AddDirective('I',directive_all, @dir_include);
             AddDirective('DEFINE',directive_all, @dir_define);
             AddDirective('UNDEF',directive_all, @dir_undef);
    +        AddDirective('INCLUDESTRINGFILE',directive_all, @dir_includestringfile);
     
             AddConditional('IF',directive_all, @dir_if);
             AddConditional('IFDEF',directive_all, @dir_ifdef);
    
    scanner.diff (4,590 bytes)
  • scanner-2.diff (4,587 bytes)
    Index: compiler/scanner.pas
    ===================================================================
    --- compiler/scanner.pas	(revision 26460)
    +++ compiler/scanner.pas	(working copy)
    @@ -2271,41 +2271,40 @@
             mac.is_used:=true;
           end;
     
    -    procedure dir_include;
    +    function findincludefile(const path,name:TCmdStr;var foundfile:TCmdStr):boolean;
    +    var
    +      found  : boolean;
    +      hpath  : TCmdStr;
    +    begin
    +      (* look for the include file
    +       If path was absolute and specified as part of {$I } then
    +        1. specified path
    +       else
    +        1. path of current inputfile,current dir
    +        2. local includepath
    +        3. global includepath
     
    -        function findincludefile(const path,name:TCmdStr;var foundfile:TCmdStr):boolean;
    -        var
    -          found  : boolean;
    -          hpath  : TCmdStr;
    -        begin
    -          (* look for the include file
    -           If path was absolute and specified as part of {$I } then
    -            1. specified path
    -           else
    -            1. path of current inputfile,current dir
    -            2. local includepath
    -            3. global includepath
    +        -- Check mantis #13461 before changing this *)
    +       found:=false;
    +       foundfile:='';
    +       hpath:='';
    +       if path_absolute(path) then
    +         begin
    +           found:=FindFile(name,path,true,foundfile);
    +         end
    +       else
    +         begin
    +           hpath:=current_scanner.inputfile.path+';'+CurDirRelPath(source_info);
    +           found:=FindFile(path+name, hpath,true,foundfile);
    +           if not found then
    +             found:=current_module.localincludesearchpath.FindFile(path+name,true,foundfile);
    +           if not found  then
    +             found:=includesearchpath.FindFile(path+name,true,foundfile);
    +         end;
    +       result:=found;
    +    end;
     
    -            -- Check mantis #13461 before changing this *)
    -           found:=false;
    -           foundfile:='';
    -           hpath:='';
    -           if path_absolute(path) then
    -             begin
    -               found:=FindFile(name,path,true,foundfile);
    -             end
    -           else
    -             begin
    -               hpath:=current_scanner.inputfile.path+';'+CurDirRelPath(source_info);
    -               found:=FindFile(path+name, hpath,true,foundfile);
    -               if not found then
    -                 found:=current_module.localincludesearchpath.FindFile(path+name,true,foundfile);
    -               if not found  then
    -                 found:=includesearchpath.FindFile(path+name,true,foundfile);
    -             end;
    -           result:=found;
    -        end;
    -
    +    procedure dir_include;
           var
             foundfile : TCmdStr;
             path,
    @@ -2422,7 +2421,38 @@
              end;
           end;
     
    +    procedure dir_includestringfile;
    +      var
    +        path : ansistring;
    +        fname : ansistring;
    +        f : file;
    +      begin
     
    +        Current_scanner.skipspace;
    +
    +        path := current_scanner.readcomment;
    +
    +        if not findincludefile(ExtractFilePath(path), ExtractFileName(path), fname) then
    +          Message1(scan_f_cannot_open_includefile, path)
    +        else
    +         begin
    +
    +           assign(f, fname);
    +           reset(f, 1);
    +
    +           setlength(cstringpattern, filesize(f) );
    +           blockread(f, cstringpattern[1], length(cstringpattern) );
    +
    +           cstringpattern[length(cstringpattern) + 1] := #0;
    +           token := _CSTRING;
    +
    +           close(f);
    +
    +         end;
    +
    +      end;
    +
    +
     {*****************************************************************************
                                 Preprocessor writing
     *****************************************************************************}
    @@ -4439,6 +4469,8 @@
                goto exit_label;
              end;
     
    +        token := NOTOKEN; // Clear Token
    +
           { Skip all spaces and comments }
             repeat
               case c of
    @@ -4468,6 +4500,10 @@
               end;
             until false;
     
    +      { Was a token set from a Directive or elsewhere at this point? }
    +        if token <> NOTOKEN then
    +          goto exit_label;
    +
           { Save current token position, for EOF its already loaded }
             if c<>#26 then
               gettokenpos;
    @@ -5490,6 +5526,7 @@
             AddDirective('I',directive_all, @dir_include);
             AddDirective('DEFINE',directive_all, @dir_define);
             AddDirective('UNDEF',directive_all, @dir_undef);
    +        AddDirective('INCLUDESTRINGFILE',directive_all, @dir_includestringfile);
     
             AddConditional('IF',directive_all, @dir_if);
             AddConditional('IFDEF',directive_all, @dir_ifdef);
    
    scanner-2.diff (4,587 bytes)
  • includestringfile.diff (9,089 bytes)
    Index: compiler/scanner.pas
    ===================================================================
    --- compiler/scanner.pas	(revision 26570)
    +++ compiler/scanner.pas	(working copy)
    @@ -33,11 +33,11 @@
            widestr;
     
         const
    +       max_includestringfile_size=128*1024*1024; // 128MB shouuuuuld be enough?
            max_include_nesting=32;
            max_macro_nesting=16;
            preprocbufsize=32*1024;
     
    -
         type
            tcommentstyle = (comment_none,comment_tp,comment_oldtp,comment_delphi,comment_c);
     
    @@ -2271,41 +2271,40 @@
             mac.is_used:=true;
           end;
     
    -    procedure dir_include;
    +    function findincludefile(const path,name:TCmdStr;var foundfile:TCmdStr):boolean;
    +    var
    +      found  : boolean;
    +      hpath  : TCmdStr;
    +    begin
    +      (* look for the include file
    +       If path was absolute and specified as part of {$I } then
    +        1. specified path
    +       else
    +        1. path of current inputfile,current dir
    +        2. local includepath
    +        3. global includepath
     
    -        function findincludefile(const path,name:TCmdStr;var foundfile:TCmdStr):boolean;
    -        var
    -          found  : boolean;
    -          hpath  : TCmdStr;
    -        begin
    -          (* look for the include file
    -           If path was absolute and specified as part of {$I } then
    -            1. specified path
    -           else
    -            1. path of current inputfile,current dir
    -            2. local includepath
    -            3. global includepath
    +        -- Check mantis #13461 before changing this *)
    +       found:=false;
    +       foundfile:='';
    +       hpath:='';
    +       if path_absolute(path) then
    +         begin
    +           found:=FindFile(name,path,true,foundfile);
    +         end
    +       else
    +         begin
    +           hpath:=current_scanner.inputfile.path+';'+CurDirRelPath(source_info);
    +           found:=FindFile(path+name, hpath,true,foundfile);
    +           if not found then
    +             found:=current_module.localincludesearchpath.FindFile(path+name,true,foundfile);
    +           if not found  then
    +             found:=includesearchpath.FindFile(path+name,true,foundfile);
    +         end;
    +       result:=found;
    +    end;
     
    -            -- Check mantis #13461 before changing this *)
    -           found:=false;
    -           foundfile:='';
    -           hpath:='';
    -           if path_absolute(path) then
    -             begin
    -               found:=FindFile(name,path,true,foundfile);
    -             end
    -           else
    -             begin
    -               hpath:=current_scanner.inputfile.path+';'+CurDirRelPath(source_info);
    -               found:=FindFile(path+name, hpath,true,foundfile);
    -               if not found then
    -                 found:=current_module.localincludesearchpath.FindFile(path+name,true,foundfile);
    -               if not found  then
    -                 found:=includesearchpath.FindFile(path+name,true,foundfile);
    -             end;
    -           result:=found;
    -        end;
    -
    +    procedure dir_include;
           var
             foundfile : TCmdStr;
             path,
    @@ -2422,7 +2421,77 @@
              end;
           end;
     
    +    procedure dir_includestringfile;
    +      var
    +        fsize : int64;
    +        path : ansistring;
    +        fname : ansistring;
    +        f : file;
    +      begin
     
    +        // Skip White-Space to the actual Path //
    +
    +        Current_scanner.skipspace;
    +
    +        // Get the Path! //
    +
    +        path := current_scanner.readcomment;
    +
    +        // We use the New-Global Function to check for an Include File //
    +
    +        if not findincludefile(ExtractFilePath(path), ExtractFileName(path), fname) then
    +          Message1(scan_f_cannot_open_includefile, path)
    +        else
    +         begin
    +
    +           // Open the File (Read-Only) //
    +
    +           assign(f, fname);
    +           reset(f, 1);
    +
    +           try
    +
    +             // Only read if there is something in the file //
    +
    +             fsize := filesize(f);
    +
    +             if fsize = 0 then
    +               cstringpattern := ''
    +             else
    +              begin
    +
    +                // Too big for us? //
    +
    +                if fsize > max_includestringfile_size then
    +                  Message2(scan_f_includestringfile_toobig, path, inttostr(max_includestringfile_size))
    +                else
    +                 begin
    +
    +                   // Allocate space for the File, and READ! //
    +
    +                   setlength(cstringpattern, fsize);
    +                   blockread(f, cstringpattern[1], length(cstringpattern) );
    +
    +                   // We use a CString Token, as it's an AnsiString and can hold more than 255 Chars //
    +
    +                   token := _CSTRING;
    +
    +                 end;
    +
    +              end;
    +
    +             token := _CSTRING;
    +
    +           finally
    +             // Close the File! We're done! //
    +             close(f);
    +           end;
    +
    +         end;
    +
    +      end;
    +
    +
     {*****************************************************************************
                                 Preprocessor writing
     *****************************************************************************}
    @@ -4439,6 +4508,8 @@
                goto exit_label;
              end;
     
    +        token := NOTOKEN; // Clear Token
    +
           { Skip all spaces and comments }
             repeat
               case c of
    @@ -4468,6 +4539,10 @@
               end;
             until false;
     
    +      { Was a token set from a Directive or elsewhere at this point? }
    +        if token <> NOTOKEN then
    +          goto exit_label;
    +
           { Save current token position, for EOF its already loaded }
             if c<>#26 then
               gettokenpos;
    @@ -5490,6 +5565,7 @@
             AddDirective('I',directive_all, @dir_include);
             AddDirective('DEFINE',directive_all, @dir_define);
             AddDirective('UNDEF',directive_all, @dir_undef);
    +        AddDirective('INCLUDESTRINGFILE',directive_all, @dir_includestringfile);
     
             AddConditional('IF',directive_all, @dir_if);
             AddConditional('IFDEF',directive_all, @dir_ifdef);
    Index: compiler/msg/errore.msg
    ===================================================================
    --- compiler/msg/errore.msg	(revision 26570)
    +++ compiler/msg/errore.msg	(working copy)
    @@ -184,6 +184,8 @@
     % \fpc cannot find the program or unit source file you specified on the
     % command line.
     scan_f_cannot_open_includefile=02013_F_Can't open include file "$1"
    +% The String File is too large
    +scan_f_includestringfile_toobig=02014_F_String file too large "$1" (Size: $2)
     % \fpc cannot find the source file you specified in a \var{\{\$include ..\}}
     % statement.
     scan_e_illegal_pack_records=02015_E_Illegal record alignment specifier "$1"
    Index: tests/test/tincstrfile.pp
    ===================================================================
    --- tests/test/tincstrfile.pp	(revision 0)
    +++ tests/test/tincstrfile.pp	(working copy)
    @@ -0,0 +1,47 @@
    +Program tincstrfile;
    +
    +{$MODE OBJFPC}
    +
    +//========== Constants =======================================================//
    +
    +Const
    +
    +  // Note: All Strings have been saved with no ending LF //
    +
    +  STR_NORMAL      = {$INCLUDESTRINGFILE tincstrfile_1.inc};
    +  STR_WITH_LF     = {$INCLUDESTRINGFILE tincstrfile_2.inc};
    +  STR_WITH_QUOTES = {$INCLUDESTRINGFILE tincstrfile_3.inc};
    +  STR_EMPTY       = {$INCLUDESTRINGFILE tincstrfile_4.inc};
    +
    +//========== Variables =======================================================//
    +
    +Var ErrCode : LongInt = 0;
    +
    +//========== Functions =======================================================//
    +
    +Procedure CheckStr(Msg, SrcStr, DestStr : AnsiString);
    +Begin
    +
    +  // Write our little message //
    +
    +  Write(Msg, ': ');
    +
    +  // Check if the string matches or not! //
    +
    +  IF SrcStr = DestStr
    +   Then Writeln('OK')
    +  Else
    +  Begin
    +    Writeln('Not OK');
    +    ErrCode := 1;
    +  End; { Else }
    +
    +End; { Procedure }
    +
    +Begin
    +  CheckStr('Normal String', STR_NORMAL, 'This is a normal String');
    +  CheckStr('String with LineFeed', STR_WITH_LF, 'This is a String with' + #10 + 'Another Line!');
    +  CheckStr('String with Quotes', STR_WITH_QUOTES, 'This is ''a String'' with err''thing and quotes n''"'' such''""" yeah''''''"''""''');
    +  CheckStr('Empty String', STR_EMPTY, '');
    +  Halt(ErrCode);
    +End.
    Index: tests/test/tincstrfile_1.inc
    ===================================================================
    --- tests/test/tincstrfile_1.inc	(revision 0)
    +++ tests/test/tincstrfile_1.inc	(working copy)
    @@ -0,0 +1 @@
    +This is a normal String
    \ No newline at end of file
    Index: tests/test/tincstrfile_2.inc
    ===================================================================
    --- tests/test/tincstrfile_2.inc	(revision 0)
    +++ tests/test/tincstrfile_2.inc	(working copy)
    @@ -0,0 +1,2 @@
    +This is a String with
    +Another Line!
    \ No newline at end of file
    Index: tests/test/tincstrfile_3.inc
    ===================================================================
    --- tests/test/tincstrfile_3.inc	(revision 0)
    +++ tests/test/tincstrfile_3.inc	(working copy)
    @@ -0,0 +1 @@
    +This is 'a String' with err'thing and quotes n'"' such'""" yeah'''"'""'
    \ No newline at end of file
    Index: tests/test/tincstrfile_4.inc
    ===================================================================
    
    includestringfile.diff (9,089 bytes)

Relationships

has duplicate 0021848 resolvedJonas Maebe Implemented HEREDOC 
has duplicate 0015560 resolvedJonas Maebe [patch] New $IncludeString directive 

Activities

Dennis Fehr

2014-01-14 21:17

reporter  

scanner.diff (4,590 bytes)
Index: compiler/scanner.pas
===================================================================
--- compiler/scanner.pas	(revision 26407)
+++ compiler/scanner.pas	(working copy)
@@ -2271,41 +2271,40 @@
         mac.is_used:=true;
       end;
 
-    procedure dir_include;
+    function findincludefile(const path,name:TCmdStr;var foundfile:TCmdStr):boolean;
+    var
+      found  : boolean;
+      hpath  : TCmdStr;
+    begin
+      (* look for the include file
+       If path was absolute and specified as part of {$I } then
+        1. specified path
+       else
+        1. path of current inputfile,current dir
+        2. local includepath
+        3. global includepath
 
-        function findincludefile(const path,name:TCmdStr;var foundfile:TCmdStr):boolean;
-        var
-          found  : boolean;
-          hpath  : TCmdStr;
-        begin
-          (* look for the include file
-           If path was absolute and specified as part of {$I } then
-            1. specified path
-           else
-            1. path of current inputfile,current dir
-            2. local includepath
-            3. global includepath
+        -- Check mantis #13461 before changing this *)
+       found:=false;
+       foundfile:='';
+       hpath:='';
+       if path_absolute(path) then
+         begin
+           found:=FindFile(name,path,true,foundfile);
+         end
+       else
+         begin
+           hpath:=current_scanner.inputfile.path+';'+CurDirRelPath(source_info);
+           found:=FindFile(path+name, hpath,true,foundfile);
+           if not found then
+             found:=current_module.localincludesearchpath.FindFile(path+name,true,foundfile);
+           if not found  then
+             found:=includesearchpath.FindFile(path+name,true,foundfile);
+         end;
+       result:=found;
+    end;
 
-            -- Check mantis #13461 before changing this *)
-           found:=false;
-           foundfile:='';
-           hpath:='';
-           if path_absolute(path) then
-             begin
-               found:=FindFile(name,path,true,foundfile);
-             end
-           else
-             begin
-               hpath:=current_scanner.inputfile.path+';'+CurDirRelPath(source_info);
-               found:=FindFile(path+name, hpath,true,foundfile);
-               if not found then
-                 found:=current_module.localincludesearchpath.FindFile(path+name,true,foundfile);
-               if not found  then
-                 found:=includesearchpath.FindFile(path+name,true,foundfile);
-             end;
-           result:=found;
-        end;
-
+    procedure dir_include;
       var
         foundfile : TCmdStr;
         path,
@@ -2422,7 +2421,38 @@
          end;
       end;
 
+    procedure dir_includestringfile;
+      var
+        path : ansistring;
+        fname : ansistring;
+        f : file;
+      begin
 
+        Current_scanner.skipspace;
+
+        path := current_scanner.readcomment;
+
+        if not findincludefile(ExtractFilePath(path), ExtractFileName(path), fname) then
+          Message1(scan_f_cannot_open_includefile, path)
+        else
+         begin
+
+           assign(f, fname);
+           reset(f, 1);
+
+           setlength(cstringpattern, filesize(f) - 1);
+           blockread(f, cstringpattern[1], length(cstringpattern) );
+
+           cstringpattern[length(cstringpattern) + 1] := #0;
+           token := _CSTRING;
+
+           close(f);
+
+         end;
+
+      end;
+
+
 {*****************************************************************************
                             Preprocessor writing
 *****************************************************************************}
@@ -4439,6 +4469,8 @@
            goto exit_label;
          end;
 
+        token := NOTOKEN; // Clear Token
+
       { Skip all spaces and comments }
         repeat
           case c of
@@ -4468,6 +4500,10 @@
           end;
         until false;
 
+      { Was a token set from a Directive or elsewhere at this point? }
+        if token <> NOTOKEN then
+          goto exit_label;
+
       { Save current token position, for EOF its already loaded }
         if c<>#26 then
           gettokenpos;
@@ -5490,6 +5526,7 @@
         AddDirective('I',directive_all, @dir_include);
         AddDirective('DEFINE',directive_all, @dir_define);
         AddDirective('UNDEF',directive_all, @dir_undef);
+        AddDirective('INCLUDESTRINGFILE',directive_all, @dir_includestringfile);
 
         AddConditional('IF',directive_all, @dir_if);
         AddConditional('IFDEF',directive_all, @dir_ifdef);
scanner.diff (4,590 bytes)

Dennis Fehr

2014-01-14 21:19

reporter   ~0072439

I know this is a 'duplicate' of my other bug report of this, but can someone make this the official, and mark the other as duplicate? A dev from the fpc-devel mailing list had mentioned they were going to include this, but has not yet.. So I post it officially here (I have been using this for quite awhile in my own projects).

Jonas Maebe

2014-01-14 21:28

manager   ~0072440

Why do your read in one byte less than the file size?

Dennis Fehr

2014-01-14 23:12

reporter  

scanner-2.diff (4,587 bytes)
Index: compiler/scanner.pas
===================================================================
--- compiler/scanner.pas	(revision 26460)
+++ compiler/scanner.pas	(working copy)
@@ -2271,41 +2271,40 @@
         mac.is_used:=true;
       end;
 
-    procedure dir_include;
+    function findincludefile(const path,name:TCmdStr;var foundfile:TCmdStr):boolean;
+    var
+      found  : boolean;
+      hpath  : TCmdStr;
+    begin
+      (* look for the include file
+       If path was absolute and specified as part of {$I } then
+        1. specified path
+       else
+        1. path of current inputfile,current dir
+        2. local includepath
+        3. global includepath
 
-        function findincludefile(const path,name:TCmdStr;var foundfile:TCmdStr):boolean;
-        var
-          found  : boolean;
-          hpath  : TCmdStr;
-        begin
-          (* look for the include file
-           If path was absolute and specified as part of {$I } then
-            1. specified path
-           else
-            1. path of current inputfile,current dir
-            2. local includepath
-            3. global includepath
+        -- Check mantis #13461 before changing this *)
+       found:=false;
+       foundfile:='';
+       hpath:='';
+       if path_absolute(path) then
+         begin
+           found:=FindFile(name,path,true,foundfile);
+         end
+       else
+         begin
+           hpath:=current_scanner.inputfile.path+';'+CurDirRelPath(source_info);
+           found:=FindFile(path+name, hpath,true,foundfile);
+           if not found then
+             found:=current_module.localincludesearchpath.FindFile(path+name,true,foundfile);
+           if not found  then
+             found:=includesearchpath.FindFile(path+name,true,foundfile);
+         end;
+       result:=found;
+    end;
 
-            -- Check mantis #13461 before changing this *)
-           found:=false;
-           foundfile:='';
-           hpath:='';
-           if path_absolute(path) then
-             begin
-               found:=FindFile(name,path,true,foundfile);
-             end
-           else
-             begin
-               hpath:=current_scanner.inputfile.path+';'+CurDirRelPath(source_info);
-               found:=FindFile(path+name, hpath,true,foundfile);
-               if not found then
-                 found:=current_module.localincludesearchpath.FindFile(path+name,true,foundfile);
-               if not found  then
-                 found:=includesearchpath.FindFile(path+name,true,foundfile);
-             end;
-           result:=found;
-        end;
-
+    procedure dir_include;
       var
         foundfile : TCmdStr;
         path,
@@ -2422,7 +2421,38 @@
          end;
       end;
 
+    procedure dir_includestringfile;
+      var
+        path : ansistring;
+        fname : ansistring;
+        f : file;
+      begin
 
+        Current_scanner.skipspace;
+
+        path := current_scanner.readcomment;
+
+        if not findincludefile(ExtractFilePath(path), ExtractFileName(path), fname) then
+          Message1(scan_f_cannot_open_includefile, path)
+        else
+         begin
+
+           assign(f, fname);
+           reset(f, 1);
+
+           setlength(cstringpattern, filesize(f) );
+           blockread(f, cstringpattern[1], length(cstringpattern) );
+
+           cstringpattern[length(cstringpattern) + 1] := #0;
+           token := _CSTRING;
+
+           close(f);
+
+         end;
+
+      end;
+
+
 {*****************************************************************************
                             Preprocessor writing
 *****************************************************************************}
@@ -4439,6 +4469,8 @@
            goto exit_label;
          end;
 
+        token := NOTOKEN; // Clear Token
+
       { Skip all spaces and comments }
         repeat
           case c of
@@ -4468,6 +4500,10 @@
           end;
         until false;
 
+      { Was a token set from a Directive or elsewhere at this point? }
+        if token <> NOTOKEN then
+          goto exit_label;
+
       { Save current token position, for EOF its already loaded }
         if c<>#26 then
           gettokenpos;
@@ -5490,6 +5526,7 @@
         AddDirective('I',directive_all, @dir_include);
         AddDirective('DEFINE',directive_all, @dir_define);
         AddDirective('UNDEF',directive_all, @dir_undef);
+        AddDirective('INCLUDESTRINGFILE',directive_all, @dir_includestringfile);
 
         AddConditional('IF',directive_all, @dir_if);
         AddConditional('IFDEF',directive_all, @dir_ifdef);
scanner-2.diff (4,587 bytes)

Dennis Fehr

2014-01-14 23:13

reporter   ~0072448

Last edited: 2014-01-14 23:21

View 2 revisions

It was written quite awhile ago, but think it was to rid the UNIX last LF, but that should be left up to the USER, and they can always do a Trim if need be. I uploaded a new version without it.

Edit: *Sorry meant LineFeed

Dennis Fehr

2014-01-19 18:57

reporter   ~0072551

I'll give a low-down of what the patch does:

  - 'dir_include' is moved to a global function, so my INCLUDESTRINGFILE directive can use it as well (so no duplicate code)
  - I check to see if a token was set while in the comment scanning (hence the directives setting a token, like mine) and exit
  - And because of the check (as it always gets over-written later) I need to clear the token (NOTOKEN) beforehand to make sure it doesn't bail from the previously set Token.

dir_includestringfile:

  - Pretty straight forward; Gets path, loads file, loads up the entire file and sets token as '_CSTRING' (ansistring -- so it can handle more than 255 chars).

Sven Barth

2014-01-23 09:23

manager   ~0072614

Would you please provide test files that adhere to the tests inside the $fpc/tests directory?

Are "'" handled correctly?
What happens if the file is too large to be included?
What if the file has a Unicode BOM? (UTF-8, UTF-16 LE/BE)

Did you run the testsuite to ensure that no regressions are introduced?

Regards,
Sven

Dennis Fehr

2014-01-24 05:48

reporter  

includestringfile.diff (9,089 bytes)
Index: compiler/scanner.pas
===================================================================
--- compiler/scanner.pas	(revision 26570)
+++ compiler/scanner.pas	(working copy)
@@ -33,11 +33,11 @@
        widestr;
 
     const
+       max_includestringfile_size=128*1024*1024; // 128MB shouuuuuld be enough?
        max_include_nesting=32;
        max_macro_nesting=16;
        preprocbufsize=32*1024;
 
-
     type
        tcommentstyle = (comment_none,comment_tp,comment_oldtp,comment_delphi,comment_c);
 
@@ -2271,41 +2271,40 @@
         mac.is_used:=true;
       end;
 
-    procedure dir_include;
+    function findincludefile(const path,name:TCmdStr;var foundfile:TCmdStr):boolean;
+    var
+      found  : boolean;
+      hpath  : TCmdStr;
+    begin
+      (* look for the include file
+       If path was absolute and specified as part of {$I } then
+        1. specified path
+       else
+        1. path of current inputfile,current dir
+        2. local includepath
+        3. global includepath
 
-        function findincludefile(const path,name:TCmdStr;var foundfile:TCmdStr):boolean;
-        var
-          found  : boolean;
-          hpath  : TCmdStr;
-        begin
-          (* look for the include file
-           If path was absolute and specified as part of {$I } then
-            1. specified path
-           else
-            1. path of current inputfile,current dir
-            2. local includepath
-            3. global includepath
+        -- Check mantis #13461 before changing this *)
+       found:=false;
+       foundfile:='';
+       hpath:='';
+       if path_absolute(path) then
+         begin
+           found:=FindFile(name,path,true,foundfile);
+         end
+       else
+         begin
+           hpath:=current_scanner.inputfile.path+';'+CurDirRelPath(source_info);
+           found:=FindFile(path+name, hpath,true,foundfile);
+           if not found then
+             found:=current_module.localincludesearchpath.FindFile(path+name,true,foundfile);
+           if not found  then
+             found:=includesearchpath.FindFile(path+name,true,foundfile);
+         end;
+       result:=found;
+    end;
 
-            -- Check mantis #13461 before changing this *)
-           found:=false;
-           foundfile:='';
-           hpath:='';
-           if path_absolute(path) then
-             begin
-               found:=FindFile(name,path,true,foundfile);
-             end
-           else
-             begin
-               hpath:=current_scanner.inputfile.path+';'+CurDirRelPath(source_info);
-               found:=FindFile(path+name, hpath,true,foundfile);
-               if not found then
-                 found:=current_module.localincludesearchpath.FindFile(path+name,true,foundfile);
-               if not found  then
-                 found:=includesearchpath.FindFile(path+name,true,foundfile);
-             end;
-           result:=found;
-        end;
-
+    procedure dir_include;
       var
         foundfile : TCmdStr;
         path,
@@ -2422,7 +2421,77 @@
          end;
       end;
 
+    procedure dir_includestringfile;
+      var
+        fsize : int64;
+        path : ansistring;
+        fname : ansistring;
+        f : file;
+      begin
 
+        // Skip White-Space to the actual Path //
+
+        Current_scanner.skipspace;
+
+        // Get the Path! //
+
+        path := current_scanner.readcomment;
+
+        // We use the New-Global Function to check for an Include File //
+
+        if not findincludefile(ExtractFilePath(path), ExtractFileName(path), fname) then
+          Message1(scan_f_cannot_open_includefile, path)
+        else
+         begin
+
+           // Open the File (Read-Only) //
+
+           assign(f, fname);
+           reset(f, 1);
+
+           try
+
+             // Only read if there is something in the file //
+
+             fsize := filesize(f);
+
+             if fsize = 0 then
+               cstringpattern := ''
+             else
+              begin
+
+                // Too big for us? //
+
+                if fsize > max_includestringfile_size then
+                  Message2(scan_f_includestringfile_toobig, path, inttostr(max_includestringfile_size))
+                else
+                 begin
+
+                   // Allocate space for the File, and READ! //
+
+                   setlength(cstringpattern, fsize);
+                   blockread(f, cstringpattern[1], length(cstringpattern) );
+
+                   // We use a CString Token, as it's an AnsiString and can hold more than 255 Chars //
+
+                   token := _CSTRING;
+
+                 end;
+
+              end;
+
+             token := _CSTRING;
+
+           finally
+             // Close the File! We're done! //
+             close(f);
+           end;
+
+         end;
+
+      end;
+
+
 {*****************************************************************************
                             Preprocessor writing
 *****************************************************************************}
@@ -4439,6 +4508,8 @@
            goto exit_label;
          end;
 
+        token := NOTOKEN; // Clear Token
+
       { Skip all spaces and comments }
         repeat
           case c of
@@ -4468,6 +4539,10 @@
           end;
         until false;
 
+      { Was a token set from a Directive or elsewhere at this point? }
+        if token <> NOTOKEN then
+          goto exit_label;
+
       { Save current token position, for EOF its already loaded }
         if c<>#26 then
           gettokenpos;
@@ -5490,6 +5565,7 @@
         AddDirective('I',directive_all, @dir_include);
         AddDirective('DEFINE',directive_all, @dir_define);
         AddDirective('UNDEF',directive_all, @dir_undef);
+        AddDirective('INCLUDESTRINGFILE',directive_all, @dir_includestringfile);
 
         AddConditional('IF',directive_all, @dir_if);
         AddConditional('IFDEF',directive_all, @dir_ifdef);
Index: compiler/msg/errore.msg
===================================================================
--- compiler/msg/errore.msg	(revision 26570)
+++ compiler/msg/errore.msg	(working copy)
@@ -184,6 +184,8 @@
 % \fpc cannot find the program or unit source file you specified on the
 % command line.
 scan_f_cannot_open_includefile=02013_F_Can't open include file "$1"
+% The String File is too large
+scan_f_includestringfile_toobig=02014_F_String file too large "$1" (Size: $2)
 % \fpc cannot find the source file you specified in a \var{\{\$include ..\}}
 % statement.
 scan_e_illegal_pack_records=02015_E_Illegal record alignment specifier "$1"
Index: tests/test/tincstrfile.pp
===================================================================
--- tests/test/tincstrfile.pp	(revision 0)
+++ tests/test/tincstrfile.pp	(working copy)
@@ -0,0 +1,47 @@
+Program tincstrfile;
+
+{$MODE OBJFPC}
+
+//========== Constants =======================================================//
+
+Const
+
+  // Note: All Strings have been saved with no ending LF //
+
+  STR_NORMAL      = {$INCLUDESTRINGFILE tincstrfile_1.inc};
+  STR_WITH_LF     = {$INCLUDESTRINGFILE tincstrfile_2.inc};
+  STR_WITH_QUOTES = {$INCLUDESTRINGFILE tincstrfile_3.inc};
+  STR_EMPTY       = {$INCLUDESTRINGFILE tincstrfile_4.inc};
+
+//========== Variables =======================================================//
+
+Var ErrCode : LongInt = 0;
+
+//========== Functions =======================================================//
+
+Procedure CheckStr(Msg, SrcStr, DestStr : AnsiString);
+Begin
+
+  // Write our little message //
+
+  Write(Msg, ': ');
+
+  // Check if the string matches or not! //
+
+  IF SrcStr = DestStr
+   Then Writeln('OK')
+  Else
+  Begin
+    Writeln('Not OK');
+    ErrCode := 1;
+  End; { Else }
+
+End; { Procedure }
+
+Begin
+  CheckStr('Normal String', STR_NORMAL, 'This is a normal String');
+  CheckStr('String with LineFeed', STR_WITH_LF, 'This is a String with' + #10 + 'Another Line!');
+  CheckStr('String with Quotes', STR_WITH_QUOTES, 'This is ''a String'' with err''thing and quotes n''"'' such''""" yeah''''''"''""''');
+  CheckStr('Empty String', STR_EMPTY, '');
+  Halt(ErrCode);
+End.
Index: tests/test/tincstrfile_1.inc
===================================================================
--- tests/test/tincstrfile_1.inc	(revision 0)
+++ tests/test/tincstrfile_1.inc	(working copy)
@@ -0,0 +1 @@
+This is a normal String
\ No newline at end of file
Index: tests/test/tincstrfile_2.inc
===================================================================
--- tests/test/tincstrfile_2.inc	(revision 0)
+++ tests/test/tincstrfile_2.inc	(working copy)
@@ -0,0 +1,2 @@
+This is a String with
+Another Line!
\ No newline at end of file
Index: tests/test/tincstrfile_3.inc
===================================================================
--- tests/test/tincstrfile_3.inc	(revision 0)
+++ tests/test/tincstrfile_3.inc	(working copy)
@@ -0,0 +1 @@
+This is 'a String' with err'thing and quotes n'"' such'""" yeah'''"'""'
\ No newline at end of file
Index: tests/test/tincstrfile_4.inc
===================================================================
includestringfile.diff (9,089 bytes)

Dennis Fehr

2014-01-24 05:50

reporter   ~0072624

Last edited: 2014-01-24 06:36

View 3 revisions

Alright! I went over the patch and added quite a lot of comments, and a max-size constant, an error message (if too big), and some tests! (That also include ' and such).. It's currently handled as an AnsiString (The Token is _CSTRING), I suppose in the future I could add a INCLUDEWIDESTRINGFILE or something? Anyway.. Tell me what you think Sven! :)

Edit: Ran the tests and they are the same! (well, on the one with my addition, the only difference is my new test, and it runs successful. :p)

Thaddy de Koning

2014-01-24 11:37

reporter   ~0072627

Last edited: 2014-01-24 11:40

View 2 revisions

I think the notion of $includewidestringfile is debatable.
As I see it, $includestringfile should be opaque and the inner workings should take care of possible conversions into the string format of the main file.
It doesn't make much sense otherwise. You preferrably do not want to have two or more encodings in a single file anyway ;)

In that case proper warnings should be issued if there is potential data loss, but a brief glance shows that the conversion routines themselves would take care of that, if you would implement it as an opaque.
It also needs precise documentation.

I guess Sven was hinting at something similar.

Jonas Maebe

2014-01-24 11:48

manager   ~0072629

If this is in fact implemented eventually, $includestringfile should not convert anything. The file should be required to be in the same encoding as the main file, just like include files must have the same encoding as the main file. And FPC does not support UTF-16-encoded source files at this time, afaik.

Thaddy de Koning

2014-01-24 12:10

reporter   ~0072630

Last edited: 2014-01-24 12:16

View 2 revisions

I see the point, broadly agree. In that case the limitation should be documented as such.

As an aside:
I am not aware of a way (even by statistical analysis, deterministic, this fails on short files) to determine reliably what the encoding of a certain text file is. A BOM is not always there. EBCDIC wouldn't work anyway. Wishing well .....
Although it is quite possible to determine if the file is compatible with a certain encoding at the time of inclusion.

Jonas Maebe

2014-01-24 12:56

manager   ~0072631

Last edited: 2014-01-24 12:57

View 2 revisions

That reminds me: if an explicit code page is set and characters >chr(127) are encountered, the resulting strings are automatically converted by FPC to UTF-16 internally (and later back to the appropriate code page when assigned to non-unicodestring, if applicable). I don't see any such code in this patch, so it will probably go wrong for non-ASCII inputs.

Mark Morgan Lloyd

2014-01-24 22:47

reporter   ~0072653

I could imagine using this facility to include e.g. the rules for a compiler-compiler. So far, whenever I've done this it's been strict (i.e. 7-bit) ASCII, but in principle it would be desirable to extend this to handle e.g. the left-arrow for ALGOL or Smalltalk assignment. At which correct codepage or Unicode handling definitely becomes an issue.

Dennis Fehr

2014-01-25 23:12

reporter   ~0072681

@Jonas, can you give me an example from my test-case to throw it off?

J. Gareth Moreton

2019-07-04 08:04

developer   ~0117055

Changed status back to "New" since it was assigned to no-one.

Issue History

Date Modified Username Field Change
2014-01-14 21:17 Dennis Fehr New Issue
2014-01-14 21:17 Dennis Fehr File Added: scanner.diff
2014-01-14 21:19 Dennis Fehr Note Added: 0072439
2014-01-14 21:28 Jonas Maebe Note Added: 0072440
2014-01-14 21:28 Jonas Maebe Relationship added has duplicate 0021848
2014-01-14 21:29 Jonas Maebe Relationship added has duplicate 0015560
2014-01-14 23:12 Dennis Fehr File Added: scanner-2.diff
2014-01-14 23:13 Dennis Fehr Note Added: 0072448
2014-01-14 23:21 Dennis Fehr Note Edited: 0072448 View Revisions
2014-01-19 18:57 Dennis Fehr Note Added: 0072551
2014-01-23 09:23 Sven Barth Note Added: 0072614
2014-01-24 05:48 Dennis Fehr File Added: includestringfile.diff
2014-01-24 05:50 Dennis Fehr Note Added: 0072624
2014-01-24 06:04 Dennis Fehr Note Edited: 0072624 View Revisions
2014-01-24 06:36 Dennis Fehr Note Edited: 0072624 View Revisions
2014-01-24 11:37 Thaddy de Koning Note Added: 0072627
2014-01-24 11:40 Thaddy de Koning Note Edited: 0072627 View Revisions
2014-01-24 11:48 Jonas Maebe Note Added: 0072629
2014-01-24 12:10 Thaddy de Koning Note Added: 0072630
2014-01-24 12:16 Thaddy de Koning Note Edited: 0072630 View Revisions
2014-01-24 12:56 Jonas Maebe Note Added: 0072631
2014-01-24 12:57 Jonas Maebe Note Edited: 0072631 View Revisions
2014-01-24 22:47 Mark Morgan Lloyd Note Added: 0072653
2014-01-25 23:12 Dennis Fehr Note Added: 0072681
2019-02-23 16:49 Mattias Gaertner Assigned To => Mattias Gaertner
2019-02-23 16:49 Mattias Gaertner Status new => assigned
2019-02-23 16:54 Mattias Gaertner Assigned To Mattias Gaertner =>
2019-07-04 08:04 J. Gareth Moreton Assigned To => J. Gareth Moreton
2019-07-04 08:04 J. Gareth Moreton Status assigned => new
2019-07-04 08:04 J. Gareth Moreton FPCTarget => -
2019-07-04 08:04 J. Gareth Moreton Note Added: 0117055
2019-07-04 08:04 J. Gareth Moreton Assigned To J. Gareth Moreton =>