]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
backport: re PR fortran/89344 (uncaught programmer error: polymorphic variable is...
authorSteven G. Kargl <kargl@gcc.gnu.org>
Fri, 21 Jun 2019 00:24:53 +0000 (00:24 +0000)
committerSteven G. Kargl <kargl@gcc.gnu.org>
Fri, 21 Jun 2019 00:24:53 +0000 (00:24 +0000)
2019-06-20  Steven G. Kargl  <kargl@gcc.gnu.org>

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

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

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

From-SVN: r272539

gcc/fortran/ChangeLog
gcc/fortran/expr.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/pr89344.f90 [new file with mode: 0644]

index 7bb5d24903053eb95aa9bacf79d17de20348e954..c5a86631a12dc425904fab0b7d1335c2b08ac016 100644 (file)
@@ -1,3 +1,10 @@
+2019-06-20  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       Backport from mainline
+       PR fortran/89344
+       * expr.c (gfc_check_vardef_context): Check for INTENT(IN) variable
+       in SELECT TYPE construct.
+
 2019-06-20  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        Backport from mainline
index 474e9ecc40136422a5354ddb1ef1c47c02e0398d..4579d82501f911f9ac3146afa64960119d46fe17 100644 (file)
@@ -6086,7 +6086,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)
        {
@@ -6098,10 +6103,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;
        }
     }
index f74e5efa8024d51b8c2cbfb5f91ccbb025d3f2dd..f5466c0d3d3adce9ec7fa383c3720cdd07d63239 100644 (file)
@@ -1,3 +1,9 @@
+2019-06-20  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       Backport from mainline
+       PR fortran/89344
+       * gfortran.dg/pr89344.f90: New test.
+
 2019-06-20  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        Backport from mainline
diff --git a/gcc/testsuite/gfortran.dg/pr89344.f90 b/gcc/testsuite/gfortran.dg/pr89344.f90
new file mode 100644 (file)
index 0000000..8749071
--- /dev/null
@@ -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