diff mbox series

PR fortran/89344 -- INTENT(IN) CLASS(*) cannot be assigned to

Message ID 20190612184209.GA48014@troutmask.apl.washington.edu
State New
Headers show
Series PR fortran/89344 -- INTENT(IN) CLASS(*) cannot be assigned to | expand

Commit Message

Steve Kargl June 12, 2019, 6:42 p.m. UTC 
The attach patch has lived in my tree for 4 months.
It's time to submit it.  Passed regression testing
for a long time.

An INTENT(in) entity that has CLASS(*) dummy argument
should not use SELECT TYPE to then try to assign to the
entity.  OK to commit?

2019-06-12  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-12  Steven G. Kargl  <kargl@gcc.gnu.org>

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

Comments

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

OK - thanks

Paul

On Wed, 12 Jun 2019 at 19:42, Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
>
> The attach patch has lived in my tree for 4 months.
> It's time to submit it.  Passed regression testing
> for a long time.
>
> An INTENT(in) entity that has CLASS(*) dummy argument
> should not use SELECT TYPE to then try to assign to the
> entity.  OK to commit?
>
> 2019-06-12  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-12  Steven G. Kargl  <kargl@gcc.gnu.org>
>
>         PR fortran/89344
>         * gfortran.dg/pr89344.f90: New test.
>
> --
> Steve
diff mbox series

Patch

Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c	(revision 270774)
+++ gcc/fortran/expr.c	(working copy)
@@ -6086,7 +6095,12 @@  gfc_check_vardef_context (gfc_expr* e, bool pointer, b
 	    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)
 	{
@@ -6098,10 +6112,12 @@  gfc_check_vardef_context (gfc_expr* e, bool pointer, b
 	}
       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;
 	}
     }
Index: /safe/sgk/gcc/gccx/gcc/testsuite/gfortran.dg/pr89344.f90
===================================================================
--- /safe/sgk/gcc/gccx/gcc/testsuite/gfortran.dg/pr89344.f90	(nonexistent)
+++ /safe/sgk/gcc/gccx/gcc/testsuite/gfortran.dg/pr89344.f90	(working copy)
@@ -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