|
|
@@ -3578,122 +3578,138 @@ implementation
|
|
|
else
|
|
|
{ not a procedure variable }
|
|
|
begin
|
|
|
- { do we know the procedure to call ? }
|
|
|
- if not(assigned(procdefinition)) then
|
|
|
- begin
|
|
|
- { ignore possible private for properties or in delphi mode for anon. inherited (FK) }
|
|
|
- ignorevisibility:=(nf_isproperty in flags) or
|
|
|
- ((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags));
|
|
|
- candidates:=tcallcandidates.create(symtableprocentry,symtableproc,left,ignorevisibility,
|
|
|
- not(nf_isproperty in flags),cnf_objc_id_call in callnodeflags,cnf_unit_specified in callnodeflags,
|
|
|
- callnodeflags*[cnf_anon_inherited,cnf_inherited]=[],cnf_anon_inherited in callnodeflags,spezcontext);
|
|
|
-
|
|
|
- { no procedures found? then there is something wrong
|
|
|
- with the parameter size or the procedures are
|
|
|
- not accessible }
|
|
|
- if candidates.count=0 then
|
|
|
- begin
|
|
|
- { when it's an auto inherited call and there
|
|
|
- is no procedure found, but the procedures
|
|
|
- were defined with overload directive and at
|
|
|
- least two procedures are defined then we ignore
|
|
|
- this inherited by inserting a nothingn. Only
|
|
|
- do this ugly hack in Delphi mode as it looks more
|
|
|
- like a bug. It's also not documented }
|
|
|
- if (m_delphi in current_settings.modeswitches) and
|
|
|
- (cnf_anon_inherited in callnodeflags) and
|
|
|
- (symtableprocentry.owner.symtabletype=ObjectSymtable) and
|
|
|
- (po_overload in tprocdef(symtableprocentry.ProcdefList[0]).procoptions) and
|
|
|
- (symtableprocentry.ProcdefList.Count>=2) then
|
|
|
- result:=cnothingnode.create
|
|
|
- else
|
|
|
- begin
|
|
|
- { in tp mode we can try to convert to procvar if
|
|
|
- there are no parameters specified }
|
|
|
- if not(assigned(left)) and
|
|
|
- not(cnf_inherited in callnodeflags) and
|
|
|
- ((m_tp_procvar in current_settings.modeswitches) or
|
|
|
- (m_mac_procvar in current_settings.modeswitches)) and
|
|
|
- (not assigned(methodpointer) or
|
|
|
- (methodpointer.nodetype <> typen)) then
|
|
|
- begin
|
|
|
- hpt:=cloadnode.create(tprocsym(symtableprocentry),symtableproc);
|
|
|
- if assigned(methodpointer) then
|
|
|
- tloadnode(hpt).set_mp(methodpointer.getcopy);
|
|
|
- typecheckpass(hpt);
|
|
|
- result:=hpt;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,symtableprocentry.realname);
|
|
|
- symtableprocentry.write_parameter_lists(nil);
|
|
|
- end;
|
|
|
- end;
|
|
|
- candidates.free;
|
|
|
- exit;
|
|
|
- end;
|
|
|
+ { do we know the procedure to call ? }
|
|
|
+ if not(assigned(procdefinition)) then
|
|
|
+ begin
|
|
|
+ { according to bug reports 32539 and 20551, real variant of sqr/abs should be used when they are called for variants to be
|
|
|
+ delphi compatible, this is in contrast to normal overloading behaviour, so fix this by a terrible hack to be compatible }
|
|
|
+ if assigned(left) and assigned(tcallparanode(left).left) and
|
|
|
+ (tcallparanode(left).left.resultdef.typ=variantdef) and assigned(symtableproc.name) and (symtableproc.name^='SYSTEM') then
|
|
|
+ begin
|
|
|
+ if symtableprocentry.Name='SQR' then
|
|
|
+ begin
|
|
|
+ result:=cinlinenode.createintern(in_sqr_real,false,tcallparanode(left).left.getcopy);
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ if symtableprocentry.Name='ABS' then
|
|
|
+ begin
|
|
|
+ result:=cinlinenode.createintern(in_abs_real,false,tcallparanode(left).left.getcopy);
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ { ignore possible private for properties or in delphi mode for anon. inherited (FK) }
|
|
|
+ ignorevisibility:=(nf_isproperty in flags) or
|
|
|
+ ((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags));
|
|
|
+ candidates:=tcallcandidates.create(symtableprocentry,symtableproc,left,ignorevisibility,
|
|
|
+ not(nf_isproperty in flags),cnf_objc_id_call in callnodeflags,cnf_unit_specified in callnodeflags,
|
|
|
+ callnodeflags*[cnf_anon_inherited,cnf_inherited]=[],cnf_anon_inherited in callnodeflags,spezcontext);
|
|
|
+
|
|
|
+ { no procedures found? then there is something wrong
|
|
|
+ with the parameter size or the procedures are
|
|
|
+ not accessible }
|
|
|
+ if candidates.count=0 then
|
|
|
+ begin
|
|
|
+ { when it's an auto inherited call and there
|
|
|
+ is no procedure found, but the procedures
|
|
|
+ were defined with overload directive and at
|
|
|
+ least two procedures are defined then we ignore
|
|
|
+ this inherited by inserting a nothingn. Only
|
|
|
+ do this ugly hack in Delphi mode as it looks more
|
|
|
+ like a bug. It's also not documented }
|
|
|
+ if (m_delphi in current_settings.modeswitches) and
|
|
|
+ (cnf_anon_inherited in callnodeflags) and
|
|
|
+ (symtableprocentry.owner.symtabletype=ObjectSymtable) and
|
|
|
+ (po_overload in tprocdef(symtableprocentry.ProcdefList[0]).procoptions) and
|
|
|
+ (symtableprocentry.ProcdefList.Count>=2) then
|
|
|
+ result:=cnothingnode.create
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ { in tp mode we can try to convert to procvar if
|
|
|
+ there are no parameters specified }
|
|
|
+ if not(assigned(left)) and
|
|
|
+ not(cnf_inherited in callnodeflags) and
|
|
|
+ ((m_tp_procvar in current_settings.modeswitches) or
|
|
|
+ (m_mac_procvar in current_settings.modeswitches)) and
|
|
|
+ (not assigned(methodpointer) or
|
|
|
+ (methodpointer.nodetype <> typen)) then
|
|
|
+ begin
|
|
|
+ hpt:=cloadnode.create(tprocsym(symtableprocentry),symtableproc);
|
|
|
+ if assigned(methodpointer) then
|
|
|
+ tloadnode(hpt).set_mp(methodpointer.getcopy);
|
|
|
+ typecheckpass(hpt);
|
|
|
+ result:=hpt;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,symtableprocentry.realname);
|
|
|
+ symtableprocentry.write_parameter_lists(nil);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ candidates.free;
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
|
|
|
- { Retrieve information about the candidates }
|
|
|
- candidates.get_information;
|
|
|
+ { Retrieve information about the candidates }
|
|
|
+ candidates.get_information;
|
|
|
{$ifdef EXTDEBUG}
|
|
|
- { Display info when multiple candidates are found }
|
|
|
- if candidates.count>1 then
|
|
|
- candidates.dump_info(V_Debug);
|
|
|
+ { Display info when multiple candidates are found }
|
|
|
+ if candidates.count>1 then
|
|
|
+ candidates.dump_info(V_Debug);
|
|
|
{$endif EXTDEBUG}
|
|
|
|
|
|
- { Choose the best candidate and count the number of
|
|
|
- candidates left }
|
|
|
- cand_cnt:=candidates.choose_best(procdefinition,
|
|
|
- assigned(left) and
|
|
|
- not assigned(tcallparanode(left).right) and
|
|
|
- (tcallparanode(left).left.resultdef.typ=variantdef));
|
|
|
+ { Choose the best candidate and count the number of
|
|
|
+ candidates left }
|
|
|
+ cand_cnt:=candidates.choose_best(procdefinition,
|
|
|
+ assigned(left) and
|
|
|
+ not assigned(tcallparanode(left).right) and
|
|
|
+ (tcallparanode(left).left.resultdef.typ=variantdef));
|
|
|
|
|
|
- { All parameters are checked, check if there are any
|
|
|
- procedures left }
|
|
|
- if cand_cnt>0 then
|
|
|
- begin
|
|
|
- { Multiple candidates left? }
|
|
|
- if cand_cnt>1 then
|
|
|
- begin
|
|
|
- CGMessage(type_e_cant_choose_overload_function);
|
|
|
+ { All parameters are checked, check if there are any
|
|
|
+ procedures left }
|
|
|
+ if cand_cnt>0 then
|
|
|
+ begin
|
|
|
+ { Multiple candidates left? }
|
|
|
+ if cand_cnt>1 then
|
|
|
+ begin
|
|
|
+ CGMessage(type_e_cant_choose_overload_function);
|
|
|
{$ifdef EXTDEBUG}
|
|
|
- candidates.dump_info(V_Hint);
|
|
|
+ candidates.dump_info(V_Hint);
|
|
|
{$else EXTDEBUG}
|
|
|
- candidates.list(false);
|
|
|
+ candidates.list(false);
|
|
|
{$endif EXTDEBUG}
|
|
|
- { we'll just use the first candidate to make the
|
|
|
- call }
|
|
|
- end;
|
|
|
+ { we'll just use the first candidate to make the
|
|
|
+ call }
|
|
|
+ end;
|
|
|
|
|
|
- { assign procdefinition }
|
|
|
- if symtableproc=nil then
|
|
|
- symtableproc:=procdefinition.owner;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- { No candidates left, this must be a type error,
|
|
|
- because wrong size is already checked. procdefinition
|
|
|
- is filled with the first (random) definition that is
|
|
|
- found. We use this definition to display a nice error
|
|
|
- message that the wrong type is passed }
|
|
|
- candidates.find_wrong_para;
|
|
|
- candidates.list(true);
|
|
|
+ { assign procdefinition }
|
|
|
+ if symtableproc=nil then
|
|
|
+ symtableproc:=procdefinition.owner;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ { No candidates left, this must be a type error,
|
|
|
+ because wrong size is already checked. procdefinition
|
|
|
+ is filled with the first (random) definition that is
|
|
|
+ found. We use this definition to display a nice error
|
|
|
+ message that the wrong type is passed }
|
|
|
+ candidates.find_wrong_para;
|
|
|
+ candidates.list(true);
|
|
|
{$ifdef EXTDEBUG}
|
|
|
- candidates.dump_info(V_Hint);
|
|
|
+ candidates.dump_info(V_Hint);
|
|
|
{$endif EXTDEBUG}
|
|
|
|
|
|
- { We can not proceed, release all procs and exit }
|
|
|
- candidates.free;
|
|
|
- exit;
|
|
|
- end;
|
|
|
+ { We can not proceed, release all procs and exit }
|
|
|
+ candidates.free;
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
|
|
|
- { if the final procedure definition is not yet owned,
|
|
|
- ensure that it is }
|
|
|
- procdefinition.register_def;
|
|
|
- if procdefinition.is_specialization and (procdefinition.typ=procdef) then
|
|
|
- maybe_add_pending_specialization(procdefinition);
|
|
|
+ { if the final procedure definition is not yet owned,
|
|
|
+ ensure that it is }
|
|
|
+ procdefinition.register_def;
|
|
|
+ if procdefinition.is_specialization and (procdefinition.typ=procdef) then
|
|
|
+ maybe_add_pending_specialization(procdefinition);
|
|
|
|
|
|
- candidates.free;
|
|
|
+ candidates.free;
|
|
|
end; { end of procedure to call determination }
|
|
|
end;
|
|
|
|
florian