[Bug fortran/55901] [OOP] type is (character(len=*)) misinterpreted as array

[Dominique Dhumieres]

Dear Paul,

> Please find attached an extended version of your patch for PR60255. It
> incorporates the patch for PR55901. ...
> The upshot of all of this is that
> ftp://ftp.numerical.rl.ac.uk/pub/MRandC/oo.f90 , pointed to in comment
> #5 of PR59901 now runs correctly; or, rather, produces the same output
> as ifort.

I confirm the above. However I got four ICEs not present with the latest Andre's
patch:
(1) the second test in pr57305 (at https://gcc.gnu.org/bugzilla/attachment.cgi?id=30136);
(2) the original test for pr60255;
(3) the tests in pr61337.

All these ICEs disappear if I revert the hunk

@@ -5248,7 +5342,17 @@ gfc_trans_allocate (gfc_code * code)
 	  /* Initialization via SOURCE block
 	     (or static default initializer).  */
 	  gfc_expr *rhs = gfc_copy_expr (code->expr3);
-	  if (class_expr != NULL_TREE)
+
+	  if (UNLIMITED_POLY (code->expr3))
+	    {
+	      sz = gfc_copy_expr (code->expr3);
+	      gfc_add_data_component (sz);
+	      gfc_init_se (&se_sz, NULL);
+	      gfc_conv_expr (&se_sz, sz);
+	      gfc_free_expr (sz);
+	      tmp = gfc_build_memcpy_call (se.expr, se_sz.expr, memsz);
+	    }
+	  else if (class_expr != NULL_TREE)
 	    {
 	      tree to;
 	      to = TREE_OPERAND (se.expr, 0);

for gcc/fortran/trans-stmt.c.

The ICE for (3) occurs when executing the line

              gfc_conv_expr (&se_sz, sz);

for (1) when executing the line

              tmp = gfc_build_memcpy_call (se.expr, se_sz.expr, memsz);

and for (2) after it.

I also see the following error

          call sub3(x%sub1) 
                   1
Error: Interface mismatch in dummy procedure 'sub4' at (1): Type mismatch in function result (INTEGER(8)/CLASS(*))

for the test

module m1 
   implicit none 
   abstract interface 
      function sub1(x) bind(C) 
         use ISO_C_BINDING 
         integer(C_INTPTR_T) sub1 
         integer(C_INT) x 
      end function sub1 
   end interface 
   type T 
      procedure(sub1),pointer,NOPASS :: sub1 
   end type T 
end module m1 
module m2 
   use m1 
   implicit none 
   contains 
      subroutine sub2(x) 
         type(T) x 
         call sub3(x%sub1) 
      end subroutine sub2 
      subroutine sub3(sub4) 
         external sub4 
         pointer sub4 
         class(*) sub4 
      end subroutine sub3 
end module m2 

with/without the hunk above.

Cheers,

Dominique