diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index 0c6b6cb824..6d2e101541 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -1237,8 +1237,7 @@ implementation is_open_array(fromdef) or is_open_array(todef) or ((fromdef.typ=pointerdef) and (todef.typ=arraydef)) or - ((fromdef.typ = objectdef) and (todef.typ = objectdef) and - (tobjectdef(fromdef).is_related(tobjectdef(todef))))) and + (fromdef.is_related(todef))) and (fromdef.size<>todef.size) then begin { in TP it is allowed to typecast to smaller types. But the variable can't diff --git a/compiler/jvm/njvmcnv.pas b/compiler/jvm/njvmcnv.pas index dfb9fd5409..626933cd72 100644 --- a/compiler/jvm/njvmcnv.pas +++ b/compiler/jvm/njvmcnv.pas @@ -54,6 +54,7 @@ interface { procedure second_char_to_char;override; } protected function target_specific_explicit_typeconv: tnode; override; + function target_specific_general_typeconv(var res: tnode): boolean; override; end; tjvmasnode = class(tcgasnode) @@ -408,8 +409,8 @@ implementation var - frominclass, - toinclass: boolean; + fromclasscompatible, + toclasscompatible: boolean; fromdef, todef: tdef; begin @@ -421,14 +422,17 @@ implementation { don't allow conversions between object-based and non-object-based types } - frominclass:= + fromclasscompatible:= (left.resultdef.typ=objectdef) or - is_dynamic_array(left.resultdef); - toinclass:= + is_dynamic_array(left.resultdef) or + ((left.resultdef.typ=recorddef) and + (resultdef.typ=objectdef)); + toclasscompatible:= (resultdef.typ=objectdef) or - is_dynamic_array(resultdef); - if frominclass and - toinclass then + is_dynamic_array(resultdef) or + ((resultdef.typ=recorddef) and + (left.resultdef.typ=objectdef)); + if fromclasscompatible and toclasscompatible then begin { we need an as-node to check the validity of the conversion (since it wasn't handled by another type conversion, we know it can't @@ -439,9 +443,10 @@ implementation fromdef:=left.resultdef; todef:=resultdef; get_most_nested_types(fromdef,todef); - if ((fromdef.typ<>objectdef) and - not is_dynamic_array(fromdef)) or - (todef<>java_jlobject) then + if not left.resultdef.is_related(resultdef) and + (((fromdef.typ<>objectdef) and + not is_dynamic_array(fromdef)) or + (todef<>java_jlobject)) then begin result:=ctypenode.create(resultdef); if resultdef.typ=objectdef then @@ -489,6 +494,26 @@ implementation end; + function tjvmtypeconvnode.target_specific_general_typeconv(var res: tnode): boolean; + begin + result:=false; + { deal with explicit typecasts between records and classes (for + FpcBaseRecordType) } + if ((left.resultdef.typ=recorddef) and + (resultdef.typ=objectdef) and + left.resultdef.is_related(resultdef)) or + ((left.resultdef.typ=objectdef) and + (resultdef.typ=recorddef) and + resultdef.is_related(left.resultdef)) and + (nf_explicit in flags) then + begin + convtype:=tc_equal; + res:=target_specific_explicit_typeconv; + result:=true; + end; + end; + + {***************************************************************************** AsNode and IsNode common helpers *****************************************************************************} @@ -496,16 +521,29 @@ implementation function asis_target_specific_typecheck(node: tasisnode): boolean; var fromelt, toelt: tdef; + realfromdef, + realtodef: tdef; begin + realfromdef:=maybe_find_real_class_definition(node.left.resultdef,false); + realtodef:=maybe_find_real_class_definition(node.right.resultdef,false); + + if is_record(realtodef) then + result:= + (realfromdef=java_jlobject) or + (realfromdef=java_fpcbaserecordtype) + else if is_record(realfromdef) then + result:= + (realtodef=java_jlobject) or + (realtodef=java_fpcbaserecordtype) { dynamic arrays can be converted to java.lang.Object and vice versa } - if node.right.resultdef=java_jlobject then + else if realtodef=java_jlobject then { dynamic array to java.lang.Object } - result:=is_dynamic_array(node.left.resultdef) - else if is_dynamic_array(node.right.resultdef) then + result:=is_dynamic_array(realfromdef) + else if is_dynamic_array(realtodef) then begin { to dynamic array: only if possibly valid } fromelt:=node.left.resultdef; - toelt:=node.right.resultdef; + toelt:=realtodef; get_most_nested_types(fromelt,toelt); { final levels must be convertable: a) from array (dynamic or not) to java.lang.Object or vice versa, @@ -531,10 +569,10 @@ implementation if result then if node.nodetype=asn then begin - if node.right.resultdef.typ<>classrefdef then - node.resultdef:=node.right.resultdef + if realtodef.typ<>classrefdef then + node.resultdef:=realtodef else - node.resultdef:=tclassrefdef(node.right.resultdef).pointeddef + node.resultdef:=tclassrefdef(realtodef).pointeddef end else node.resultdef:=pasbool8type; @@ -559,8 +597,8 @@ implementation checkdef:=tclassrefdef(node.right.resultdef).pointeddef else checkdef:=node.right.resultdef; - if checkdef.typ=objectdef then - current_asmdata.CurrAsmList.concat(taicpu.op_sym(opcode,current_asmdata.RefAsmSymbol(tobjectdef(checkdef).jvm_full_typename(true)))) + if checkdef.typ in [objectdef,recorddef] then + current_asmdata.CurrAsmList.concat(taicpu.op_sym(opcode,current_asmdata.RefAsmSymbol(tabstractrecorddef(checkdef).jvm_full_typename(true)))) else current_asmdata.CurrAsmList.concat(taicpu.op_sym(opcode,current_asmdata.RefAsmSymbol(jvmencodetype(checkdef)))); location_reset(node.location,LOC_REGISTER,OS_ADDR); diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas index 7fcd537238..f3039509b5 100644 --- a/compiler/ncnv.pas +++ b/compiler/ncnv.pas @@ -116,6 +116,14 @@ interface function _typecheck_interface_to_variant : tnode; function _typecheck_array_2_dynarray : tnode; protected + { always called before any other type conversion checks. If it + returns true, the type conversion is ok and no further checks/ + handling are required. "res" can be set to a node that should + replace the type conversion node, but this is not required } + function target_specific_general_typeconv(var res: tnode): boolean;virtual; + { called in case of a valid explicit type conversion. Can be used to + replace this explicit type conversion with a different node, or to + reject it after all } function target_specific_explicit_typeconv: tnode;virtual; function first_int_to_int : tnode;virtual; function first_cstring_to_pchar : tnode;virtual; @@ -1771,6 +1779,12 @@ implementation end; + function ttypeconvnode.target_specific_general_typeconv(var res: tnode): boolean; + begin + result:=false; + end; + + function ttypeconvnode.target_specific_explicit_typeconv: tnode; begin result:=nil; @@ -1954,6 +1968,9 @@ implementation typecheckpass(left); end; + if target_specific_general_typeconv(result) then + exit; + if convtype=tc_none then begin cdoptions:=[cdo_check_operator,cdo_allow_variant,cdo_warn_incompatible_univ]; diff --git a/compiler/symtable.pas b/compiler/symtable.pas index e4754944d8..6d3dcb91a8 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -252,6 +252,7 @@ interface {*** Object Helpers ***} function search_default_property(pd : tabstractrecorddef) : tpropertysym; + function maybe_find_real_class_definition(pd: tdef; erroronfailure: boolean): tdef; function find_real_class_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef; {*** Macro Helpers ***} @@ -2129,6 +2130,15 @@ implementation end; + function maybe_find_real_class_definition(pd: tdef; erroronfailure: boolean): tdef; + begin + result:=pd; + if pd.typ<>objectdef then + exit; + result:=find_real_class_definition(tobjectdef(pd),erroronfailure); + end; + + function find_real_class_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef; var hashedid : THashedIDString;