diff --git a/compiler/defcmp.pas b/compiler/defcmp.pas index 446d8e6a64..1a05ee72fd 100644 --- a/compiler/defcmp.pas +++ b/compiler/defcmp.pas @@ -90,7 +90,8 @@ interface tc_enum_2_variant, tc_interface_2_variant, tc_variant_2_interface, - tc_array_2_dynarray + tc_array_2_dynarray, + tc_elem_2_openarray ); function compare_defs_ext(def_from,def_to : tdef; @@ -680,7 +681,7 @@ implementation (def_from.typ=tarraydef(def_to).elementdef.typ) and equal_defs(def_from,tarraydef(def_to).elementdef) then begin - doconv:=tc_equal; + doconv:=tc_elem_2_openarray; { also update in htypechk.pas/var_para_allowed if changed here } eq:=te_convert_l3; diff --git a/compiler/jvm/njvmcnv.pas b/compiler/jvm/njvmcnv.pas index 3120e5ab14..3fbe0f5abb 100644 --- a/compiler/jvm/njvmcnv.pas +++ b/compiler/jvm/njvmcnv.pas @@ -54,6 +54,7 @@ interface { procedure second_pchar_to_string;override; } { procedure second_class_to_intf;override; } { procedure second_char_to_char;override; } + procedure second_elem_to_openarray; override; function target_specific_explicit_typeconv: boolean; override; function target_specific_general_typeconv: boolean; override; protected @@ -443,6 +444,36 @@ implementation end; + procedure tjvmtypeconvnode.second_elem_to_openarray; + var + primitivetype: boolean; + opc: tasmop; + mangledname: string; + basereg: tregister; + arrayref: treference; + begin + { create an array with one element of the required type } + thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,s32inttype,1,R_INTREGISTER); + mangledname:=jvmarrtype(left.resultdef,primitivetype); + if primitivetype then + opc:=a_newarray + else + opc:=a_anewarray; + { doesn't change stack height: one int replaced by one reference } + current_asmdata.CurrAsmList.concat(taicpu.op_sym(opc,current_asmdata.RefAsmSymbol(mangledname))); + { store the data in the newly created array } + basereg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlobject); + thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,java_jlobject,basereg); + reference_reset_base(arrayref,basereg,0,4); + arrayref.arrayreftype:=art_indexconst; + arrayref.indexoffset:=0; + hlcg.a_load_loc_ref(current_asmdata.CurrAsmList,left.resultdef,left.resultdef,left.location,arrayref); + location_reset_ref(location,LOC_REFERENCE,OS_ADDR,4); + tg.gethltemp(current_asmdata.CurrAsmList,java_jlobject,4,tt_normal,location.reference); + hlcg.a_load_reg_ref(current_asmdata.CurrAsmList,java_jlobject,java_jlobject,basereg,location.reference); + end; + + procedure get_most_nested_types(var fromdef, todef: tdef); begin while is_dynamic_array(fromdef) and diff --git a/compiler/ncgcnv.pas b/compiler/ncgcnv.pas index d5de1525be..8410d199e1 100644 --- a/compiler/ncgcnv.pas +++ b/compiler/ncgcnv.pas @@ -50,6 +50,7 @@ interface procedure second_ansistring_to_pchar;override; procedure second_class_to_intf;override; procedure second_char_to_char;override; + procedure second_elem_to_openarray;override; procedure second_nothing;override; procedure pass_generate_code;override; {$ifdef cpuflags} @@ -705,6 +706,12 @@ interface internalerror(2007081202); end; + procedure tcgtypeconvnode.second_elem_to_openarray; + begin + { nothing special to do by default } + second_nothing; + end; + procedure tcgtypeconvnode.second_nothing; var diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas index 61abcd6f8c..7df480320e 100644 --- a/compiler/ncnv.pas +++ b/compiler/ncnv.pas @@ -95,6 +95,7 @@ interface function typecheck_variant_to_interface : tnode; virtual; function typecheck_interface_to_variant : tnode; virtual; function typecheck_array_2_dynarray : tnode; virtual; + function typecheck_elem_2_openarray : tnode; virtual; private function _typecheck_int_to_int : tnode; function _typecheck_cord_to_pointer : tnode; @@ -124,6 +125,7 @@ interface function _typecheck_variant_to_interface : tnode; function _typecheck_interface_to_variant : tnode; function _typecheck_array_2_dynarray : tnode; + function _typecheck_elem_2_openarray : tnode; protected function first_int_to_int : tnode;virtual; function first_cstring_to_pchar : tnode;virtual; @@ -199,6 +201,7 @@ interface procedure _second_ansistring_to_pchar;virtual; procedure _second_class_to_intf;virtual; procedure _second_char_to_char;virtual; + procedure _second_elem_to_openarray;virtual; procedure _second_nothing; virtual; protected @@ -223,6 +226,7 @@ interface procedure second_ansistring_to_pchar;virtual;abstract; procedure second_class_to_intf;virtual;abstract; procedure second_char_to_char;virtual;abstract; + procedure second_elem_to_openarray;virtual;abstract; procedure second_nothing; virtual;abstract; end; ttypeconvnodeclass = class of ttypeconvnode; @@ -904,7 +908,8 @@ implementation 'tc_enum_2_variant', 'tc_interface_2_variant', 'tc_variant_2_interface', - 'tc_array_2_dynarray' + 'tc_array_2_dynarray', + 'tc_elem_2_openarray' ); begin inherited printnodeinfo(t); @@ -1619,6 +1624,12 @@ implementation end; + function ttypeconvnode.typecheck_elem_2_openarray : tnode; + begin + result:=nil; + end; + + function ttypeconvnode._typecheck_int_to_int : tnode; begin result := typecheck_int_to_int; @@ -1787,6 +1798,12 @@ implementation end; + function ttypeconvnode._typecheck_elem_2_openarray : tnode; + begin + result := typecheck_elem_2_openarray; + end; + + function ttypeconvnode.target_specific_general_typeconv: boolean; begin result:=false; @@ -1901,7 +1918,8 @@ implementation { enum_2_variant} @ttypeconvnode._typecheck_enum_to_variant, { variant_2_interface} @ttypeconvnode._typecheck_interface_to_variant, { interface_2_variant} @ttypeconvnode._typecheck_variant_to_interface, - { array_2_dynarray} @ttypeconvnode._typecheck_array_2_dynarray + { array_2_dynarray} @ttypeconvnode._typecheck_array_2_dynarray, + { elem_2_openarray } @ttypeconvnode._typecheck_elem_2_openarray ); type tprocedureofobject = function : tnode of object; @@ -3281,7 +3299,8 @@ implementation nil, nil, nil, - nil + nil, + @ttypeconvnode._first_nothing ); type tprocedureofobject = function : tnode of object; @@ -3490,6 +3509,12 @@ implementation end; + procedure ttypeconvnode._second_elem_to_openarray; + begin + second_elem_to_openarray; + end; + + procedure ttypeconvnode._second_nothing; begin second_nothing; @@ -3538,7 +3563,8 @@ implementation @ttypeconvnode._second_nothing, { enum_2_variant } @ttypeconvnode._second_nothing, { variant_2_interface } @ttypeconvnode._second_nothing, { interface_2_variant } - @ttypeconvnode._second_nothing { array_2_dynarray } + @ttypeconvnode._second_nothing, { array_2_dynarray } + @ttypeconvnode._second_elem_to_openarray { elem_2_openarray } ); type tprocedureofobject = procedure of object;