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: branches/fixes_3_2@49055 -

.gitattributes

@@ -14956,6 +14956,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
@@ -17831,6 +17836,8 @@ tests/webtbs/tw38058.pp svneol=native#text/pascal
 tests/webtbs/tw38069.pp svneol=native#text/pascal
 tests/webtbs/tw38083.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/tw38151.pp svneol=native#text/pascal
 tests/webtbs/tw38238.pp svneol=native#text/pascal
 tests/webtbs/tw3827.pp svneol=native#text/plain

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 }

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>

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;
 

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;
 

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.

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.

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.

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.

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.

tests/webtbf/tw12109a.pp

@@ -1,3 +1,4 @@
+{ %MAXVERSION=3.2.0 }
 { %fail }
 
 type

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.

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.