From 66b128efb36b09094668ea8b4eddb388d790dcd0 Mon Sep 17 00:00:00 2001 From: paul Date: Sat, 25 Dec 2010 11:08:02 +0000 Subject: [PATCH] compiler: map delphi Implicit operator to := operator of FPC, add Explicit operator for delphi only (for now) which works when explicit type conversion happens + extend test git-svn-id: trunk@16636 - --- compiler/defcmp.pas | 16 ++++++++++-- compiler/htypechk.pas | 57 ++++++++++++++++++++++--------------------- compiler/pdecsub.pas | 6 ++--- compiler/pexpr.pas | 2 +- compiler/symtable.pas | 9 ++++--- compiler/tokens.pas | 7 ++++-- tests/test/terecs6.pp | 19 +++++++++++++++ 7 files changed, 77 insertions(+), 39 deletions(-) diff --git a/compiler/defcmp.pas b/compiler/defcmp.pas index 661a836856..a52201d6dd 100644 --- a/compiler/defcmp.pas +++ b/compiler/defcmp.pas @@ -29,7 +29,7 @@ interface cclasses, globtype,globals, node, - symconst,symtype,symdef; + symconst,symtype,symbase,symdef; type { if acp is cp_all the var const or nothing are considered equal } @@ -1487,7 +1487,19 @@ implementation ) ) then begin - operatorpd:=search_assignment_operator(def_from,def_to); + { search record/object symtable first for a sutable operator } + if def_from.typ in [recorddef,objectdef] then + symtablestack.push(tabstractrecorddef(def_from).symtable); + { if type conversion is explicit then search first for explicit + operator overload and if not found then use implicit operator } + if cdo_explicit in cdoptions then + operatorpd:=search_assignment_operator(def_from,def_to,true) + else + operatorpd:=nil; + if operatorpd=nil then + operatorpd:=search_assignment_operator(def_from,def_to,false); + if def_from.typ in [recorddef,objectdef] then + symtablestack.pop(tabstractrecorddef(def_from).symtable); if assigned(operatorpd) then eq:=te_convert_operator; end; diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index 8a1ba33718..94415c41c8 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -97,34 +97,35 @@ interface {$i compinnr.inc} const - tok2nodes=26; + tok2nodes=27; tok2node:array[1..tok2nodes] of ttok2noderec=( - (tok:_PLUS ;nod:addn;inr:-1;op_overloading_supported:true), { binary overloading supported } - (tok:_MINUS ;nod:subn;inr:-1;op_overloading_supported:true), { binary and unary overloading supported } - (tok:_STAR ;nod:muln;inr:-1;op_overloading_supported:true), { binary overloading supported } - (tok:_SLASH ;nod:slashn;inr:-1;op_overloading_supported:true), { binary overloading supported } - (tok:_EQ ;nod:equaln;inr:-1;op_overloading_supported:true), { binary overloading supported } - (tok:_GT ;nod:gtn;inr:-1;op_overloading_supported:true), { binary overloading supported } - (tok:_LT ;nod:ltn;inr:-1;op_overloading_supported:true), { binary overloading supported } - (tok:_GTE ;nod:gten;inr:-1;op_overloading_supported:true), { binary overloading supported } - (tok:_LTE ;nod:lten;inr:-1;op_overloading_supported:true), { binary overloading supported } - (tok:_SYMDIF ;nod:symdifn;inr:-1;op_overloading_supported:true), { binary overloading supported } - (tok:_STARSTAR ;nod:starstarn;inr:-1;op_overloading_supported:true), { binary overloading supported } - (tok:_OP_AS ;nod:asn;inr:-1;op_overloading_supported:false), { binary overloading NOT supported } - (tok:_OP_IN ;nod:inn;inr:-1;op_overloading_supported:true), { binary overloading supported } - (tok:_OP_IS ;nod:isn;inr:-1;op_overloading_supported:false), { binary overloading NOT supported } - (tok:_OP_OR ;nod:orn;inr:-1;op_overloading_supported:true), { binary overloading supported } - (tok:_OP_AND ;nod:andn;inr:-1;op_overloading_supported:true), { binary overloading supported } - (tok:_OP_DIV ;nod:divn;inr:-1;op_overloading_supported:true), { binary overloading supported } - (tok:_OP_NOT ;nod:notn;inr:-1;op_overloading_supported:true), { unary overloading supported } - (tok:_OP_MOD ;nod:modn;inr:-1;op_overloading_supported:true), { binary overloading supported } - (tok:_OP_SHL ;nod:shln;inr:-1;op_overloading_supported:true), { binary overloading supported } - (tok:_OP_SHR ;nod:shrn;inr:-1;op_overloading_supported:true), { binary overloading supported } - (tok:_OP_XOR ;nod:xorn;inr:-1;op_overloading_supported:true), { binary overloading supported } - (tok:_ASSIGNMENT;nod:assignn;inr:-1;op_overloading_supported:true), { unary overloading supported } - (tok:_NE ;nod:unequaln;inr:-1;op_overloading_supported:true), { binary overloading supported } - (tok:_OP_INC ;nod:inlinen;inr:in_inc_x;op_overloading_supported:true),{ unary overloading supported } - (tok:_OP_DEC ;nod:inlinen;inr:in_dec_x;op_overloading_supported:true) { unary overloading supported } + (tok:_PLUS ;nod:addn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_MINUS ;nod:subn;inr:-1;op_overloading_supported:true), { binary and unary overloading supported } + (tok:_STAR ;nod:muln;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_SLASH ;nod:slashn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_EQ ;nod:equaln;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_GT ;nod:gtn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_LT ;nod:ltn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_GTE ;nod:gten;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_LTE ;nod:lten;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_SYMDIF ;nod:symdifn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_STARSTAR ;nod:starstarn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_OP_AS ;nod:asn;inr:-1;op_overloading_supported:false), { binary overloading NOT supported } + (tok:_OP_IN ;nod:inn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_OP_IS ;nod:isn;inr:-1;op_overloading_supported:false), { binary overloading NOT supported } + (tok:_OP_OR ;nod:orn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_OP_AND ;nod:andn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_OP_DIV ;nod:divn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_OP_NOT ;nod:notn;inr:-1;op_overloading_supported:true), { unary overloading supported } + (tok:_OP_MOD ;nod:modn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_OP_SHL ;nod:shln;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_OP_SHR ;nod:shrn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_OP_XOR ;nod:xorn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_ASSIGNMENT ;nod:assignn;inr:-1;op_overloading_supported:true), { unary overloading supported } + (tok:_OP_EXPLICIT;nod:assignn;inr:-1;op_overloading_supported:true), { unary overloading supported } + (tok:_NE ;nod:unequaln;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_OP_INC ;nod:inlinen;inr:in_inc_x;op_overloading_supported:true),{ unary overloading supported } + (tok:_OP_DEC ;nod:inlinen;inr:in_dec_x;op_overloading_supported:true) { unary overloading supported } ); { true, if we are parsing stuff which allows array constructors } @@ -419,7 +420,7 @@ implementation 1 : begin ld:=tparavarsym(pf.parast.SymList[0]).vardef; { assignment is a special case } - if optoken=_ASSIGNMENT then + if optoken in [_ASSIGNMENT,_OP_EXPLICIT] then begin eq:=compare_defs_ext(ld,pf.returndef,nothingn,conv,pd,[cdo_explicit]); result:= diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index 9a672bb782..18e77fbc1c 100644 --- a/compiler/pdecsub.pas +++ b/compiler/pdecsub.pas @@ -826,8 +826,8 @@ implementation else if (m_delphi in current_settings.modeswitches) then case lastidtoken of -// _IMPLICIT:optoken:=; -// _EXPLICIT:optoken:=; + _IMPLICIT:optoken:=_ASSIGNMENT; + _EXPLICIT:optoken:=_OP_EXPLICIT; _NEGATIVE:optoken:=_MINUS; // _POSITIVE:optoken:=_PLUS; _INC:optoken:=_OP_INC; @@ -1380,7 +1380,7 @@ implementation ((pd.returndef.typ<>orddef) or (torddef(pd.returndef).ordtype<>pasbool)) then Message(parser_e_comparative_operator_return_boolean); - if (optoken=_ASSIGNMENT) and + if (optoken in [_ASSIGNMENT,_OP_EXPLICIT]) and equal_defs(pd.returndef,tparavarsym(pd.parast.SymList[0]).vardef) then message(parser_e_no_such_assignment) else if not isoperatoracceptable(pd,optoken) then diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index d2240dd4c9..9b9818f457 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -2786,7 +2786,7 @@ implementation ****************************************************************************} const { Warning these stay be ordered !! } - operator_levels:array[Toperator_precedence] of set of Ttoken= + operator_levels:array[Toperator_precedence] of set of NOTOKEN..last_operator= ([_LT,_LTE,_GT,_GTE,_EQ,_NE,_OP_IN], [_PLUS,_MINUS,_OP_OR,_PIPE,_OP_XOR], [_CARET,_SYMDIF,_STARSTAR,_STAR,_SLASH, diff --git a/compiler/symtable.pas b/compiler/symtable.pas index 63344fdcca..b8052914ac 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -214,7 +214,7 @@ interface function search_system_type(const s: TIDString): ttypesym; function search_named_unit_globaltype(const unitname, typename: TIDString; throwerror: boolean): ttypesym; function search_struct_member(pd : tabstractrecorddef;const s : string):tsym; - function search_assignment_operator(from_def,to_def:Tdef):Tprocdef; + function search_assignment_operator(from_def,to_def:Tdef;explicit:boolean):Tprocdef; function search_enumerator_operator(from_def,to_def:Tdef):Tprocdef; function search_class_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean; function search_objc_method(const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean; @@ -290,6 +290,7 @@ interface { _OP_SHR } 'shr', { _OP_XOR } 'xor', { _ASSIGNMENT } 'assign', + { _OP_EXPLICIT } 'explicit', { _OP_ENUMERATOR } 'enumerator', { _OP_INC } 'inc', { _OP_DEC } 'dec'); @@ -2234,7 +2235,9 @@ implementation end; - function search_assignment_operator(from_def,to_def:Tdef):Tprocdef; + function search_assignment_operator(from_def,to_def:Tdef;explicit:boolean):Tprocdef; + const + op_token:array[boolean] of ttoken=(_ASSIGNMENT,_OP_EXPLICIT); var sym : Tprocsym; hashedid : THashedIDString; @@ -2244,7 +2247,7 @@ implementation bestpd : tprocdef; stackitem : psymtablestackitem; begin - hashedid.id:='assign'; + hashedid.id:=overloaded_names[op_token[explicit]]; besteq:=te_incompatible; bestpd:=nil; stackitem:=symtablestack.stack; diff --git a/compiler/tokens.pas b/compiler/tokens.pas index 104b49796b..d41ee371a0 100644 --- a/compiler/tokens.pas +++ b/compiler/tokens.pas @@ -54,6 +54,7 @@ type _OP_SHR, _OP_XOR, _ASSIGNMENT, + _OP_EXPLICIT, _OP_ENUMERATOR, _OP_INC, _OP_DEC, @@ -299,6 +300,7 @@ const be declared directly after NOTOKEN } first_overloaded = succ(NOTOKEN); last_overloaded = _OP_DEC; + last_operator = _GENERICSPECIALTOKEN; type tokenrec=record @@ -346,9 +348,10 @@ const (str:'shr' ;special:true ;keyword:m_none;op:NOTOKEN), (str:'xor' ;special:true ;keyword:m_none;op:NOTOKEN), (str:':=' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'explicit' ;special:true ;keyword:m_none;op:NOTOKEN), (str:'enumerator' ;special:true ;keyword:m_none;op:NOTOKEN), - (str:'++' ;special:true ;keyword:m_none;op:NOTOKEN), - (str:'--' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'inc' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'dec' ;special:true ;keyword:m_none;op:NOTOKEN), { Special chars } (str:'^' ;special:true ;keyword:m_none;op:NOTOKEN), (str:'[' ;special:true ;keyword:m_none;op:NOTOKEN), diff --git a/tests/test/terecs6.pp b/tests/test/terecs6.pp index 36a7d6974d..f0a5551612 100644 --- a/tests/test/terecs6.pp +++ b/tests/test/terecs6.pp @@ -8,6 +8,8 @@ uses type TFoo = record F: Integer; + class operator Explicit(a: TFoo): Integer; + class operator Implicit(a: TFoo): Integer; class operator Equal(a, b: TFoo): Boolean; class operator NotEqual(a, b: TFoo): Boolean; class operator In(a, b: TFoo): Boolean; @@ -34,6 +36,17 @@ type class operator Dec(a: TFoo): TFoo; end; +class operator TFoo.Explicit(a: TFoo): Integer; +begin + // to check the difference with implicit + Result := a.F + 1; +end; + +class operator TFoo.Implicit(a: TFoo): Integer; +begin + Result := a.F; +end; + class operator TFoo.Equal(a, b: TFoo): Boolean; begin Result := a.F = b.F; @@ -156,6 +169,7 @@ end; var a, b: TFoo; + i: integer; begin a.F := 1; b.F := 2; @@ -213,5 +227,10 @@ begin dec(b); if b.F <> 1 then halt(25); + i := b; + if i <> 1 then + halt(26); + if Integer(b) <> 2 then + halt(27); WriteLn('ok'); end.