diff --git a/compiler/finput.pas b/compiler/finput.pas index 36eca6cf37..8c7ab867d2 100644 --- a/compiler/finput.pas +++ b/compiler/finput.pas @@ -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; diff --git a/compiler/scanner.pas b/compiler/scanner.pas index 4da811acfb..61af7d541b 100644 --- a/compiler/scanner.pas +++ b/compiler/scanner.pas @@ -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; diff --git a/compiler/symcreat.pas b/compiler/symcreat.pas index 99dcf4b02c..a255081b80 100644 --- a/compiler/symcreat.pas +++ b/compiler/symcreat.pas @@ -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;'; diff --git a/compiler/symtable.pas b/compiler/symtable.pas index 31ae536c0e..63d75a448b 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -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