From: Steven G. Kargl <kargl@gcc.gnu.org>
Date: Thu, 13 Jun 2019 18:07:53 +0000 (+0000)
Subject: re PR fortran/89344 (uncaught programmer error:  polymorphic variable is INTENT(IN... 
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=b9fb83059d73733742f5511f9261111db8eddbfd;p=gcc.git

re PR fortran/89344 (uncaught programmer error:  polymorphic variable is INTENT(IN) but assigned to without error)

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

	PR fortran/89344
	* expr.c (gfc_check_vardef_context): Check for INTENT(IN) variable
	in SELECT TYPE construct.

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

	PR fortran/89344
	 * gfortran.dg/pr89344.f90: New test.

From-SVN: r272255
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ebff4278f5a..2b2395c68c1 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2019-06-13  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/89344
+	* expr.c (gfc_check_vardef_context): Check for INTENT(IN) variable
+	in SELECT TYPE construct.
+
 2019-06-13  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/88810
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 949eff19cdd..ec9e3288b48 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -6089,7 +6089,12 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
 	    check_intentin = false;
 	}
     }
-  if (check_intentin && sym->attr.intent == INTENT_IN)
+
+  if (check_intentin
+      && (sym->attr.intent == INTENT_IN
+	  || (sym->attr.select_type_temporary && sym->assoc
+	      && sym->assoc->target && sym->assoc->target->symtree
+	      && sym->assoc->target->symtree->n.sym->attr.intent == INTENT_IN)))
     {
       if (pointer && is_pointer)
 	{
@@ -6101,10 +6106,12 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
 	}
       if (!pointer && !is_pointer && !sym->attr.pointer)
 	{
+	  const char *name = sym->attr.select_type_temporary
+			   ? sym->assoc->target->symtree->name : sym->name;
 	  if (context)
 	    gfc_error ("Dummy argument %qs with INTENT(IN) in variable"
 		       " definition context (%s) at %L",
-		       sym->name, context, &e->where);
+		       name, context, &e->where);
 	  return false;
 	}
     }
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7ec2594ca88..1761ae7a90b 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-06-13  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/89344
+	* gfortran.dg/pr89344.f90: New test.
+
 2019-06-13  Iain Sandoe  <iain@sandoe.co.uk>
 
 	* gcc.dg/darwin-minversion-1.c: Use compile rather than link/run.
diff --git a/gcc/testsuite/gfortran.dg/pr89344.f90 b/gcc/testsuite/gfortran.dg/pr89344.f90
new file mode 100644
index 00000000000..8749071bd25
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr89344.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+program demo_setval
+   call setval(value)
+   write(*,*)'VALUE=',value
+   contains
+      subroutine setval(value)
+         class(*),intent(in) :: value
+         select type(value)
+            type is (integer)
+               value = 10     ! { dg-error "in variable definition context" }
+            type is (real)
+               value = 10.20  ! { dg-error "in variable definition context" }
+         end select
+      end subroutine setval
+end program demo_setval