From 3597696e9827b40db75734a137e153da6422a397 Mon Sep 17 00:00:00 2001 From: svenbarth Date: Sun, 29 Nov 2020 15:47:52 +0000 Subject: [PATCH] * fix for Mantis #38145: allow overloading of assignment operators that return ShortStrings with a specific size + added tests The following rules for using these operator overloads as *implicit* overloads apply (Delphi compatible): - if a found assignment operator returns a default ShortString then that is used - if only one assignment operator to a String[x] is found then that is used - otherwise the assignment is not possible The explicit assignment checks for an exact match (and falls back for an implicit assignment). This is not entirely Delphi compatible as Delphi seems to favor the first found symbol in that case, but sometimes also not... :/ git-svn-id: trunk@47634 - --- .gitattributes | 7 +++ compiler/htypechk.pas | 12 +---- compiler/symsym.pas | 30 +++++++++-- compiler/symtable.pas | 33 +++++++++++- tests/test/toperator91.pp | 104 ++++++++++++++++++++++++++++++++++++++ tests/test/toperator92.pp | 33 ++++++++++++ tests/test/toperator93.pp | 27 ++++++++++ tests/test/toperator94.pp | 66 ++++++++++++++++++++++++ tests/test/toperator95.pp | 29 +++++++++++ tests/webtbs/tw38145a.pp | 29 +++++++++++ tests/webtbs/tw38145b.pp | 28 ++++++++++ 11 files changed, 381 insertions(+), 17 deletions(-) create mode 100644 tests/test/toperator91.pp create mode 100644 tests/test/toperator92.pp create mode 100644 tests/test/toperator93.pp create mode 100644 tests/test/toperator94.pp create mode 100644 tests/test/toperator95.pp create mode 100644 tests/webtbs/tw38145a.pp create mode 100644 tests/webtbs/tw38145b.pp diff --git a/.gitattributes b/.gitattributes index fa90ab925f..146c631f3b 100644 --- a/.gitattributes +++ b/.gitattributes @@ -15581,6 +15581,11 @@ tests/test/toperator88.pp svneol=native#text/pascal tests/test/toperator89.pp svneol=native#text/pascal tests/test/toperator9.pp svneol=native#text/pascal tests/test/toperator90.pp svneol=native#text/pascal +tests/test/toperator91.pp svneol=native#text/pascal +tests/test/toperator92.pp svneol=native#text/pascal +tests/test/toperator93.pp svneol=native#text/pascal +tests/test/toperator94.pp svneol=native#text/pascal +tests/test/toperator95.pp svneol=native#text/pascal tests/test/toperatorerror.pp svneol=native#text/plain tests/test/tover1.pp svneol=native#text/plain tests/test/tover2.pp svneol=native#text/plain @@ -18592,6 +18597,8 @@ tests/webtbs/tw38074.pp svneol=native#text/pascal tests/webtbs/tw38083.pp svneol=native#text/pascal tests/webtbs/tw38122.pp svneol=native#text/pascal tests/webtbs/tw3814.pp svneol=native#text/plain +tests/webtbs/tw38145a.pp svneol=native#text/pascal +tests/webtbs/tw38145b.pp svneol=native#text/pascal tests/webtbs/tw3827.pp svneol=native#text/plain tests/webtbs/tw3829.pp svneol=native#text/plain tests/webtbs/tw3833.pp svneol=native#text/plain diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index a3a0b532d5..0ab2cb3595 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -673,17 +673,7 @@ implementation eq:=compare_defs_ext(ld,pf.returndef,nothingn,conv,pd,cdo); result:= (eq=te_exact) or - ( - (eq=te_incompatible) and - { don't allow overloading assigning to custom shortstring - types, because we also don't want to differentiate based - on different shortstring types (e.g., - "operator :=(const v: variant) res: shorstring" also - has to work for assigning a variant to a string[80]) - } - (not is_shortstring(pf.returndef) or - (tstringdef(pf.returndef).len=255)) - ); + (eq=te_incompatible); end else { enumerator is a special case too } diff --git a/compiler/symsym.pas b/compiler/symsym.pas index a83343dab4..b33a561b10 100644 --- a/compiler/symsym.pas +++ b/compiler/symsym.pas @@ -151,7 +151,7 @@ interface function find_procdef_bytype_and_para(pt:Tproctypeoption;para:TFPObjectList;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef; function find_procdef_byoptions(ops:tprocoptions): Tprocdef; function find_procdef_byprocvardef(d:Tprocvardef):Tprocdef; - function find_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef; + function find_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype;isexplicit:boolean):Tprocdef; function find_procdef_enumerator_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef; property ProcdefList:TFPObjectList read FProcdefList; end; @@ -1214,7 +1214,7 @@ implementation end; - function Tprocsym.Find_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef; + function Tprocsym.Find_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype;isexplicit:boolean):Tprocdef; var paraidx, realparamcount, i, j : longint; @@ -1223,12 +1223,22 @@ implementation pd : tprocdef; convtyp : tconverttype; eq : tequaltype; + shortstringcount : longint; + checkshortstring, + isgenshortstring : boolean; begin { This function will return the pprocdef of pprocsym that is the best match for fromdef and todef. } result:=nil; bestpd:=nil; besteq:=te_incompatible; + { special handling for assignment operators overloads to shortstring: + for implicit assignment we pick the ShortString one if available and + only pick one with specific length if it is the *only* one } + shortstringcount:=0; + checkshortstring:=not isexplicit and + is_shortstring(todef) and + (tstringdef(todef).len<>255); for i:=0 to ProcdefList.Count-1 do begin pd:=tprocdef(ProcdefList[i]); @@ -1236,7 +1246,7 @@ implementation continue; if (equal_defs(todef,pd.returndef) or { shortstrings of different lengths are ok as result } - (is_shortstring(todef) and is_shortstring(pd.returndef))) and + (not isexplicit and is_shortstring(todef) and is_shortstring(pd.returndef))) and { the result type must be always really equal and not an alias, if you mess with this code, check tw4093 } ((todef=pd.returndef) or @@ -1270,7 +1280,14 @@ implementation (df_unique in tparavarsym(pd.paras[paraidx]).vardef.defoptions)) then eq:=te_convert_l1; - if eq=te_exact then + isgenshortstring:=false; + if checkshortstring and is_shortstring(pd.returndef) then + if tstringdef(pd.returndef).len<>255 then + inc(shortstringcount) + else + isgenshortstring:=true; + + if (eq=te_exact) and (not checkshortstring or isgenshortstring) then begin besteq:=eq; result:=pd; @@ -1284,6 +1301,11 @@ implementation end; end; end; + if checkshortstring and (shortstringcount>1) then + begin + besteq:=te_incompatible; + bestpd:=nil; + end; result:=bestpd; end; diff --git a/compiler/symtable.pas b/compiler/symtable.pas index f27efe4fbe..e581546712 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -3969,11 +3969,21 @@ implementation currpd, bestpd : tprocdef; stackitem : psymtablestackitem; + shortstringcount : longint; + isexplicit, + checkshortstring : boolean; begin hashedid.id:=overloaded_names[assignment_type]; besteq:=te_incompatible; bestpd:=nil; stackitem:=symtablestack.stack; + { special handling for assignments to shortstrings with a specific length: + - if we get an operator to ShortString we use that + - if we get only a single String[x] operator we use that + - otherwise it's a nogo } + isexplicit:=assignment_type=_OP_EXPLICIT; + shortstringcount:=0; + checkshortstring:=not isexplicit and is_shortstring(to_def) and (tstringdef(to_def).len<>255); while assigned(stackitem) do begin sym:=Tprocsym(stackitem^.symtable.FindWithHash(hashedid)); @@ -3983,17 +3993,36 @@ implementation internalerror(200402031); { if the source type is an alias then this is only the second choice, if you mess with this code, check tw4093 } - currpd:=sym.find_procdef_assignment_operator(from_def,to_def,curreq); + currpd:=sym.find_procdef_assignment_operator(from_def,to_def,curreq,isexplicit); + { we found a ShortString overload, use that and be done } + if checkshortstring and + assigned(currpd) and + is_shortstring(currpd.returndef) and + (tstringdef(currpd.returndef).len=255) then + begin + besteq:=curreq; + bestpd:=currpd; + break; + end; + { independently of the operator being better count if we encountered + multpile String[x] operators } + if checkshortstring and assigned(currpd) and is_shortstring(currpd.returndef) then + inc(shortstringcount); if curreq>besteq then begin besteq:=curreq; bestpd:=currpd; - if (besteq=te_exact) then + { don't stop searching if we have a String[x] operator cause + we might find a ShortString one or multiple ones (which + leads to no operator use) } + if (besteq=te_exact) and not checkshortstring then break; end; end; stackitem:=stackitem^.next; end; + if checkshortstring and (shortstringcount>1) then + bestpd:=nil; result:=bestpd; end; diff --git a/tests/test/toperator91.pp b/tests/test/toperator91.pp new file mode 100644 index 0000000000..d7d0496abb --- /dev/null +++ b/tests/test/toperator91.pp @@ -0,0 +1,104 @@ +program toperator91; + +{$mode delphi} + +type + TString80 = String[80]; + TString90 = String[90]; + TString40 = String[40]; + TString100 = String[100]; + + TTest = record + class operator Explicit(const aArg: TTest): TString80; + class operator Explicit(const aArg: TTest): TString90; + class operator Explicit(const aArg: TTest): ShortString; + class operator Implicit(const aArg: TTest): TString80; + class operator Implicit(const aArg: TTest): TString90; + class operator Implicit(const aArg: TTest): ShortString; + end; + +var + ExplicitString80: LongInt; + ExplicitString90: LongInt; + ExplicitShortString: LongInt; + ImplicitString80: LongInt; + ImplicitString90: LongInt; + ImplicitShortString: LongInt; + +class operator TTest.Explicit(const aArg: TTest): TString80; +begin + Writeln('TString80 Explicit'); + Inc(ExplicitString80); + Result := ''; +end; + +class operator TTest.Explicit(const aArg: TTest): TString90; +begin + Writeln('TString90 Explicit'); + Inc(ExplicitString90); + Result := ''; +end; + +class operator TTest.Explicit(const aArg: TTest): ShortString; +begin + Writeln('ShortString Explicit'); + Inc(ExplicitShortString); + Result := ''; +end; + +class operator TTest.Implicit(const aArg: TTest): TString80; +begin + Writeln('TString80 Implicit'); + Inc(ImplicitString80); + Result := ''; +end; + +class operator TTest.Implicit(const aArg: TTest): TString90; +begin + Writeln('TString90 Implicit'); + Inc(ImplicitString90); + Result := ''; +end; + +class operator TTest.Implicit(const aArg: TTest): ShortString; +begin + Writeln('ShortString Implicit'); + Inc(ImplicitShortString); + Result := ''; +end; + +var + s80: TString80; + s90: TString90; + s40: TString40; + s100: TString100; + t: TTest; +begin + // Explicit + s80 := TString80(t); + if ExplicitString80 <> 1 then + Halt(1); + s90 := TString90(t); + if ExplicitString90 <> 1 then + Halt(2); + s40 := TString40(t); + if ImplicitShortString <> 1 then + Halt(3); + s100 := TString100(t); + if ImplicitShortString <> 2 then + Halt(4); + // Implicit + s80 := t; + if ImplicitShortString <> 3 then + Halt(5); + s90 := t; + if ImplicitShortString <> 4 then + Halt(6); + s40 := t; + if ImplicitShortString <> 5 then + Halt(7); + s100 := t; + if ImplicitShortString <> 6 then + Halt(8); + Writeln('ok'); +end. diff --git a/tests/test/toperator92.pp b/tests/test/toperator92.pp new file mode 100644 index 0000000000..04ea4463e9 --- /dev/null +++ b/tests/test/toperator92.pp @@ -0,0 +1,33 @@ +{ %FAIL } + +program toperator92; + +{$mode delphi} + +type + TString80 = String[80]; + TString90 = String[90]; + TString40 = String[40]; + TString100 = String[100]; + + TTest = record + class operator Implicit(const aArg: TTest): TString80; + class operator Implicit(const aArg: TTest): TString90; + end; + +class operator TTest.Implicit(const aArg: TTest): TString80; +begin + +end; + +class operator TTest.Implicit(const aArg: TTest): TString90; +begin + +end; + +var + t: TTest; + s: TString80; +begin + s := t; +end. diff --git a/tests/test/toperator93.pp b/tests/test/toperator93.pp new file mode 100644 index 0000000000..de3b37b015 --- /dev/null +++ b/tests/test/toperator93.pp @@ -0,0 +1,27 @@ +{ %NORUN } + +program toperator93; + +{$mode delphi} + +type + TString80 = String[80]; + TString90 = String[90]; + TString40 = String[40]; + TString100 = String[100]; + + TTest = record + class operator Implicit(const aArg: TTest): TString80; + end; + +class operator TTest.Implicit(const aArg: TTest): TString80; +begin + +end; + +var + t: TTest; + s: TString80; +begin + s := t; +end. diff --git a/tests/test/toperator94.pp b/tests/test/toperator94.pp new file mode 100644 index 0000000000..f575137787 --- /dev/null +++ b/tests/test/toperator94.pp @@ -0,0 +1,66 @@ +program toperator94; + +{$mode objfpc} +{$modeswitch advancedrecords} + +type + TString80 = String[80]; + TString90 = String[90]; + TString40 = String[40]; + TString100 = String[100]; + + TTest1 = record + class operator :=(const aArg: TTest1): TString80; + end; + + TTest2 = record + class operator :=(const aArg: TTest2): ShortString; + end; + +var + ImplicitTest1ShortString: LongInt; + ImplicitTest1String80: LongInt; + ImplicitTest2ShortString: LongInt; + ImplicitTest2String80: LongInt; + +class operator TTest1.:=(const aArg: TTest1): TString80; +begin + Writeln('TTest1 Implicit TString80'); + Inc(ImplicitTest1String80); + Result := ''; +end; + +class operator TTest2.:=(const aArg: TTest2): ShortString; +begin + Writeln('TTest2 Implicit ShortString'); + Inc(ImplicitTest2ShortString); + Result := ''; +end; + +operator :=(const aArg: TTest1): ShortString; +begin + Writeln('TTest1 Implicit ShortString'); + Inc(ImplicitTest1ShortString); + Result := ''; +end; + +operator :=(const aArg: TTest2): TString80; +begin + Writeln('TTest2 Implicit TString80'); + Inc(ImplicitTest2String80); + Result := ''; +end; + +var + t1: TTest1; + t2: TTest2; + s80: TString80; +begin + s80 := t1; + if ImplicitTest1ShortString <> 1 then + Halt(1); + s80 := t2; + if ImplicitTest2ShortString <> 1 then + Halt(2); + Writeln('ok'); +end. diff --git a/tests/test/toperator95.pp b/tests/test/toperator95.pp new file mode 100644 index 0000000000..c833fb88fa --- /dev/null +++ b/tests/test/toperator95.pp @@ -0,0 +1,29 @@ +{ %FAIL } + +program toperator95; + +{$mode objfpc} +{$modeswitch advancedrecords} + +type + TString80 = String[80]; + TString90 = String[90]; + + TTest = record + class operator :=(const aArg: TTest): TString80; + end; + +class operator TTest.:=(const aArg: TTest): TString80; +begin +end; + +operator :=(const aArg: TTest): TString90; +begin +end; + +var + t: TTest; + s80: TString80; +begin + s80 := t; +end. diff --git a/tests/webtbs/tw38145a.pp b/tests/webtbs/tw38145a.pp new file mode 100644 index 0000000000..7c9cc8c8e0 --- /dev/null +++ b/tests/webtbs/tw38145a.pp @@ -0,0 +1,29 @@ +{ %NORUN } + +program tw38145a; +{$mode delphi} +type + TMyWrap = record + Value: T; + class operator Explicit(const w: TMyWrap): T; + class operator Implicit(const w: TMyWrap): T; + end; + +class operator TMyWrap.Explicit(const w: TMyWrap): T; +begin + Result := w.Value; +end; + +class operator TMyWrap.Implicit(const w: TMyWrap): T; +begin + Result := w.Value; +end; + +type + //TString = string[255]; //compiles + TString = string[254]; //not compiles + +var + MySpec: TMyWrap; +begin +end. diff --git a/tests/webtbs/tw38145b.pp b/tests/webtbs/tw38145b.pp new file mode 100644 index 0000000000..ad8e9c6ac5 --- /dev/null +++ b/tests/webtbs/tw38145b.pp @@ -0,0 +1,28 @@ +{ %NORUN } + +program tw38145b; +{$mode objfpc}{$modeswitch advancedrecords} +type + generic TMyWrap = record + Value: T; + class operator Explicit(const w: TMyWrap): T; + class operator :=(const w: TMyWrap): T; + end; + +class operator TMyWrap.Explicit(const w: TMyWrap): T; +begin + Result := w.Value; +end; + +class operator TMyWrap.:=(const w: TMyWrap): T; +begin + Result := w.Value; +end; + +type + //TString = string[255]; //compiles + TString = string[254]; //not compiles +var + MySpec: specialize TMyWrap; +begin +end.