* correctly handle explicit typecasts between records and jlobject/

fpcbaserecordtype for the JVM target (intercept in ncnv via new
    target_specific_general_typeconv helper, handle in as/is code)
  * not only check for related types in htypechk in case they are
    objdefs, but always do so (records are related to jlobject/fpcbaserecord
    on the JVM target)

git-svn-id: branches/jvmbackend@18458 -

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
+                        (fromdef.is_related(todef))) and
-                         (tobjectdef(fromdef).is_related(tobjectdef(todef))))) and
                     (fromdef.size<>todef.size) then
                   begin
                     { in TP it is allowed to typecast to smaller types. But the variable can't

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,
+        fromclasscompatible,
-        toinclass: boolean;
+        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);
+          is_dynamic_array(left.resultdef) or
-        toinclass:=
+          ((left.resultdef.typ=recorddef) and
+           (resultdef.typ=objectdef));
+        toclasscompatible:=
           (resultdef.typ=objectdef) or
-          is_dynamic_array(resultdef);
+          is_dynamic_array(resultdef) or
-        if frominclass and
+          ((resultdef.typ=recorddef) and
-           toinclass then
+           (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
+            if not left.resultdef.is_related(resultdef) and
-                not is_dynamic_array(fromdef)) or
+               (((fromdef.typ<>objectdef) and
-               (todef<>java_jlobject) then
+                 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)
+        result:=is_dynamic_array(realfromdef)
-      else if is_dynamic_array(node.right.resultdef) then
+      else if is_dynamic_array(realtodef) then
         begin
           { <x> 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
+            if realtodef.typ<>classrefdef then
-              node.resultdef:=node.right.resultdef
+              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
+      if checkdef.typ in [objectdef,recorddef] then
-        current_asmdata.CurrAsmList.concat(taicpu.op_sym(opcode,current_asmdata.RefAsmSymbol(tobjectdef(checkdef).jvm_full_typename(true))))
+        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);

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];

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;