[gcc/devel/omp/gcc-9] backport: re PR fortran/68544 (ICE trying to pass derived type constructor as a function)

[Tobias Burnus]

https://gcc.gnu.org/g:8cb98c28f2c59ace1ed0c4a654cecd76ca1403fc

commit 8cb98c28f2c59ace1ed0c4a654cecd76ca1403fc
Author: Steven G. Kargl <kargl@gcc.gnu.org>
Date:   Thu Jun 20 23:15:32 2019 +0000

    backport: re PR fortran/68544 (ICE trying to pass derived type constructor as a function)
    
    2019-06-20  Steven G. Kargl  <kargl@gcc.gnu.org>
    
    	Backport from mainline
    	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-20  Steven G. Kargl  <kargl@gcc.gnu.org>
    
    	Backport from mainline
    	PR fortran/68544
    	* gfortran.dg/pr68544.f90: New test.
    	* gfortran.dg/pr85687.f90: Modify test for new error message.
    
    From-SVN: r272529

Diff:
---
 gcc/fortran/ChangeLog                 |  8 ++++++++
 gcc/fortran/resolve.c                 | 26 ++++++++++++++++++++++++++
 gcc/testsuite/ChangeLog               |  7 +++++++
 gcc/testsuite/gfortran.dg/pr68544.f90 | 13 +++++++++++++
 gcc/testsuite/gfortran.dg/pr85687.f90 |  2 +-
 5 files changed, 55 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index dc95210..087a1fd 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,6 +1,14 @@
 2019-06-20  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	Backport from mainline
+	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-20  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	Backport from mainline
 	* arith.c (arith_power): Rework overflow of an integer to an integer
 	exponent.
 
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 8232deb..c565325 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -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, procedure_type ptype,
 
       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)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 83ca428..7e17f67 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,6 +1,13 @@
 2019-06-20  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	Backport from mainline
+	PR fortran/68544
+	* gfortran.dg/pr68544.f90: New test.
+	* gfortran.dg/pr85687.f90: Modify test for new error message.
+
+2019-06-20  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	Backport from mainline
 	* gfortran.dg/integer_exponentiation_4.f90: Update test.
 	* gfortran.dg/integer_exponentiation_5.F90: Ditto.
 	* gfortran.dg/no_range_check_1.f90: Ditto.
diff --git a/gcc/testsuite/gfortran.dg/pr68544.f90 b/gcc/testsuite/gfortran.dg/pr68544.f90
new file mode 100644
index 0000000..3b17e2a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr68544.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/pr85687.f90 b/gcc/testsuite/gfortran.dg/pr85687.f90
index 03bc211..410b2b2 100644
--- a/gcc/testsuite/gfortran.dg/pr85687.f90
+++ b/gcc/testsuite/gfortran.dg/pr85687.f90
@@ -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