Fortran: fix issue with impure elemental subroutine and interface [PR119656]

	PR fortran/119656

gcc/fortran/ChangeLog:

	* interface.cc (gfc_compare_actual_formal): Fix front-end memleak
	when searching for matching interfaces.
	* trans-expr.cc (gfc_conv_procedure_call): If there is a formal
	dummy corresponding to an absent argument, use its type, and only
	fall back to inferred type otherwise.

gcc/testsuite/ChangeLog:

	* gfortran.dg/optional_absent_13.f90: New test.

3 files changed, 65 insertions, 7 deletions

diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index 6258a41..c702239 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -3382,7 +3382,11 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	  return false;
 	}
       else
-	a->associated_dummy = get_nonintrinsic_dummy_arg (f);
+	{
+	  if (a->associated_dummy)
+	    free (a->associated_dummy);
+	  a->associated_dummy = get_nonintrinsic_dummy_arg (f);
+	}
 
       if (a->expr == NULL)
 	{
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 6ece39b..62dd38d 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6925,10 +6925,18 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		{
 		  /* Pass a NULL pointer for an absent arg.  */
 		  parmse.expr = null_pointer_node;
+
+		  /* Is it an absent character dummy?  */
+		  bool absent_char = false;
 		  gfc_dummy_arg * const dummy_arg = arg->associated_dummy;
-		  if (dummy_arg
-		      && gfc_dummy_arg_get_typespec (*dummy_arg).type
-			 == BT_CHARACTER)
+
+		  /* Fall back to inferred type only if no formal.  */
+		  if (fsym)
+		    absent_char = (fsym->ts.type == BT_CHARACTER);
+		  else if (dummy_arg)
+		    absent_char = (gfc_dummy_arg_get_typespec (*dummy_arg).type
+				   == BT_CHARACTER);
+		  if (absent_char)
 		    parmse.string_length = build_int_cst (gfc_charlen_type_node,
 							  0);
 		}
@@ -6954,9 +6962,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 			  || !CLASS_DATA (fsym)->attr.allocatable));
 	  gfc_init_se (&parmse, NULL);
 	  parmse.expr = null_pointer_node;
-	  if (arg->associated_dummy
-	      && gfc_dummy_arg_get_typespec (*arg->associated_dummy).type
-		 == BT_CHARACTER)
+	  if (fsym->ts.type == BT_CHARACTER)
 	    parmse.string_length = build_int_cst (gfc_charlen_type_node, 0);
 	}
       else if (fsym && fsym->ts.type == BT_CLASS
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_13.f90 b/gcc/testsuite/gfortran.dg/optional_absent_13.f90
new file mode 100644
index 0000000..9c2039b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_13.f90
@@ -0,0 +1,48 @@
+! { dg-do run }
+! PR fortran/119656 - wrong code with impure elemental subroutine and interface
+!
+! Derived from testcase at:
+!   https://fortran-lang.discourse.group/t/
+!     problem-with-impure-elemental-subroutine-in-interface-with-gfortran/9545
+
+module m2
+  implicit none
+  interface foo
+     module procedure foo_mat
+     module procedure foo_df
+     module procedure foo_cmat
+  end interface foo
+contains
+
+  subroutine foo_mat(x, nacf, label)
+    real,             intent(in)           :: x(:,:)
+    integer,          intent(in)           :: nacf
+    character(len=*), intent(in), optional :: label
+  end subroutine foo_mat
+
+  impure elemental subroutine foo_df(nacf, outu, xstr)
+    integer         , intent(in)           :: nacf
+    integer         , intent(in), optional :: outu
+    character(len=*), intent(in), optional :: xstr
+    if (present(xstr)) then
+       if (len (xstr) /= 2) then
+          print *,"nacf, len(xstr) =", nacf, len(xstr)
+          stop nacf
+       end if
+    end if
+  end subroutine foo_df
+
+  subroutine foo_cmat(x, nacf, label)
+    complex,          intent(in)           :: x(:,:)
+    integer,          intent(in)           :: nacf
+    character(len=*), intent(in), optional :: label
+  end subroutine foo_cmat
+
+end module m2
+
+program main
+  use m2, only: foo, foo_df
+  implicit none
+  call foo_df(nacf = 1, xstr="ab")
+  call foo   (nacf = 2, xstr="ab")
+end program main