View Issue Details
| ID | Project | Category | View Status | Date Submitted | Last Update |
|---|---|---|---|---|---|
| 0025536 | FPC | Compiler | public | 2014-01-14 21:17 | 2019-07-04 08:04 |
| Reporter | Dennis Fehr | Assigned To | |||
| Priority | normal | Severity | minor | Reproducibility | N/A |
| Status | new | Resolution | open | ||
| Product Version | 2.7.1 | Product Build | |||
| Target Version | Fixed in Version | ||||
| Summary | 0025536: Patch for {$INCLUDESTRINGFILE file} | ||||
| Description | This is a patch to include {$INCLUDESTRINGFILE file} directive. | ||||
| Tags | No tags attached. | ||||
| Fixed in Revision | |||||
| FPCOldBugId | |||||
| FPCTarget | - | ||||
| Attached Files |
| ||||
| has duplicate | 0021848 | resolved | Jonas Maebe | Implemented HEREDOC |
| has duplicate | 0015560 | resolved | Jonas Maebe | [patch] New $IncludeString directive |
|
|
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);
|
|
|
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). |
|
|
Why do your read in one byte less than the file size? |
|
|
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);
|
|
|
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 |
|
|
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). |
|
|
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 |
|
|
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
===================================================================
|
|
|
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) |
|
|
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. |
|
|
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. |
|
|
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. |
|
|
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. |
|
|
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. |
|
|
@Jonas, can you give me an example from my test-case to throw it off? |
|
|
Changed status back to "New" since it was assigned to no-one. |
| 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 => |
