Merged revision(s) 47634, 47655 from trunk:

* 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... :/
........
* with the recent ShortString changes this test is no longer needed as it was added exactly to check the condition I removed, so disable it for 3.2.1 and newer (as I want to merge these changes back to fixes)
........


git-svn-id: https://svn.freepascal.org/svn/fpc/branches/fixes_3_2@49055 3ad0048d-3df7-0310-abae-a5850022a9f2

12 files changed, 389 insertions, 25 deletions

diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
index 078cbb31d2..330c5203a2 100644
--- a/compiler/htypechk.pas
+++ b/compiler/htypechk.pas
@@ -667,17 +667,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/ppcx64.lpi b/compiler/ppcx64.lpi
index a28f04cf21..19429fa097 100644
--- a/compiler/ppcx64.lpi
+++ b/compiler/ppcx64.lpi
@@ -1,7 +1,7 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="11"/>
     <PathDelim Value="\"/>
     <General>
       <Flags>
@@ -20,25 +20,32 @@
     <PublishOptions>
       <Version Value="2"/>
       <DestinationDirectory Value="$(TestDir)\publishedproject\"/>
-      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
-      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
     </PublishOptions>
     <RunParams>
       <local>
-        <FormatVersion Value="1"/>
+        <CommandLineParams Value="-n -Furtl\units\x86_64-win64 -viwn -FEtestoutput .\fpctests\tw38591.pp"/>
         <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+        <WorkingDirectory Value="c:\fpc\3.2.x"/>
       </local>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default">
+          <local>
+            <CommandLineParams Value="-n -Furtl\units\x86_64-win64 -viwn -FEtestoutput .\fpctests\tw38591.pp"/>
+            <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+            <WorkingDirectory Value="c:\fpc\3.2.x"/>
+          </local>
+        </Mode0>
+      </Modes>
     </RunParams>
     <Units Count="2">
       <Unit0>
         <Filename Value="pp.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="pp"/>
       </Unit0>
       <Unit1>
         <Filename Value="x86\aasmcpu.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="aasmcpu"/>
       </Unit1>
     </Units>
   </ProjectOptions>
@@ -71,7 +78,6 @@
         <StopAfterErrCount Value="50"/>
       </ConfigFile>
       <CustomOptions Value="-dx86_64"/>
-      <CompilerPath Value="$(CompPath)"/>
     </Other>
   </CompilerOptions>
 </CONFIG>
diff --git a/compiler/symsym.pas b/compiler/symsym.pas
index f849841e89..141939cab2 100644
--- a/compiler/symsym.pas
+++ b/compiler/symsym.pas
@@ -144,7 +144,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;
@@ -1144,7 +1144,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;
@@ -1153,12 +1153,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]);
@@ -1166,7 +1176,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
@@ -1200,7 +1210,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;
@@ -1214,6 +1231,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 44312b63d2..00141f29fb 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -3907,11 +3907,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));
@@ -3921,17 +3931,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/webtbf/tw12109a.pp b/tests/webtbf/tw12109a.pp
index 4272085510..098fecfa8d 100644
--- a/tests/webtbf/tw12109a.pp
+++ b/tests/webtbf/tw12109a.pp
@@ -1,3 +1,4 @@
+{ %MAXVERSION=3.2.0 }
 { %fail }
 
 type
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<T> = record
+    Value: T;
+    class operator Explicit(const w: TMyWrap<T>): T;
+    class operator Implicit(const w: TMyWrap<T>): T;
+  end;
+
+class operator TMyWrap<T>.Explicit(const w: TMyWrap<T>): T;
+begin
+  Result := w.Value;
+end;
+
+class operator TMyWrap<T>.Implicit(const w: TMyWrap<T>): T;
+begin
+  Result := w.Value;
+end;
+
+type
+  //TString = string[255]; //compiles
+  TString = string[254]; //not compiles
+
+var
+  MySpec: TMyWrap<TString>;
+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<T> = 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<TString>;
+begin
+end.