diff mbox series

PR fortran/68544 -- A derived type cannot be actual argument

Message ID 20190612224449.GA9159@troutmask.apl.washington.edu
State New
Headers show
Series PR fortran/68544 -- A derived type cannot be actual argument | expand

Commit Message

Steve Kargl June 12, 2019, 10:44 p.m. UTC
The attach patch has been sitting in my tree for a year.
It has been tested and updated as others have changed 
the gfortran code.  The patch has been compiled and
regression tested on x86_64-*-freebsd.  OK to commit?

Either testcase should provide sufficient information
about the problem that this patch fixes.

2019-06-12  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/68544
	* resolve.c (is_dt_name): New function to compare symbol name against
	list of derived types.
	(resolve_actual_arglist): Use it to find wrong code.

2019-06-12  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/68544
	* gfortran.dg/pr68544.f90: New test.
	* gfortran.dg/pr85687.f90: Modify test for new error message.

Comments

Paul Richard Thomas June 13, 2019, 5:18 a.m. UTC | #1
Hi Steve,

That's good to go - thanks

Paul

On Wed, 12 Jun 2019 at 23:44, Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
>
> The attach patch has been sitting in my tree for a year.
> It has been tested and updated as others have changed
> the gfortran code.  The patch has been compiled and
> regression tested on x86_64-*-freebsd.  OK to commit?
>
> Either testcase should provide sufficient information
> about the problem that this patch fixes.
>
> 2019-06-12  Steven G. Kargl  <kargl@gcc.gnu.org>
>
>         PR fortran/68544
>         * resolve.c (is_dt_name): New function to compare symbol name against
>         list of derived types.
>         (resolve_actual_arglist): Use it to find wrong code.
>
> 2019-06-12  Steven G. Kargl  <kargl@gcc.gnu.org>
>
>         PR fortran/68544
>         * gfortran.dg/pr68544.f90: New test.
>         * gfortran.dg/pr85687.f90: Modify test for new error message.
>
>
> --
> Steve
diff mbox series

Patch

Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 272219)
+++ gcc/fortran/resolve.c	(working copy)
@@ -1862,6 +1862,25 @@  resolve_procedure_expression (gfc_expr* expr)
 }
 
 
+/* Check that name is not a derived type.  */
+ 
+static bool
+is_dt_name (const char *name)
+{
+  gfc_symbol *dt_list, *dt_first;
+
+  dt_list = dt_first = gfc_derived_types;
+  for (; dt_list; dt_list = dt_list->dt_next)
+    {
+      if (strcmp(dt_list->name, name) == 0)
+	return true;
+      if (dt_first == dt_list->dt_next)
+	break;
+    }
+  return false;
+}
+
+
 /* Resolve an actual argument list.  Most of the time, this is just
    resolving the expressions in the list.
    The exception is that we sometimes have to decide whether arguments
@@ -1923,6 +1942,13 @@  resolve_actual_arglist (gfc_actual_arglist *arg, proce
 
       sym = e->symtree->n.sym;
 
+      if (sym->attr.flavor == FL_PROCEDURE && is_dt_name (sym->name))
+	{
+	  gfc_error ("Derived type %qs is used as an actual "
+		     "argument at %L", sym->name, &e->where);
+	  goto cleanup;
+	}
+
       if (sym->attr.flavor == FL_PROCEDURE
 	  || sym->attr.intrinsic
 	  || sym->attr.external)
Index: gcc/testsuite/gfortran.dg/pr68544.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr68544.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr68544.f90	(working copy)
@@ -0,0 +1,13 @@ 
+! { dg-do compile }
+! PF fortran/68544
+program p
+   real x
+   type t
+   end type
+   x = f(t)             ! { dg-error "used as an actual argument" }
+end
+subroutine b
+   type t
+   end type
+   print *, shape(t)    ! { dg-error "used as an actual argument" }
+end
Index: gcc/testsuite/gfortran.dg/pr85687.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr85687.f90	(revision 272219)
+++ gcc/testsuite/gfortran.dg/pr85687.f90	(working copy)
@@ -4,5 +4,5 @@ 
 program p
    type t
    end type
-   print *, rank(t)  ! { dg-error "must be a data object" }
+   print *, rank(t)  ! { dg-error "used as an actual argument" }
 end