@@ -184,8 +184,11 @@ gfc_typename (gfc_typespec *ts, bool for_hash)
break;
}
ts1 = ts->u.derived->components ? &ts->u.derived->components->ts : NULL;
- if (ts1 && ts1->u.derived && ts1->u.derived->attr.unlimited_polymorphic)
- sprintf (buffer, "CLASS(*)");
+ if (ts1 && ts1->u.derived)
+ if (ts1->u.derived->attr.unlimited_polymorphic)
+ sprintf (buffer, "CLASS(*)");
+ else
+ sprintf (buffer, "CLASS(%s)", ts1->u.derived->name);
else
sprintf (buffer, "CLASS(%s)", ts->u.derived->name);
break;
new file mode 100644
@@ -0,0 +1,41 @@
+! { dg-do compile }
+!
+! Test fix for PR96870
+!
+
+Program main_p
+
+ implicit none
+
+ Type :: t0
+ End Type t0
+
+ Type, extends(t0) :: t1
+ End Type t1
+
+ type(t0), target :: x
+ class(t0), pointer :: p
+
+ p => x
+ Call sub_1(x) ! { dg-error "Type mismatch in argument .p. at .1.; passed TYPE\\(t0\\) to CLASS\\(t1\\)" }
+ Call sub_1(p) ! { dg-error "Type mismatch in argument .p. at .1.; passed CLASS\\(t0\\) to CLASS\\(t1\\)" }
+ Call sub_2(x) ! { dg-error "Type mismatch in argument .p. at .1.; passed TYPE\\(t0\\) to TYPE\\(t1\\)" }
+ Call sub_2(p) ! { dg-error "Type mismatch in argument .p. at .1.; passed CLASS\\(t0\\) to TYPE\\(t1\\)" }
+ stop
+
+Contains
+
+ Subroutine sub_1(p)
+ class(t1), Intent(In) :: p
+
+ return
+ End Subroutine sub_1
+
+ Subroutine sub_2(p)
+ type(t1), Intent(In) :: p
+
+ return
+ End Subroutine sub_2
+
+End Program main_p
+
*PING* -------- Forwarded Message -------- Subject: [Patch, fortran] PR fortran/96870 - Class name on error message Date: Mon, 31 Aug 2020 16:09:32 +0000 From: José Rui Faustino de Sousa <jrfsousa@gmail.com> To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Hi all! Proposed patch to PR96870 - Class name on error message. Patch tested only on x86_64-pc-linux-gnu. Make the error message more intelligible for the average user. Thank you very much. Best regards, José Rui 2020-8-21 José Rui Faustino de Sousa <jrfsousa@gmail.com> gcc/fortran/ChangeLog: PR fortran/96870 * misc.c (gfc_typename): use class name instead of internal name on error message. gcc/testsuite/ChangeLog: PR fortran/96870 * gfortran.dg/PR96870.f90: New test.