paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 10:07:54 +02:00
Code Issues Packages Projects Releases Wiki Activity

symcreat: support for scanner/parser escape sequences

Browse Source 
Support escape sequences when parsing internally generated code. Used for now
to force interpreting certain identifiers as unit/namespace identifiers.
This commit is contained in:
Jonas Maebe 2022-09-11 21:24:00 +02:00
parent e746cf96da
commit b0e1867b4c
4 changed files with 70 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
compiler/finput.pas
View File

@ -41,10 +41,6 @@ interface
inc_path : TPathStr; { path if file was included with $I directive }
next : tinputfile; { next file for reading }
is_macro,
endoffile, { still bytes left to read }
closed : boolean; { is the file closed }
buf : pchar; { buffer }
bufstart, { buffer start position in the file }
bufsize, { amount of bytes in the buffer }
@ -60,6 +56,14 @@ interface
ref_index : longint;
ref_next : tinputfile;
is_macro,
endoffile, { still bytes left to read }
closed : boolean; { is the file closed }
{ this file represents an internally generated macro. Enables
certain escape sequences }
internally_generated_macro: boolean;
constructor create(const fn:TPathStr);
destructor destroy;override;
procedure setpos(l:longint);
@ -206,10 +210,6 @@ uses
inc_path:='';
next:=nil;
filetime:=-1;
{ file info }
is_macro:=false;
endoffile:=false;
closed:=true;
buf:=nil;
bufstart:=0;
bufsize:=0;
@ -224,6 +224,11 @@ uses
{ line buffer }
linebuf:=nil;
maxlinebuf:=0;
{ file info }
is_macro:=false;
endoffile:=false;
closed:=true;
internally_generated_macro:=false;
end;

44
compiler/scanner.pas
View File

@ -37,6 +37,15 @@ interface
max_macro_nesting=16;
preprocbufsize=32*1024;
{ when parsing an internally generated macro, if an identifier is
prefixed with this constant then it will always be interpreted as a
unit name (to avoid clashes with user-specified parameter or field
names duplicated in internally generated code) }
internal_macro_escape_unit_namespace_name = #1;
internal_macro_escape_begin = internal_macro_escape_unit_namespace_name;
internal_macro_escape_end = internal_macro_escape_unit_namespace_name;
type
tcommentstyle = (comment_none,comment_tp,comment_oldtp,comment_delphi,comment_c);
@ -168,7 +177,7 @@ interface
procedure addfile(hp:tinputfile);
procedure reload;
{ replaces current token with the text in p }
procedure substitutemacro(const macname:string;p:pchar;len,line,fileindex:longint);
procedure substitutemacro(const macname:string;p:pchar;len,line,fileindex:longint;internally_generated: boolean);
{ Scanner things }
procedure gettokenpos;
procedure inc_comment_level;
@ -2645,7 +2654,7 @@ type
if macroIsString then
hs:=''''+hs+'''';
current_scanner.substitutemacro(path,@hs[1],length(hs),
current_scanner.line_no,current_scanner.inputfile.ref_index);
current_scanner.line_no,current_scanner.inputfile.ref_index,false);
end
else
begin
@ -3713,7 +3722,7 @@ type
end;
procedure tscannerfile.substitutemacro(const macname:string;p:pchar;len,line,fileindex:longint);
procedure tscannerfile.substitutemacro(const macname:string;p:pchar;len,line,fileindex:longint;internally_generated: boolean);
var
hp : tinputfile;
begin
@ -3733,6 +3742,7 @@ type
inputpointer:=buf;
inputstart:=bufstart;
ref_index:=fileindex;
internally_generated_macro:=internally_generated;
end;
{ reset line }
line_no:=line;
@ -4187,6 +4197,26 @@ type
end;
#0 :
reload;
else if inputfile.internally_generated_macro and
(c in [internal_macro_escape_begin..internal_macro_escape_end]) then
begin
if i<255 then
begin
inc(i);
orgpattern[i]:=c;
pattern[i]:=c;
end
else
begin
if not err then
begin
Message(scan_e_string_exceeds_255_chars);
err:=true;
end;
end;
c:=inputpointer^;
inc(inputpointer);
end
else
break;
end;
@ -4904,7 +4934,7 @@ type
mac.is_used:=true;
inc(yylexcount);
substitutemacro(pattern,mac.buftext,mac.buflen,
mac.fileinfo.line,mac.fileinfo.fileindex);
mac.fileinfo.line,mac.fileinfo.fileindex,false);
{ handle empty macros }
if c=#0 then
begin
@ -5586,6 +5616,12 @@ type
checkpreprocstack;
goto exit_label;
end;
else if inputfile.internally_generated_macro and
(c in [internal_macro_escape_begin..internal_macro_escape_end]) then
begin
token:=_ID;
readstring;
end
else
Illegal_Char(c);
end;

10
compiler/symcreat.pas
View File

@ -201,7 +201,7 @@ implementation
current_scanner.closeinputfile;
{ inject the string in the scanner }
str:=str+'end;';
current_scanner.substitutemacro('meth_head_macro',@str[1],length(str),current_scanner.line_no,current_scanner.inputfile.ref_index);
current_scanner.substitutemacro('meth_head_macro',@str[1],length(str),current_scanner.line_no,current_scanner.inputfile.ref_index,true);
current_scanner.readtoken(false);
{ and parse it... }
case potype of
@ -254,7 +254,7 @@ implementation
{ "const" starts a new kind of block and hence makes the scanner return }
str:=str+'const;';
{ inject the string in the scanner }
current_scanner.substitutemacro('meth_impl_macro',@str[1],length(str),lineno,fileno);
current_scanner.substitutemacro('meth_impl_macro',@str[1],length(str),lineno,fileno,true);
current_scanner.readtoken(false);
{ and parse it... }
flags:=[];
@ -289,7 +289,7 @@ implementation
old_block_type:=block_type;
parse_only:=true;
block_type:=bt_const;
current_scanner.substitutemacro('typed_const_macro',@str[1],length(str),current_scanner.line_no,current_scanner.inputfile.ref_index);
current_scanner.substitutemacro('typed_const_macro',@str[1],length(str),current_scanner.line_no,current_scanner.inputfile.ref_index,true);
current_scanner.readtoken(false);
read_typed_const(list,ssym,ssym.owner.symtabletype in [recordsymtable,objectsymtable]);
parse_only:=old_parse_only;
@ -310,7 +310,7 @@ implementation
if not assigned(def.owner.defowner) and
assigned(def.owner.realname) and
(def.owner.moduleid<>0) then
result:=def.owner.realname^+'.';
result:=internal_macro_escape_unit_namespace_name+def.owner.realname^+'.';
end;
@ -496,7 +496,7 @@ implementation
begin
fsym:=tfieldvarsym(sym);
if fsym.vardef.needs_inittable then
str:=str+'system.initialize(&'+fsym.realname+');';
str:=str+(internal_macro_escape_unit_namespace_name+'system.initialize(&')+fsym.realname+');';
end;
end;
str:=str+'end;';

15
compiler/symtable.pas
View File

@ -311,7 +311,8 @@ interface
ssf_search_option,
ssf_search_helper,
ssf_has_inherited,
ssf_no_addsymref
ssf_no_addsymref,
ssf_unit_or_namespace_only
);
tsymbol_search_flags = set of tsymbol_search_flag;
@ -3402,7 +3403,12 @@ implementation
function searchsym(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
begin
result:=searchsym_maybe_with_symoption(s,srsym,srsymtable,[],sp_none);
case s[1] of
internal_macro_escape_unit_namespace_name:
result:=searchsym_maybe_with_symoption(copy(s,2,length(s)-1),srsym,srsymtable,[ssf_unit_or_namespace_only],sp_none)
else
result:=searchsym_maybe_with_symoption(s,srsym,srsymtable,[],sp_none);
end
end;
@ -3424,7 +3430,8 @@ implementation
while assigned(stackitem) do
begin
srsymtable:=stackitem^.symtable;
if (srsymtable.symtabletype=objectsymtable) then
if not(ssf_unit_or_namespace_only in flags) and
(srsymtable.symtabletype=objectsymtable) then
begin
{ TODO : implement the search for an option in classes as well }
if ssf_search_option in flags then
@ -3446,6 +3453,8 @@ implementation
They are visible only if they are from the current unit or
unit of generic of currently processed specialization. }
if assigned(srsym) and
(not(ssf_unit_or_namespace_only in flags) or
(srsym.typ in [unitsym,namespacesym])) and
(
not(srsym.typ in [unitsym,namespacesym]) or
srsymtable.iscurrentunit or