diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index bc7aac1f3d912cf35480a05ed78f74f519ab2ec2..9f21b3ee780fe9a442bc8e14976496d7015b6595 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -3152,14 +3152,14 @@ gfc_get_function_type (gfc_symbol * sym, gfc_actual_arglist *actual_args,
 	vec_safe_push (typelist, boolean_type_node);
       /* Coarrays which are descriptorless or assumed-shape pass with
 	 -fcoarray=lib the token and the offset as hidden arguments.  */
-      else if (arg
-	       && flag_coarray == GFC_FCOARRAY_LIB
-	       && ((arg->ts.type != BT_CLASS
-		    && arg->attr.codimension
-		    && !arg->attr.allocatable)
-		   || (arg->ts.type == BT_CLASS
-		       && CLASS_DATA (arg)->attr.codimension
-		       && !CLASS_DATA (arg)->attr.allocatable)))
+      if (arg
+	  && flag_coarray == GFC_FCOARRAY_LIB
+	  && ((arg->ts.type != BT_CLASS
+	       && arg->attr.codimension
+	       && !arg->attr.allocatable)
+	      || (arg->ts.type == BT_CLASS
+		  && CLASS_DATA (arg)->attr.codimension
+		  && !CLASS_DATA (arg)->attr.allocatable)))
 	{
 	  vec_safe_push (typelist, pvoid_type_node);  /* caf_token.  */
 	  vec_safe_push (typelist, gfc_array_index_type);  /* caf_offset.  */
diff --git a/gcc/testsuite/gfortran.dg/coarray/dummy_2.f90 b/gcc/testsuite/gfortran.dg/coarray/dummy_2.f90
new file mode 100644
index 0000000000000000000000000000000000000000..35263745bb8b89427b9f38212b405aae2b1db82d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/dummy_2.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+!
+! PR fortran/99817
+!
+! Contributed by G. Steinmetz
+!
+subroutine s1 (x)
+   character(*) :: x(*)[*]
+end
+
+subroutine s2 (x)
+   character(*), dimension(*), codimension[*] :: x
+   integer :: i
+   i = len(x)
+end
+
+subroutine s3 (x, y)
+   character(*), dimension(:) :: x[*]
+   character(*) :: y
+end
+
+subroutine s4 (x, y, z)
+   character(*), dimension(:) :: x[2, *]
+   character(*), dimension(*) :: y
+   character(*) :: z
+end