From cf3c1198ea27a5e7d8b7e80b19b758841f56ef90 Mon Sep 17 00:00:00 2001 From: peter Date: Wed, 23 Jun 2004 16:22:45 +0000 Subject: [PATCH] * include unit name in error messages when types are the same --- compiler/htypechk.pas | 15 +++++++---- compiler/ncnv.pas | 58 ++++++++++++++----------------------------- compiler/symtable.pas | 36 +++++++++++++++++---------- 3 files changed, 52 insertions(+), 57 deletions(-) diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index 352dbb7821..8b69e765ca 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -152,7 +152,7 @@ implementation cutils,verbose,globals, symtable, defutil,defcmp, - pass_1,nbas,ncnv,nld,nmem,ncal,nmat,nutils, + nbas,ncnv,nld,nmem,ncal,nmat,nutils, cgbase,procinfo ; @@ -1894,17 +1894,22 @@ implementation guess that it is a missing typeconv } if hp^.wrongpara.paratyp in [vs_var,vs_out] then CGMessagePos2(pt.fileinfo,parser_e_call_by_ref_without_typeconv, - pt.resulttype.def.typename,hp^.wrongpara.paratype.def.typename) + FullTypeName(pt.resulttype.def,hp^.wrongpara.paratype.def), + FullTypeName(hp^.wrongpara.paratype.def,pt.resulttype.def)) else - CGMessagePos3(pt.fileinfo,type_e_wrong_parameter_type, - tostr(hp^.wrongparanr),pt.resulttype.def.typename,hp^.wrongpara.paratype.def.typename); + CGMessagePos3(pt.fileinfo,type_e_wrong_parameter_type,tostr(hp^.wrongparanr), + FullTypeName(pt.resulttype.def,hp^.wrongpara.paratype.def), + FullTypeName(hp^.wrongpara.paratype.def,pt.resulttype.def)); end; end. { $Log$ - Revision 1.94 2004-06-20 08:55:29 florian + Revision 1.95 2004-06-23 16:22:45 peter + * include unit name in error messages when types are the same + + Revision 1.94 2004/06/20 08:55:29 florian * logs truncated Revision 1.93 2004/06/16 20:07:07 florian diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas index 504ea8873a..90e7a8e192 100644 --- a/compiler/ncnv.pas +++ b/compiler/ncnv.pas @@ -1362,7 +1362,9 @@ implementation { check if the types are related } if (not(tobjectdef(left.resulttype.def).is_related(tobjectdef(resulttype.def)))) and (not(tobjectdef(resulttype.def).is_related(tobjectdef(left.resulttype.def)))) then - CGMessage2(type_w_classes_not_related,left.resulttype.def.typename,resulttype.def.typename); + CGMessage2(type_w_classes_not_related, + FullTypeName(left.resulttype.def,resulttype.def), + FullTypeName(resulttype.def,left.resulttype.def)); end; end @@ -2257,7 +2259,9 @@ implementation { the operands must be related } if not(assigned(tobjectdef(left.resulttype.def).implementedinterfaces) and (tobjectdef(left.resulttype.def).implementedinterfaces.searchintf(right.resulttype.def)<>-1)) then - CGMessage2(type_e_classes_not_related,left.resulttype.def.typename,right.resulttype.def.typename); + CGMessage2(type_e_classes_not_related, + FullTypeName(left.resulttype.def,right.resulttype.def), + FullTypeName(right.resulttype.def,left.resulttype.def)) end { left is an interface } else if is_interface(left.resulttype.def) then @@ -2265,7 +2269,9 @@ implementation { the operands must be related } if (not(tobjectdef(left.resulttype.def).is_related(tobjectdef(right.resulttype.def)))) and (not(tobjectdef(right.resulttype.def).is_related(tobjectdef(left.resulttype.def)))) then - CGMessage2(type_e_classes_not_related,left.resulttype.def.typename,right.resulttype.def.typename); + CGMessage2(type_e_classes_not_related, + FullTypeName(left.resulttype.def,right.resulttype.def), + FullTypeName(right.resulttype.def,left.resulttype.def)); end else CGMessage1(type_e_class_type_expected,left.resulttype.def.typename); @@ -2342,8 +2348,9 @@ implementation tobjectdef(tclassrefdef(right.resulttype.def).pointertype.def)))) and (not(tobjectdef(tclassrefdef(right.resulttype.def).pointertype.def).is_related( tobjectdef(left.resulttype.def)))) then - CGMessage2(type_e_classes_not_related,left.resulttype.def.typename, - tclassrefdef(right.resulttype.def).pointertype.def.typename); + CGMessage2(type_e_classes_not_related, + FullTypeName(left.resulttype.def,tclassrefdef(right.resulttype.def).pointertype.def), + FullTypeName(tclassrefdef(right.resulttype.def).pointertype.def,left.resulttype.def)); end else CGMessage1(type_e_class_type_expected,left.resulttype.def.typename); @@ -2352,39 +2359,9 @@ implementation else if is_interface(right.resulttype.def) then begin { left is a class } - if is_class(left.resulttype.def) then - begin - { the operands must be related - no, because the class instance could be a child class of the current one which - implements additional interfaces (FK) - b:=false; - o:=tobjectdef(left.resulttype.def); - while assigned(o) do - begin - if assigned(o.implementedinterfaces) and - (o.implementedinterfaces.searchintf(right.resulttype.def)<>-1) then - begin - b:=true; - break; - end; - o:=o.childof; - end; - if not(b) then - CGMessage2(type_e_classes_not_related,left.resulttype.def.typename,right.resulttype.def.typename); - } - end - { left is an interface } - else if is_interface(left.resulttype.def) then - begin - { the operands must be related - we don't necessarily know how the both interfaces are implemented, so we can't do this check (FK) - if (not(tobjectdef(left.resulttype.def).is_related(tobjectdef(right.resulttype.def)))) and - (not(tobjectdef(right.resulttype.def).is_related(tobjectdef(left.resulttype.def)))) then - CGMessage2(type_e_classes_not_related,left.resulttype.def.typename,right.resulttype.def.typename); - } - end - else - CGMessage1(type_e_class_type_expected,left.resulttype.def.typename); + if not(is_class(left.resulttype.def) or + is_interface(left.resulttype.def)) then + CGMessage1(type_e_class_type_expected,left.resulttype.def.typename); resulttype:=right.resulttype; @@ -2463,7 +2440,10 @@ begin end. { $Log$ - Revision 1.149 2004-06-20 08:55:29 florian + Revision 1.150 2004-06-23 16:22:45 peter + * include unit name in error messages when types are the same + + Revision 1.149 2004/06/20 08:55:29 florian * logs truncated Revision 1.148 2004/06/16 20:07:08 florian diff --git a/compiler/symtable.pas b/compiler/symtable.pas index 1837f3c48e..3585d696a5 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -191,6 +191,7 @@ interface procedure globaldef(const s : string;var t:ttype); function findunitsymtable(st:tsymtable):tsymtable; procedure duplicatesym(sym:tsym); + function FullTypeName(def,otherdef:tdef):string; procedure incompatibletypes(def1,def2:tdef); {*** Search ***} @@ -1761,24 +1762,30 @@ implementation end; - procedure incompatibletypes(def1,def2:tdef); + function FullTypeName(def,otherdef:tdef):string; var s1,s2 : string; begin + s1:=def.typename; + { When the names are the same try to include the unit name } + if assigned(otherdef) and + (def.owner.symtabletype in [globalsymtable,staticsymtable]) then + begin + s2:=otherdef.typename; + if upper(s1)=upper(s2) then + s1:=def.owner.realname^+'.'+s1; + end; + FullTypeName:=s1; + end; + + + procedure incompatibletypes(def1,def2:tdef); + begin + { When there is an errordef there is already an error message show } if (def2.deftype=errordef) or (def1.deftype=errordef) then exit; - s1:=def1.typename; - s2:=def2.typename; - { When the names are the same try to include the unit name } - if upper(s1)=upper(s2) then - begin - if (def1.owner.symtabletype in [globalsymtable,staticsymtable]) then - s1:=def1.owner.realname^+'.'+s1; - if (def2.owner.symtabletype in [globalsymtable,staticsymtable]) then - s2:=def2.owner.realname^+'.'+s2; - end; - CGMessage2(type_e_incompatible_types,s1,s2); + CGMessage2(type_e_incompatible_types,FullTypeName(def1,def2),FullTypeName(def2,def1)); end; @@ -2325,7 +2332,10 @@ implementation end. { $Log$ - Revision 1.150 2004-06-20 08:55:30 florian + Revision 1.151 2004-06-23 16:22:45 peter + * include unit name in error messages when types are the same + + Revision 1.150 2004/06/20 08:55:30 florian * logs truncated Revision 1.149 2004/06/16 20:07:09 florian