Browse Source

fixes bug #4093
+ variant -> tdatetime implemented
+ overloaded assignment operator takes care of unique flags

git-svn-id: trunk@508 -

florian 20 years ago
parent
commit
067a39a7f9
3 changed files with 27 additions and 8 deletions
  1. 22 5
      compiler/symsym.pas
  2. 5 2
      compiler/symtable.pas
  3. 0 1
      tests/webtbs/tw4093.pp

+ 22 - 5
compiler/symsym.pas

@@ -123,7 +123,7 @@ interface
           function search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
           function search_procdef_bypara(para:tlist;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef;
           function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
-          function search_procdef_assignment_operator(fromdef,todef:tdef):Tprocdef;
+          function search_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;
           function  write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
           function is_visible_for_object(currobjdef:tdef):boolean;override;
 {$ifdef GDB}
@@ -988,13 +988,12 @@ implementation
       end;
 
 
-    function Tprocsym.search_procdef_assignment_operator(fromdef,todef:tdef):Tprocdef;
+    function Tprocsym.search_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;
       var
         convtyp : tconverttype;
         pd      : pprocdeflist;
         bestpd  : tprocdef;
-        eq,
-        besteq  : tequaltype;
+        eq      : tequaltype;
         hpd     : tprocdef;
         i       : byte;
       begin
@@ -1004,7 +1003,15 @@ implementation
         pd:=pdlistfirst;
         while assigned(pd) do
           begin
-            if equal_defs(todef,pd^.def.rettype.def) then
+            if equal_defs(todef,pd^.def.rettype.def) and
+              { the result type must be always really equal and not an alias,
+                if you mess with this code, check tw4093 }
+              ((todef=pd^.def.rettype.def) or
+               (
+                 not(df_unique in todef.defoptions) and
+                 not(df_unique in pd^.def.rettype.def.defoptions)
+               )
+              ) then
              begin
                i:=0;
                { ignore vs_hidden parameters }
@@ -1014,8 +1021,18 @@ implementation
                if assigned(pd^.def.paras[i]) then
                 begin
                   eq:=compare_defs_ext(fromdef,tparavarsym(pd^.def.paras[i]).vartype.def,nothingn,convtyp,hpd,[]);
+
+                  { alias? if yes, only l1 choice,
+                    if you mess with this code, check tw4093 }
+                  if (eq=te_exact) and
+                    (fromdef<>tparavarsym(pd^.def.paras[i]).vartype.def) and
+                    ((df_unique in fromdef.defoptions) or
+                    (df_unique in tparavarsym(pd^.def.paras[i]).vartype.def.defoptions)) then
+                    eq:=te_convert_l1;
+
                   if eq=te_exact then
                    begin
+                     besteq:=eq;
                      result:=pd^.def;
                      exit;
                    end;

+ 5 - 2
compiler/symtable.pas

@@ -2051,6 +2051,7 @@ implementation
     var st:Tsymtable;
         sym:Tprocsym;
         sv:cardinal;
+        besteq:tequaltype;
 
     begin
       st:=symtablestack;
@@ -2062,8 +2063,10 @@ implementation
             begin
               if sym.typ<>procsym then
                 internalerror(200402031);
-              search_assignment_operator:=sym.search_procdef_assignment_operator(from_def,to_def);
-              if search_assignment_operator<>nil then
+              { if the source type is an alias then this is only the second choice,
+                if you mess with this code, check tw4093 }
+              search_assignment_operator:=sym.search_procdef_assignment_operator(from_def,to_def,besteq);
+              if (search_assignment_operator<>nil) and (besteq=te_exact) then
                 break;
             end;
           st:=st.next;

+ 0 - 1
tests/webtbs/tw4093.pp

@@ -25,5 +25,4 @@ begin
   writeln(v);
   DT := V;
   WriteLn(DateTimeToStr(DT));
-  ReadLn;
 end.