paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-11 14:55:01 +01:00
Code Issues Packages Projects Releases Wiki Activity

* tprocdef.fullprocname added for better casesensitve writing of

Browse Source 
procedures
This commit is contained in:
peter 2000-11-01 23:04:37 +00:00
parent 850e8de88b
commit 5115083270
7 changed files with 73 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
compiler/hcgdata.pas
View File

@ -555,16 +555,17 @@ implementation
{ warn only if it is the first time, { warn only if it is the first time,
we hide the method } we hide the method }
if _c=hp^._class then if _c=hp^._class then
Message1(parser_w_should_use_override,_c^.objname^+'.'+_name); Message1(parser_w_should_use_override,hp^.fullprocname);
end end
else else
if _c=hp^._class then if _c=hp^._class then
begin begin
if (po_virtualmethod in procdefcoll^.data^.procoptions) then if (po_virtualmethod in procdefcoll^.data^.procoptions) then
Message1(parser_w_overloaded_are_not_both_virtual,_c^.objname^+'.'+_name) Message1(parser_w_overloaded_are_not_both_virtual,
hp^.fullprocname)
else else
Message1(parser_w_overloaded_are_not_both_non_virtual, Message1(parser_w_overloaded_are_not_both_non_virtual,
_c^.objname^+'.'+_name); hp^.fullprocname);
end; end;
{ was newentry; exit; (FK) } { was newentry; exit; (FK) }
newdefentry; newdefentry;
@ -579,7 +580,7 @@ implementation
((procdefcoll^.data^.procoptions- ((procdefcoll^.data^.procoptions-
[po_abstractmethod,po_overridingmethod,po_assembler])<> [po_abstractmethod,po_overridingmethod,po_assembler])<>
(hp^.procoptions-[po_abstractmethod,po_overridingmethod,po_assembler])) then (hp^.procoptions-[po_abstractmethod,po_overridingmethod,po_assembler])) then
Message1(parser_e_header_dont_match_forward,_c^.objname^+'.'+_name); Message1(parser_e_header_dont_match_forward,hp^.fullprocname);
{ check, if the overridden directive is set } { check, if the overridden directive is set }
{ (povirtualmethod is set! } { (povirtualmethod is set! }
@ -591,7 +592,7 @@ implementation
{ warn only if it is the first time, { warn only if it is the first time,
we hide the method } we hide the method }
if _c=hp^._class then if _c=hp^._class then
Message1(parser_w_should_use_override,_c^.objname^+'.'+_name); Message1(parser_w_should_use_override,hp^.fullprocname);
{ was newentry; (FK) } { was newentry; (FK) }
newdefentry; newdefentry;
exit; exit;
@ -605,7 +606,7 @@ implementation
(pobjectdef(hp^.rettype.def)^.is_class) and (pobjectdef(hp^.rettype.def)^.is_class) and
(pobjectdef(hp^.rettype.def)^.is_related( (pobjectdef(hp^.rettype.def)^.is_related(
pobjectdef(procdefcoll^.data^.rettype.def)))) then pobjectdef(procdefcoll^.data^.rettype.def)))) then
Message1(parser_e_overloaded_methodes_not_same_ret,_c^.objname^+'.'+_name); Message1(parser_e_overloaded_methodes_not_same_ret,hp^.fullprocname);
{ now set the number } { now set the number }
@ -635,7 +636,7 @@ implementation
{ check, if a method should be overridden } { check, if a method should be overridden }
if (po_overridingmethod in hp^.procoptions) then if (po_overridingmethod in hp^.procoptions) then
MessagePos1(hp^.fileinfo,parser_e_nothing_to_be_overridden, MessagePos1(hp^.fileinfo,parser_e_nothing_to_be_overridden,
_c^.objname^+'.'+_name+hp^.demangled_paras); hp^.fullprocname);
end; end;
handlenextdef: handlenextdef:
hp:=hp^.nextoverloaded; hp:=hp^.nextoverloaded;
@ -1039,7 +1040,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.8 2000-10-31 22:02:47 peter Revision 1.9 2000-11-01 23:04:37 peter
* tprocdef.fullprocname added for better casesensitve writing of
procedures
Revision 1.8 2000/10/31 22:02:47 peter
* symtable splitted, no real code changes * symtable splitted, no real code changes
Revision 1.7 2000/10/14 10:14:47 peter Revision 1.7 2000/10/14 10:14:47 peter

18
compiler/pdecsub.pas
View File

@ -452,7 +452,7 @@ begin
if aktprocsym^.typ<>procsym then if aktprocsym^.typ<>procsym then
begin begin
if (m_fpc in aktmodeswitches) then if (m_fpc in aktmodeswitches) then
Message1(parser_e_overloaded_no_procedure,aktprocsym^.name) Message1(parser_e_overloaded_no_procedure,aktprocsym^.realname)
else else
DuplicateSym(aktprocsym); DuplicateSym(aktprocsym);
{ try to recover by creating a new aktprocsym } { try to recover by creating a new aktprocsym }
@ -1019,7 +1019,7 @@ begin
begin begin
{ external shouldn't override the cdecl/system name } { external shouldn't override the cdecl/system name }
if not (pocall_clearstack in aktprocsym^.definition^.proccalloptions) then if not (pocall_clearstack in aktprocsym^.definition^.proccalloptions) then
aktprocsym^.definition^.setmangledname(aktprocsym^.name); aktprocsym^.definition^.setmangledname(aktprocsym^.realname);
end; end;
end; end;
end; end;
@ -1580,7 +1580,7 @@ begin
(aktprocsym^.definition^.maxparacount>0)) then (aktprocsym^.definition^.maxparacount>0)) then
begin begin
MessagePos1(aktprocsym^.definition^.fileinfo,parser_e_header_dont_match_forward, MessagePos1(aktprocsym^.definition^.fileinfo,parser_e_header_dont_match_forward,
aktprocsym^.declarationstr(aktprocsym^.definition)); aktprocsym^.definition^.fullprocname);
exit; exit;
end; end;
if hd^.forwarddef then if hd^.forwarddef then
@ -1593,7 +1593,7 @@ begin
(m_repeat_forward in aktmodeswitches)) then (m_repeat_forward in aktmodeswitches)) then
begin begin
MessagePos1(aktprocsym^.definition^.fileinfo,parser_e_header_dont_match_forward, MessagePos1(aktprocsym^.definition^.fileinfo,parser_e_header_dont_match_forward,
aktprocsym^.declarationstr(aktprocsym^.definition)); aktprocsym^.definition^.fullprocname);
exit; exit;
end; end;
{ Check calling convention, no check for internconst,internproc which { Check calling convention, no check for internconst,internproc which
@ -1649,7 +1649,7 @@ begin
begin begin
MessagePos1(aktprocsym^.definition^.fileinfo, MessagePos1(aktprocsym^.definition^.fileinfo,
parser_e_function_already_declared_public_forward, parser_e_function_already_declared_public_forward,
aktprocsym^.declarationstr(aktprocsym^.definition)); aktprocsym^.definition^.fullprocname);
check_identical_proc:=true; check_identical_proc:=true;
{ Remove other forward from the list to reduce errors } { Remove other forward from the list to reduce errors }
pd^.nextoverloaded:=pd^.nextoverloaded^.nextoverloaded; pd^.nextoverloaded:=pd^.nextoverloaded^.nextoverloaded;
@ -1736,7 +1736,7 @@ begin
not((po_overload in aktprocsym^.definition^.procoptions) and not((po_overload in aktprocsym^.definition^.procoptions) and
((po_overload in hd^.procoptions))) then ((po_overload in hd^.procoptions))) then
begin begin
MessagePos1(aktprocsym^.definition^.fileinfo,parser_e_no_overload_for_all_procs,aktprocsym^.name); MessagePos1(aktprocsym^.definition^.fileinfo,parser_e_no_overload_for_all_procs,aktprocsym^.realname);
break; break;
end; end;
end end
@ -1815,7 +1815,11 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.4 2000-10-31 22:02:49 peter Revision 1.5 2000-11-01 23:04:37 peter
* tprocdef.fullprocname added for better casesensitve writing of
procedures
Revision 1.4 2000/10/31 22:02:49 peter
* symtable splitted, no real code changes * symtable splitted, no real code changes
Revision 1.3 2000/10/21 18:16:11 florian Revision 1.3 2000/10/21 18:16:11 florian

8
compiler/pmodules.pas
View File

@ -617,6 +617,8 @@ implementation
{$endif SHORT_ON_FILE_HANDLES} {$endif SHORT_ON_FILE_HANDLES}
current_ppu:=old_current_ppu; current_ppu:=old_current_ppu;
current_module:=old_current_module; current_module:=old_current_module;
{ we are back }
SetCompileModule(current_module);
loadunit:=hp; loadunit:=hp;
end; end;
@ -1695,7 +1697,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.17 2000-10-31 22:02:50 peter Revision 1.18 2000-11-01 23:04:37 peter
* tprocdef.fullprocname added for better casesensitve writing of
procedures
Revision 1.17 2000/10/31 22:02:50 peter
* symtable splitted, no real code changes * symtable splitted, no real code changes
Revision 1.16 2000/10/21 14:36:26 peter Revision 1.16 2000/10/21 14:36:26 peter

12
compiler/psub.pas
View File

@ -628,7 +628,7 @@ implementation
if assigned(procinfo^._class) and (not assigned(oldprocinfo^._class)) then if assigned(procinfo^._class) and (not assigned(oldprocinfo^._class)) then
begin begin
Message1(parser_e_header_dont_match_any_member, Message1(parser_e_header_dont_match_any_member,
aktprocsym^.declarationstr(aktprocsym^.definition)); aktprocsym^.definition^.fullprocname);
aktprocsym^.write_parameter_lists(aktprocsym^.definition); aktprocsym^.write_parameter_lists(aktprocsym^.definition);
end end
else else
@ -642,7 +642,7 @@ implementation
not(assigned(aktprocsym^.definition^.nextoverloaded^.nextoverloaded)) then not(assigned(aktprocsym^.definition^.nextoverloaded^.nextoverloaded)) then
begin begin
Message1(parser_e_header_dont_match_forward, Message1(parser_e_header_dont_match_forward,
aktprocsym^.declarationstr(aktprocsym^.definition)); aktprocsym^.definition^.fullprocname);
aktprocsym^.write_parameter_lists(aktprocsym^.definition); aktprocsym^.write_parameter_lists(aktprocsym^.definition);
end end
else else
@ -690,7 +690,7 @@ implementation
if (pdflags and pd_body)<>0 then if (pdflags and pd_body)<>0 then
begin begin
Message1(parser_p_procedure_start, Message1(parser_p_procedure_start,
aktprocsym^.declarationstr(aktprocsym^.definition)); aktprocsym^.definition^.fullprocname);
names^.insert(aktprocsym^.definition^.mangledname); names^.insert(aktprocsym^.definition^.mangledname);
{ set _FAIL as keyword if constructor } { set _FAIL as keyword if constructor }
if (aktprocsym^.definition^.proctypeoption=potype_constructor) then if (aktprocsym^.definition^.proctypeoption=potype_constructor) then
@ -832,7 +832,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.20 2000-10-31 22:02:50 peter Revision 1.21 2000-11-01 23:04:38 peter
* tprocdef.fullprocname added for better casesensitve writing of
procedures
Revision 1.20 2000/10/31 22:02:50 peter
* symtable splitted, no real code changes * symtable splitted, no real code changes
Revision 1.19 2000/10/24 22:21:25 peter Revision 1.19 2000/10/24 22:21:25 peter

54
compiler/symdef.pas
View File

@ -473,9 +473,7 @@ interface
procedure setmangledname(const s : string); procedure setmangledname(const s : string);
procedure load_references; procedure load_references;
function write_references : boolean; function write_references : boolean;
{$ifdef dummy} function fullprocname:string;
function procname: string;
{$endif dummy}
function cplusplusmangledname : string; function cplusplusmangledname : string;
{ debug } { debug }
{$ifdef GDB} {$ifdef GDB}
@ -3170,7 +3168,7 @@ implementation
while assigned(hp) do while assigned(hp) do
begin begin
if assigned(hp^.paratype.def^.typesym) then if assigned(hp^.paratype.def^.typesym) then
s:=s+hp^.paratype.def^.typesym^.name s:=s+hp^.paratype.def^.typesym^.realname
else if hp^.paratyp=vs_var then else if hp^.paratyp=vs_var then
s:=s+'var' s:=s+'var'
else if hp^.paratyp=vs_const then else if hp^.paratyp=vs_const then
@ -3377,6 +3375,19 @@ implementation
is_used:=false; is_used:=false;
end; end;
function tprocdef.fullprocname:string;
var
s : string;
begin
s:='';
if assigned(_class) then
s:=_class^.objname^+'.';
s:=s+procsym^.realname+demangled_paras;
fullprocname:=s;
end;
function tprocdef.getsymtable(t:tgetsymtable):psymtable; function tprocdef.getsymtable(t:tgetsymtable):psymtable;
begin begin
case t of case t of
@ -3721,35 +3732,6 @@ Const local_symtable_index : longint = $8001;
end; end;
{$ifdef dummy}
function tprocdef.procname: string;
var
s : string;
l : longint;
begin
s:=mangledname;
{ delete leading $$'s }
l:=pos('$$',s);
while l<>0 do
begin
delete(s,1,l+1);
l:=pos('$$',s);
end;
{ delete leading _$'s }
l:=pos('_$',s);
while l<>0 do
begin
delete(s,1,l+1);
l:=pos('_$',s);
end;
l:=pos('$',s);
if l=0 then
procname:=s
else
procname:=Copy(s,1,l-1);
end;
{$endif}
function tprocdef.cplusplusmangledname : string; function tprocdef.cplusplusmangledname : string;
function getcppparaname(p : pdef) : string; function getcppparaname(p : pdef) : string;
@ -5099,7 +5081,11 @@ Const local_symtable_index : longint = $8001;
end. end.
{ {
$Log$ $Log$
Revision 1.1 2000-10-31 22:02:52 peter Revision 1.2 2000-11-01 23:04:38 peter
* tprocdef.fullprocname added for better casesensitve writing of
procedures
Revision 1.1 2000/10/31 22:02:52 peter
* symtable splitted, no real code changes * symtable splitted, no real code changes
} }

24
compiler/symsym.pas
View File

@ -109,8 +109,7 @@ interface
constructor load; constructor load;
destructor done;virtual; destructor done;virtual;
function mangledname : string;virtual; function mangledname : string;virtual;
function declarationstr(p : pprocdef):string; { writes all declarations except the specified one }
{ writes all declarations }
procedure write_parameter_lists(skipdef:pprocdef); procedure write_parameter_lists(skipdef:pprocdef);
{ tests, if all procedures definitions are defined and not } { tests, if all procedures definitions are defined and not }
{ only forward } { only forward }
@ -703,12 +702,6 @@ implementation
end; end;
function tprocsym.declarationstr(p : pprocdef):string;
begin
declarationstr:=realname+p^.demangled_paras;
end;
procedure tprocsym.write_parameter_lists(skipdef:pprocdef); procedure tprocsym.write_parameter_lists(skipdef:pprocdef);
var var
p : pprocdef; p : pprocdef;
@ -717,7 +710,7 @@ implementation
while assigned(p) do while assigned(p) do
begin begin
if p<>skipdef then if p<>skipdef then
MessagePos1(p^.fileinfo,sym_b_param_list,name+p^.demangled_paras); MessagePos1(p^.fileinfo,sym_b_param_list,p^.fullprocname);
p:=p^.nextoverloaded; p:=p^.nextoverloaded;
end; end;
end; end;
@ -732,10 +725,7 @@ implementation
begin begin
if pd^.forwarddef then if pd^.forwarddef then
begin begin
if assigned(pd^._class) then MessagePos1(fileinfo,sym_e_forward_not_resolved,pd^.fullprocname);
MessagePos1(fileinfo,sym_e_forward_not_resolved,pd^._class^.objname^+'.'+declarationstr(pd))
else
MessagePos1(fileinfo,sym_e_forward_not_resolved,declarationstr(pd));
{ Turn futher error messages off } { Turn futher error messages off }
pd^.forwarddef:=false; pd^.forwarddef:=false;
end; end;
@ -1718,11 +1708,9 @@ implementation
(sp_static in symoptions) then (sp_static in symoptions) then
begin begin
if (cs_gdb_gsym in aktglobalswitches) then st := 'G'+st else st := 'S'+st; if (cs_gdb_gsym in aktglobalswitches) then st := 'G'+st else st := 'S'+st;
{$ifndef Delphi}
stabstring := strpnew('"'+owner^.name^+'__'+name+':'+st+ stabstring := strpnew('"'+owner^.name^+'__'+name+':'+st+
'",'+ '",'+
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname); tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
{$endif}
end end
else if (owner^.symtabletype = globalsymtable) or else if (owner^.symtabletype = globalsymtable) or
(owner^.symtabletype = unitsymtable) then (owner^.symtabletype = unitsymtable) then
@ -2476,7 +2464,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.1 2000-10-31 22:02:52 peter Revision 1.2 2000-11-01 23:04:38 peter
* tprocdef.fullprocname added for better casesensitve writing of
procedures
Revision 1.1 2000/10/31 22:02:52 peter
* symtable splitted, no real code changes * symtable splitted, no real code changes
} }

8
compiler/symtable.pas
View File

@ -2353,7 +2353,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.12 2000-10-31 22:02:52 peter Revision 1.13 2000-11-01 23:04:38 peter
* tprocdef.fullprocname added for better casesensitve writing of
procedures
Revision 1.12 2000/10/31 22:02:52 peter
* symtable splitted, no real code changes * symtable splitted, no real code changes
} }