ソースを参照

* support proc to procvar conversion for overloaded procdefs passed to parameters

git-svn-id: trunk@2997 -
peter 19 年 前
コミット
ae0010ad6c
5 ファイル変更71 行追加9 行削除
  1. 1 0
      .gitattributes
  2. 19 0
      compiler/htypechk.pas
  3. 1 4
      compiler/ncal.pas
  4. 5 5
      compiler/nld.pas
  5. 45 0
      tests/webtbs/tw4922.pp

+ 1 - 0
.gitattributes

@@ -6760,6 +6760,7 @@ tests/webtbs/tw4893a.pp svneol=native#text/plain
 tests/webtbs/tw4893b.pp svneol=native#text/plain
 tests/webtbs/tw4893c.pp svneol=native#text/plain
 tests/webtbs/tw4898.pp -text
+tests/webtbs/tw4922.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

+ 19 - 0
compiler/htypechk.pas

@@ -1802,6 +1802,7 @@ implementation
         pt       : tcallparanode;
         eq       : tequaltype;
         convtype : tconverttype;
+        pdtemp,
         pdoper   : tprocdef;
         releasecurrpt : boolean;
         cdoptions : tcompare_defs_options;
@@ -1854,6 +1855,24 @@ implementation
                     end;
                 end;
 
+             { If we expect a procvar and the left is loadnode that
+               returns a procdef we need to find the correct overloaded
+               procdef that matches the expected procvar. The loadnode
+               temporary returned the first procdef (PFV) }
+             if (def_to.deftype=procvardef) and
+                (currpt.left.nodetype=loadn) and
+                (currpt.left.resulttype.def.deftype=procdef) then
+               begin
+                 pdtemp:=tprocsym(Tloadnode(currpt.left).symtableentry).search_procdef_byprocvardef(Tprocvardef(def_to));
+                 if assigned(pdtemp) then
+                   begin
+                     tloadnode(currpt.left).procdef:=pdtemp;
+                     currpt.left.resulttype.setdef(tloadnode(currpt.left).procdef);
+                     currpt.resulttype:=currpt.left.resulttype;
+                     def_from:=currpt.left.resulttype.def;
+                   end;
+               end;
+
               { varargs are always equal, but not exact }
               if (po_varargs in hp^.data.procoptions) and
                  (currparanr>hp^.data.minparacount) then

+ 1 - 4
compiler/ncal.pas

@@ -1644,14 +1644,11 @@ type
                       else
                         begin
                           { in tp mode we can try to convert to procvar if
-                            there are no parameters specified. Only try it
-                            when there is only one proc definition, else the
-                            loadnode will give a strange error }
+                            there are no parameters specified }
                           if not(assigned(left)) and
                              not(cnf_inherited in callnodeflags) and
                              ((m_tp_procvar in aktmodeswitches) or
                               (m_mac_procvar in aktmodeswitches)) and
-                             (symtableprocentry.procdef_count=1) and
                              (not assigned(methodpointer) or
                               (methodpointer.nodetype <> typen)) then
                             begin

+ 5 - 5
compiler/nld.pas

@@ -304,12 +304,12 @@ implementation
              resulttype:=ttypedconstsym(symtableentry).typedconsttype;
            procsym :
              begin
+               { Return the first procdef. In case of overlaoded
+                 procdefs the matching procdef will be choosen
+                 when the expected procvardef is known, see get_information
+                 in htypechk.pas (PFV) }
                if not assigned(procdef) then
-                begin
-                  if Tprocsym(symtableentry).procdef_count>1 then
-                   CGMessage(parser_e_no_overloaded_procvars);
-                  procdef:=tprocsym(symtableentry).first_procdef;
-                end;
+                 procdef:=tprocsym(symtableentry).first_procdef;
 
                { the result is a procdef, addrn and proc_to_procvar
                  typeconvn need this as resulttype so they know

+ 45 - 0
tests/webtbs/tw4922.pp

@@ -0,0 +1,45 @@
+{$mode delphi}
+
+type
+  TStream = pointer;
+  EncodingMemoryProc = function ( pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer;
+  DecodingMemoryProc = function ( pIN, pOUT: PByte; Size: integer): integer;
+var
+  err : boolean;
+
+function SZFullEncodeBase64(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
+begin
+end;
+
+function SZFullEncodeBase64(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
+begin
+  err:=false;
+  writeln('success');
+end;
+
+function SZDecodeBase64(pIN, pOUT: PByte; Size: integer): integer; overload;
+begin
+end;
+
+function SZDecodeBase64(sIN, sOUT: TStream): integer; overload;
+begin
+end;
+
+function DoEncodingMemory( Encoding: EncodingMemoryProc; Decoding: DecodingMemoryProc): integer;
+begin
+  Encoding(nil,nil,0);
+end;
+
+
+begin
+  err:=true;
+  DoEncodingMemory(
+    SZFullEncodeBase64,
+    SZDecodeBase64);
+  if err then
+    begin
+      writeln('Error!');
+      halt(1);
+    end;
+end.
+