Please find attached a fix for this PR.

I think the discussion of intent muddied the waters for this PR. As I understand it initialisation of variables implies the save attribute.  The save attribute is incompatible with the dummy attribute so an error should be output when initialisation is attempted for dummy variables.

Is this correct? If so OK to commit and backport?

make check-fortran doesn't produce any additional errors on x86_64.

Commit message:

Fortran  : accepts pointer initialization of DT dummy args PR45337

Initialisation of a variable results in an implicit save attribute
being added to the variable.  The save attribute is not allowed for
variables with the dummy attribute set.  Initialisation should be
rejected for dummy variables.

2020-07-09  Mark Eggleston <markeggles...@gcc.gnu.org>

gcc/fortran/

    PR fortran/45337
    * resolve.c (resolve_fl_variable): Remove type and intent
    checks from the check for dummy.

2020-07-09  Mark Eggleston <markeggles...@gcc.gnu.org>

gcc/testsuite/

    PR fortran/45337
    * gfortran.dg/pr45337_1.f90: New test.
    * gfortran.dg/pr45337_2.f90: New test.

--
https://www.codethink.co.uk/privacy.html

>From d77b47ea1de104ee960c0c952148f7f1500cf97a Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggles...@gcc.gnu.org>
Date: Wed, 10 Jun 2020 07:22:50 +0100
Subject: [PATCH] Fortran  : accepts pointer initialization of DT dummy args
 PR45337

Initialisation of a variable results in an implicit save attribute
being added to the variable.  The save attribute is not allowed for
variables with the dummy attribute set.  Initialisation should be
rejected for dummy variables.

2020-07-09  Mark Eggleston  <markeggles...@gcc.gnu.org>

gcc/fortran/

	PR fortran/45337
	* resolve.c (resolve_fl_variable): Remove type and intent
	checks from the check for dummy.

2020-07-09  Mark Eggleston  <markeggles...@gcc.gnu.org>

gcc/testsuite/

	PR fortran/45337
	* gfortran.dg/pr45337_1.f90: New test.
	* gfortran.dg/pr45337_2.f90: New test.
---
 gcc/fortran/resolve.c                   |  3 +--
 gcc/testsuite/gfortran.dg/pr45337_1.f90 | 14 ++++++++++++++
 gcc/testsuite/gfortran.dg/pr45337_2.f90 | 18 ++++++++++++++++++
 3 files changed, 33 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr45337_1.f90
 create mode 100644 gcc/testsuite/gfortran.dg/pr45337_2.f90

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 223dcccce91..730d11105bd 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -12918,8 +12918,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
       else if (sym->attr.external)
 	gfc_error ("External %qs at %L cannot have an initializer",
 		   sym->name, &sym->declared_at);
-      else if (sym->attr.dummy
-	&& !(sym->ts.type == BT_DERIVED && sym->attr.intent == INTENT_OUT))
+      else if (sym->attr.dummy)
 	gfc_error ("Dummy %qs at %L cannot have an initializer",
 		   sym->name, &sym->declared_at);
       else if (sym->attr.intrinsic)
diff --git a/gcc/testsuite/gfortran.dg/pr45337_1.f90 b/gcc/testsuite/gfortran.dg/pr45337_1.f90
new file mode 100644
index 00000000000..2bb8ff244cc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr45337_1.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+
+module ptrmod
+contains
+subroutine lengthX(x, i) ! { dg-error "Dummy 'x' at .1. cannot have an initializer" }
+   implicit none
+   real, pointer, intent(out) :: x(:)=>null()
+   integer :: i
+   x=>null()
+   allocate(x(i))
+   x=i
+end subroutine
+end module
+
diff --git a/gcc/testsuite/gfortran.dg/pr45337_2.f90 b/gcc/testsuite/gfortran.dg/pr45337_2.f90
new file mode 100644
index 00000000000..ca7a6f53ad6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr45337_2.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+
+type t
+end type t
+type t2
+  integer :: j = 7
+end type t2
+contains
+  subroutine x(a, b, c)
+    intent(out) :: a, b, c
+    type(t) :: a = t()
+    type(t2) :: b = t2()
+    type(t2) :: c
+  end subroutine x
+end
+
+! { dg-error "Dummy .a. at .1. cannot have an initializer" " " { target *-*-* } 9 }
+! { dg-error "Dummy .b. at .1. cannot have an initializer" " " { target *-*-* } 9 }
-- 
2.11.0

Reply via email to