[PATCH] fortran: [PR49802] Allow VALUE attribute on assumed-length CHARACTER and array dummies

Jerry D <[email protected]>
Newsgroups gmane.comp.gcc.patches,gmane.comp.gcc.fortran
Message-ID <[email protected]>
This is the next one up on my list. This bug has been around since July of 2011.

As stated in the PR, I rolled the two patches submitted there into one patch and 
started testing and digging on this. I had to do a lot of editing and messaging 
on this.  There are several more test cases.

See the attached diff.

Regression tested numerous times. Comments welcome.

OK for mainline?

Regards,

Jerry

---

     fortran: [PR49802] Allow VALUE attribute on assumed-length CHARACTER and 
array dummies

     Fortran 2003 prohibited VALUE on CHARACTER dummies of length other than
     one (C528) and on any array dummy (C527).  Fortran 2008 relaxed both
     restrictions with C557, prohibiting only assumed-size arrays, coarrays,
     and entities with a coarray ultimate component.  gfortran still rejected
     both cases; this patch implements the Fortran 2008 rules under
     gfc_notify_std, so -std=f2003 still rejects them, and consolidates the
     C-interop length checks into one "must have length one" condition.

     VALUE dummies of these kinds are still passed by reference (trans-types.cc),
     since VALUE now means copy-in-only semantics rather than pass-by-value of
     the raw data.  trans-expr.cc makes the copy: a caller-side VLA copy for
     non-constant-length CHARACTER dummies, and a private deep array copy via
     gfc_conv_subref_array_arg for array dummies, with no write-back to the
     actual argument.  A scalar actual argument sequence associated with an
     explicit-shape VALUE array dummy (F2023, 15.5.2.12) is copied by the new
     conv_seq_assoc_value_arg.  Neither copy is made when the actual argument
     is an absent optional one; fixing this exposed two latent bugs in the
     pass_optional path of gfc_conv_subref_array_arg.

             PR fortran/49802

     gcc/fortran/ChangeLog:

             * resolve.cc: Allow character(len=*) VALUE and a specified but
             non-constant length under Fortran 2008; consolidate the
             C-interop length checks into a single "must have length one"
             check ordered ahead of the Fortran 2008 allowance.  Allow VALUE
             on assumed-shape and explicit-shape array dummies under Fortran
             2008 (C557); reject it on assumed-size arrays, on array dummies
             of a BIND(C) procedure, and, as not yet implemented, on
             polymorphic array dummies.
             * symbol.cc (gfc_check_conflict): Remove the conflict between
             VALUE and DIMENSION; only VALUE and CODIMENSION remain mutually
             exclusive.
             * trans.h (gfc_conv_subref_array_arg): Add DEEP_COPY argument.
             * trans-expr.cc (gfc_conv_subref_array_arg): Take DEEP_COPY and
             pass it on to gfc_trans_scalar_assign; deallocate the allocatable
             components of the temporary after the call.  Dereference the
             descriptor when setting the pointer for an optional argument that
             is not also checked for contiguity, and pass the string length
             back to the caller's gfc_se.
             (has_value_array_dummy): New function.
             (conv_seq_assoc_value_arg): New function.  Copy the element
             sequence declared by a VALUE array dummy when the actual argument
             is a sequence associated scalar.
             (conv_dummy_value): For assumed-length or non-constant-length
             CHARACTER VALUE dummies, make a caller-side copy and pass its
             address; scale the copy size by the size of the character kind;
             suppress the copy and pass a null pointer and a zero length when
             the actual argument is an absent optional one.
             (gfc_conv_procedure_call): Request an interface mapping when a
             dummy is an explicit-shape VALUE array.  Call
             conv_seq_assoc_value_arg for a scalar actual argument passed to a
             VALUE array dummy.  For a VALUE array dummy, pass a private deep
             copy of the actual argument via gfc_conv_subref_array_arg with
             INTENT_IN, giving it the symbol of the actual argument so that an
             absent optional one suppresses the copy.
             * trans-types.cc (gfc_sym_type): Use byref=1 for assumed-length
             or non-constant-length VALUE character dummies and for VALUE
             array dummies, so the ABI still passes by reference.

     gcc/testsuite/ChangeLog:

             * gfortran.dg/value_3.f90: Remove now-invalid expectation that
             an explicit-shape array dummy with VALUE conflicts with
             DIMENSION; this combination is permitted (F2008, C557).
             * gfortran.dg/value_5.f90: Compile under -std=f2003 so the
             Fortran 2008 assumed-length VALUE relaxation is exercised as a
             rejection, and update the C-interop error expectation to match
             the consolidated diagnostic.
             * gfortran.dg/value_6.f90: New test - run test for correctness
             with assumed-length VALUE character dummies.
             * gfortran.dg/value_7.f90: New test - compile/error test for
             -std=f2003 rejection.
             * gfortran.dg/value_11.f90: New test - run test for correctness
             with a non-constant specified-length VALUE character dummy.
             * gfortran.dg/value_12.f90: New test - run test for VALUE on
             assumed-shape, explicit-shape, and non-contiguous array actuals.
             * gfortran.dg/value_13.f90: New test - compile test rejecting
             VALUE on an assumed-size array dummy under -std=f2008.
             * gfortran.dg/value_14.f90: New test - run test for a VALUE
             character dummy of a kind wider than one byte.
             * gfortran.dg/value_15.f90: New test - run test for a scalar
             actual argument sequence associated with a VALUE array dummy.
             * gfortran.dg/value_16.f90: New test - run test for the deep copy
             of a VALUE array dummy with allocatable components.
             * gfortran.dg/value_17.f90: New test - compile test rejecting
             VALUE array dummies in a BIND(C) procedure and polymorphic VALUE
             array dummies.
             * gfortran.dg/value_18.f90: New test - run test for an absent
             optional actual argument passed to an optional VALUE dummy.
             * gfortran.dg/assumed_rank_11.f90: Update expected diagnostic
             for VALUE on an assumed-rank dummy.
             * gfortran.dg/c-interop/c535a-2.f90: Likewise.
---
pr49802.diff (text/x-patch, 44.3 KB)
commit 772f8878be71fa2384069c4b5971f5edbc7e6da5
Author: Jerry DeLisle <[email protected]>
Date:   Fri Jun 12 10:27:40 2026 -0700

    fortran: [PR49802] Allow VALUE attribute on assumed-length CHARACTER and array dummies
    
    Fortran 2003 prohibited VALUE on CHARACTER dummies of length other than
    one (C528) and on any array dummy (C527).  Fortran 2008 relaxed both
    restrictions with C557, prohibiting only assumed-size arrays, coarrays,
    and entities with a coarray ultimate component.  gfortran still rejected
    both cases; this patch implements the Fortran 2008 rules under
    gfc_notify_std, so -std=f2003 still rejects them, and consolidates the
    C-interop length checks into one "must have length one" condition.
    
    VALUE dummies of these kinds are still passed by reference (trans-types.cc),
    since VALUE now means copy-in-only semantics rather than pass-by-value of
    the raw data.  trans-expr.cc makes the copy: a caller-side VLA copy for
    non-constant-length CHARACTER dummies, and a private deep array copy via
    gfc_conv_subref_array_arg for array dummies, with no write-back to the
    actual argument.  A scalar actual argument sequence associated with an
    explicit-shape VALUE array dummy (F2023, 15.5.2.12) is copied by the new
    conv_seq_assoc_value_arg.  Neither copy is made when the actual argument
    is an absent optional one; fixing this exposed two latent bugs in the
    pass_optional path of gfc_conv_subref_array_arg.
    
            PR fortran/49802
    
    gcc/fortran/ChangeLog:
    
            * resolve.cc: Allow character(len=*) VALUE and a specified but
            non-constant length under Fortran 2008; consolidate the
            C-interop length checks into a single "must have length one"
            check ordered ahead of the Fortran 2008 allowance.  Allow VALUE
            on assumed-shape and explicit-shape array dummies under Fortran
            2008 (C557); reject it on assumed-size arrays, on array dummies
            of a BIND(C) procedure, and, as not yet implemented, on
            polymorphic array dummies.
            * symbol.cc (gfc_check_conflict): Remove the conflict between
            VALUE and DIMENSION; only VALUE and CODIMENSION remain mutually
            exclusive.
            * trans.h (gfc_conv_subref_array_arg): Add DEEP_COPY argument.
            * trans-expr.cc (gfc_conv_subref_array_arg): Take DEEP_COPY and
            pass it on to gfc_trans_scalar_assign; deallocate the allocatable
            components of the temporary after the call.  Dereference the
            descriptor when setting the pointer for an optional argument that
            is not also checked for contiguity, and pass the string length
            back to the caller's gfc_se.
            (has_value_array_dummy): New function.
            (conv_seq_assoc_value_arg): New function.  Copy the element
            sequence declared by a VALUE array dummy when the actual argument
            is a sequence associated scalar.
            (conv_dummy_value): For assumed-length or non-constant-length
            CHARACTER VALUE dummies, make a caller-side copy and pass its
            address; scale the copy size by the size of the character kind;
            suppress the copy and pass a null pointer and a zero length when
            the actual argument is an absent optional one.
            (gfc_conv_procedure_call): Request an interface mapping when a
            dummy is an explicit-shape VALUE array.  Call
            conv_seq_assoc_value_arg for a scalar actual argument passed to a
            VALUE array dummy.  For a VALUE array dummy, pass a private deep
            copy of the actual argument via gfc_conv_subref_array_arg with
            INTENT_IN, giving it the symbol of the actual argument so that an
            absent optional one suppresses the copy.
            * trans-types.cc (gfc_sym_type): Use byref=1 for assumed-length
            or non-constant-length VALUE character dummies and for VALUE
            array dummies, so the ABI still passes by reference.
    
    gcc/testsuite/ChangeLog:
    
            * gfortran.dg/value_3.f90: Remove now-invalid expectation that
            an explicit-shape array dummy with VALUE conflicts with
            DIMENSION; this combination is permitted (F2008, C557).
            * gfortran.dg/value_5.f90: Compile under -std=f2003 so the
            Fortran 2008 assumed-length VALUE relaxation is exercised as a
            rejection, and update the C-interop error expectation to match
            the consolidated diagnostic.
            * gfortran.dg/value_6.f90: New test - run test for correctness
            with assumed-length VALUE character dummies.
            * gfortran.dg/value_7.f90: New test - compile/error test for
            -std=f2003 rejection.
            * gfortran.dg/value_11.f90: New test - run test for correctness
            with a non-constant specified-length VALUE character dummy.
            * gfortran.dg/value_12.f90: New test - run test for VALUE on
            assumed-shape, explicit-shape, and non-contiguous array actuals.
            * gfortran.dg/value_13.f90: New test - compile test rejecting
            VALUE on an assumed-size array dummy under -std=f2008.
            * gfortran.dg/value_14.f90: New test - run test for a VALUE
            character dummy of a kind wider than one byte.
            * gfortran.dg/value_15.f90: New test - run test for a scalar
            actual argument sequence associated with a VALUE array dummy.
            * gfortran.dg/value_16.f90: New test - run test for the deep copy
            of a VALUE array dummy with allocatable components.
            * gfortran.dg/value_17.f90: New test - compile test rejecting
            VALUE array dummies in a BIND(C) procedure and polymorphic VALUE
            array dummies.
            * gfortran.dg/value_18.f90: New test - run test for an absent
            optional actual argument passed to an optional VALUE dummy.
            * gfortran.dg/assumed_rank_11.f90: Update expected diagnostic
            for VALUE on an assumed-rank dummy.
            * gfortran.dg/c-interop/c535a-2.f90: Likewise.

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 484397da5f8..625dd2310fb 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -18867,6 +18867,42 @@ skip_interfaces:
 		     "CODIMENSION attribute", &sym->declared_at);
 	  return;
 	}
+
+      /* F2008, C557 (F2018, C862; F2023, C867).  Assumed-shape and
+	 explicit-shape array dummies may have the VALUE attribute, but
+	 assumed-size arrays may not.  */
+      if (as->type == AS_ASSUMED_SIZE && sym->attr.value)
+	{
+	  gfc_error ("Assumed-size array %qs at %L may not have the VALUE "
+		     "attribute", sym->name, &sym->declared_at);
+	  return;
+	}
+      else if (sym->attr.value && sym->attr.dummy
+	       && (as->type == AS_EXPLICIT || as->type == AS_ASSUMED_SHAPE))
+	{
+	  if (!gfc_notify_std (GFC_STD_F2008, "Array dummy argument %qs at "
+			       "%L with VALUE attribute", sym->name,
+			       &sym->declared_at))
+	    return;
+
+	  /* F2023, 18.3.6 (4): only a scalar VALUE dummy is interoperable
+	     with a formal parameter of the C prototype.  */
+	  if (sym->ns->proc_name && sym->ns->proc_name->attr.is_bind_c)
+	    {
+	      gfc_error ("Array dummy argument %qs at %L with VALUE attribute "
+			 "not allowed in BIND(C) procedure %qs", sym->name,
+			 &sym->declared_at, sym->ns->proc_name->name);
+	      return;
+	    }
+
+	  if (sym->ts.type == BT_CLASS)
+	    {
+	      gfc_error ("Sorry, polymorphic array dummy argument %qs at %L "
+			 "with VALUE attribute is not yet implemented",
+			 sym->name, &sym->declared_at);
+	      return;
+	    }
+	}
     }
 
   /* Make sure symbols with known intent or optional are really dummy
@@ -18890,7 +18926,7 @@ skip_interfaces:
   if (sym->attr.value && sym->ts.type == BT_CHARACTER)
     {
       gfc_charlen *cl = sym->ts.u.cl;
-      if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT)
+      if (!cl)
 	{
 	  gfc_error ("Character dummy variable %qs at %L with VALUE "
 		     "attribute must have constant length",
@@ -18898,14 +18934,32 @@ skip_interfaces:
 	  return;
 	}
 
+      /* C interoperable character dummies must have length one.  */
       if (sym->ts.is_c_interop
-	  && mpz_cmp_si (cl->length->value.integer, 1) != 0)
+	  && (!cl->length
+	      || cl->length->expr_type != EXPR_CONSTANT
+	      || mpz_cmp_si (cl->length->value.integer, 1) != 0))
 	{
 	  gfc_error ("C interoperable character dummy variable %qs at %L "
 		     "with VALUE attribute must have length one",
 		     sym->name, &sym->declared_at);
 	  return;
 	}
+
+      /* Assumed-length character dummy with VALUE, valid since F2008.  */
+      if (!cl->length
+	  && !gfc_notify_std (GFC_STD_F2008, "Assumed-length character "
+			      "dummy variable %qs at %L with VALUE attribute",
+			      sym->name, &sym->declared_at))
+	return;
+
+      /* Likewise for a specified but non-constant length.  */
+      if (cl->length && cl->length->expr_type != EXPR_CONSTANT
+	  && !gfc_notify_std (GFC_STD_F2008, "Character dummy variable "
+			      "%qs at %L with VALUE attribute and "
+			      "non-constant length",
+			      sym->name, &sym->declared_at))
+	return;
     }
 
   if (sym->ts.type == BT_DERIVED && !sym->attr.is_iso_c
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 36e1262fff5..7b52b7aef98 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -694,7 +694,6 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
   conf (value, subroutine)
   conf (value, function)
   conf (value, volatile_)
-  conf (value, dimension)
   conf (value, codimension)
   conf (value, external)
 
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 7656f9784dd..50f53478a85 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5556,7 +5556,8 @@ void
 gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr, int g77,
 			   sym_intent intent, bool formal_ptr,
 			   const gfc_symbol *fsym, const char *proc_name,
-			   gfc_symbol *sym, bool check_contiguous)
+			   gfc_symbol *sym, bool check_contiguous,
+			   bool deep_copy)
 {
   gfc_se lse;
   gfc_se rse;
@@ -5668,7 +5669,7 @@ gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr, int g77,
 
   if (intent != INTENT_OUT)
     {
-      tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, false, false);
+      tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, deep_copy, false);
       gfc_add_expr_to_block (&body, tmp);
       gcc_assert (rse.ss == gfc_ss_terminator);
       gfc_trans_scalarizing_loops (&loop, &body);
@@ -5800,6 +5801,19 @@ gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr, int g77,
 
 class_array_fcn:
 
+  /* A deep copy allocated fresh components for the temporary; free them
+     again once the call has returned, before the temporary itself goes.
+     Only INTENT_IN is supported, as writing the temporary back would leave
+     the actual argument holding the freed component pointers.  */
+  gcc_assert (!deep_copy || intent == INTENT_IN);
+  if (deep_copy && expr->ts.type == BT_DERIVED
+      && expr->ts.u.derived->attr.alloc_comp)
+    {
+      tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, parmse->expr,
+				       dimen);
+      gfc_add_expr_to_block (&parmse->post, tmp);
+    }
+
   gfc_add_block_to_block (&parmse->post, &loop.post);
 
   gfc_cleanup_loop (&loop);
@@ -5965,8 +5979,11 @@ class_array_fcn:
 	}
       else
 	{
-	  /* pointer = pramse->expr;  .  */
-	  gfc_add_modify (&parmse->pre, pointer, parmse->expr);
+	  /* pointer = parmse->expr;  .  */
+	  tmp = (GFC_DESCRIPTOR_TYPE_P (type)
+		 ? build_fold_indirect_ref_loc (input_location, parmse->expr)
+		 : parmse->expr);
+	  gfc_add_modify (&parmse->pre, pointer, tmp);
 	  pre_stmts = gfc_finish_block (&parmse->pre);
 	}
 
@@ -6048,6 +6065,7 @@ class_array_fcn:
 	    gcc_assert (!pass_optional);
 	}
       se->expr = pointer;
+      se->string_length = parmse->string_length;
     }
 
   return;
@@ -6699,6 +6717,207 @@ gfc_const_length_character_type_p (gfc_typespec *ts)
 }
 
 
+/* Returns true if FORMAL contains an explicit-shape array dummy with the
+   VALUE attribute.  The bounds of such a dummy may have to be evaluated
+   on the caller side, which needs an interface mapping.  */
+
+static bool
+has_value_array_dummy (gfc_formal_arglist *formal)
+{
+  for (; formal; formal = formal->next)
+    if (formal->sym && formal->sym->attr.value && formal->sym->attr.dimension
+	&& formal->sym->as && formal->sym->as->type == AS_EXPLICIT)
+      return true;
+
+  return false;
+}
+
+
+/* Sequence association (F2023, 15.5.2.12) of a scalar actual argument E with
+   an explicit-shape array dummy FSYM that has the VALUE attribute.  Copy as
+   many elements as the dummy declares into a temporary and pass that.
+   MAPPING supplies the caller-side values of any dummy arguments appearing
+   in the bounds or the character length of FSYM.  */
+
+static void
+conv_seq_assoc_value_arg (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym,
+			  gfc_interface_mapping *mapping)
+{
+  tree nelems, eltype, eltsize, tmpvar, src, tmp;
+  gfc_se se;
+  int n;
+
+  gcc_assert (fsym->as && fsym->as->type == AS_EXPLICIT);
+
+  /* Address of the first element of the actual argument's sequence.  */
+  gfc_init_se (&se, NULL);
+  if (e->ts.type == BT_CHARACTER)
+    {
+      gfc_conv_expr (&se, e);
+      gfc_conv_string_parameter (&se);
+      /* The hidden length argument is that of the actual argument, as it
+	 is for a dummy that does not have the VALUE attribute.  */
+      parmse->string_length = se.string_length;
+    }
+  else
+    gfc_conv_expr_reference (&se, e);
+  gfc_add_block_to_block (&parmse->pre, &se.pre);
+  gfc_add_block_to_block (&parmse->post, &se.post);
+  src = se.expr;
+
+  /* Number of elements of the dummy.  */
+  nelems = gfc_index_one_node;
+  for (n = 0; n < fsym->as->rank; n++)
+    {
+      tree lbound, ubound, extent;
+
+      gfc_init_se (&se, NULL);
+      gfc_apply_interface_mapping (mapping, &se, fsym->as->upper[n]);
+      gfc_add_block_to_block (&parmse->pre, &se.pre);
+      gfc_add_block_to_block (&parmse->post, &se.post);
+      ubound = fold_convert (gfc_array_index_type, se.expr);
+
+      if (fsym->as->lower[n])
+	{
+	  gfc_init_se (&se, NULL);
+	  gfc_apply_interface_mapping (mapping, &se, fsym->as->lower[n]);
+	  gfc_add_block_to_block (&parmse->pre, &se.pre);
+	  gfc_add_block_to_block (&parmse->post, &se.post);
+	  lbound = fold_convert (gfc_array_index_type, se.expr);
+	}
+      else
+	lbound = gfc_index_one_node;
+
+      extent = fold_build2_loc (input_location, MINUS_EXPR,
+				gfc_array_index_type, ubound, lbound);
+      extent = fold_build2_loc (input_location, PLUS_EXPR,
+				gfc_array_index_type, extent,
+				gfc_index_one_node);
+      extent = fold_build2_loc (input_location, MAX_EXPR, gfc_array_index_type,
+				extent, gfc_index_zero_node);
+      nelems = fold_build2_loc (input_location, MULT_EXPR,
+				gfc_array_index_type, nelems, extent);
+    }
+  nelems = gfc_evaluate_now (nelems, &parmse->pre);
+
+  /* Element type and size of the dummy.  For characters the element
+     sequence is grouped by the character length of the dummy.  */
+  if (fsym->ts.type == BT_CHARACTER)
+    {
+      tree len;
+
+      if (fsym->ts.u.cl->length)
+	{
+	  gfc_init_se (&se, NULL);
+	  gfc_apply_interface_mapping (mapping, &se, fsym->ts.u.cl->length);
+	  gfc_add_block_to_block (&parmse->pre, &se.pre);
+	  gfc_add_block_to_block (&parmse->post, &se.post);
+	  len = fold_convert (gfc_charlen_type_node, se.expr);
+	}
+      else
+	len = fold_convert (gfc_charlen_type_node, parmse->string_length);
+
+      eltype = gfc_get_character_type_len (fsym->ts.kind, len);
+      eltsize = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
+				 fold_convert (size_type_node, len),
+				 fold_convert (size_type_node,
+					       TYPE_SIZE_UNIT (gfc_get_char_type
+							       (fsym->ts.kind))));
+    }
+  else
+    {
+      eltype = gfc_typenode_for_spec (&fsym->ts);
+      eltsize = fold_convert (size_type_node, TYPE_SIZE_UNIT (eltype));
+    }
+
+  /* The temporary holding the copy.  Allocate at least one element so that
+     a zero-sized dummy does not produce a degenerate array type.  */
+  tmp = fold_build2_loc (input_location, MAX_EXPR, gfc_array_index_type,
+			 nelems, gfc_index_one_node);
+  tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			 tmp, gfc_index_one_node);
+  tmp = build_array_type (eltype, build_range_type (gfc_array_index_type,
+						    gfc_index_zero_node, tmp));
+  tmpvar = gfc_create_var (tmp, "seq_copy");
+  gfc_add_expr_to_block (&parmse->pre,
+			 fold_build1_loc (input_location, DECL_EXPR, tmp,
+					  tmpvar));
+
+  tmp = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
+			 fold_convert (size_type_node, nelems), eltsize);
+  tmp = gfc_build_memcpy_call (fold_convert (pvoid_type_node,
+					     gfc_build_addr_expr (NULL_TREE,
+								  tmpvar)),
+			       fold_convert (pvoid_type_node, src), tmp);
+  gfc_add_expr_to_block (&parmse->pre, tmp);
+
+  /* The memcpy also copied the component pointers of a derived type, which
+     would leave the temporary sharing the actual argument's allocatable
+     components.  Give the copy components of its own and free them again
+     once the call has returned.  */
+  if (fsym->ts.type == BT_DERIVED && fsym->ts.u.derived->attr.alloc_comp)
+    {
+      tree srcp = fold_convert (build_pointer_type (eltype), src);
+
+      for (n = 0; n < 2; n++)
+	{
+	  stmtblock_t loop_block, body;
+	  tree idx, exit_label, delt;
+
+	  idx = gfc_create_var (gfc_array_index_type, "idx");
+	  exit_label = gfc_build_label_decl (NULL_TREE);
+	  TREE_USED (exit_label) = 1;
+
+	  gfc_start_block (&loop_block);
+	  gfc_add_modify (&loop_block, idx, gfc_index_zero_node);
+
+	  gfc_start_block (&body);
+	  tmp = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
+				 idx, nelems);
+	  tmp = build3_v (COND_EXPR, tmp, build1_v (GOTO_EXPR, exit_label),
+			  build_empty_stmt (input_location));
+	  gfc_add_expr_to_block (&body, tmp);
+
+	  delt = gfc_build_array_ref (tmpvar, idx, NULL_TREE);
+	  if (n == 0)
+	    {
+	      tree off = fold_build2_loc (input_location, MULT_EXPR, sizetype,
+					  fold_convert (sizetype, idx), eltsize);
+	      tree selt
+		= build_fold_indirect_ref_loc (input_location,
+					       fold_build_pointer_plus_loc
+					       (input_location, srcp, off));
+	      tmp = gfc_copy_alloc_comp (fsym->ts.u.derived, selt, delt, 0, 0);
+	    }
+	  else
+	    tmp = gfc_deallocate_alloc_comp (fsym->ts.u.derived, delt, 0);
+	  gfc_add_expr_to_block (&body, tmp);
+
+	  tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+				 idx, gfc_index_one_node);
+	  gfc_add_modify (&body, idx, tmp);
+
+	  gfc_add_expr_to_block (&loop_block,
+				 build1_v (LOOP_EXPR, gfc_finish_block (&body)));
+	  gfc_add_expr_to_block (&loop_block, build1_v (LABEL_EXPR, exit_label));
+
+	  tmp = gfc_finish_block (&loop_block);
+	  if (n == 0)
+	    gfc_add_expr_to_block (&parmse->pre, tmp);
+	  else
+	    gfc_add_expr_to_block (&parmse->post, tmp);
+	}
+    }
+
+  if (fsym->ts.type == BT_CHARACTER)
+    parmse->expr
+      = gfc_build_addr_expr (build_pointer_type (gfc_get_char_type
+						 (fsym->ts.kind)), tmpvar);
+  else
+    parmse->expr = gfc_build_addr_expr (build_pointer_type (eltype), tmpvar);
+}
+
+
 /* Helper function for the handling of (currently) scalar dummy variables
    with the VALUE attribute.  Argument parmse should already be set up.  */
 static void
@@ -6754,6 +6973,59 @@ conv_dummy_value (gfc_se * parmse, gfc_expr * e, gfc_symbol * fsym,
       return;
     }
 
+  /* Assumed-length or non-constant-length CHARACTER VALUE dummy: copy
+     the actual argument and pass the copy.  */
+  if (fsym->ts.type == BT_CHARACTER
+      && (!fsym->ts.u.cl || !fsym->ts.u.cl->length
+	  || fsym->ts.u.cl->length->expr_type != EXPR_CONSTANT))
+    {
+      /* An optional actual argument that is absent has nothing to copy
+	 from; pass a null pointer and a length of zero instead.  */
+      tree present = NULL_TREE;
+      if (fsym->attr.optional && e->expr_type == EXPR_VARIABLE
+	  && e->symtree->n.sym->attr.optional)
+	present = gfc_conv_expr_present (e->symtree->n.sym);
+
+      gfc_conv_string_parameter (parmse);
+      tree len = fold_convert (gfc_charlen_type_node, parmse->string_length);
+      if (present)
+	{
+	  len = fold_build3_loc (input_location, COND_EXPR,
+				 gfc_charlen_type_node, present, len,
+				 build_zero_cst (gfc_charlen_type_node));
+	  len = gfc_evaluate_now (len, &parmse->pre);
+	  parmse->string_length = len;
+	}
+      tree chartype = gfc_get_character_type_len (fsym->ts.kind, len);
+      tree val_copy = gfc_create_var (chartype, "val_copy");
+      tmp = fold_build1_loc (input_location, DECL_EXPR, chartype, val_copy);
+      gfc_add_expr_to_block (&parmse->pre, tmp);
+      /* The copy size is in bytes, not in characters.  */
+      tree bytes
+	= fold_build2_loc (input_location, MULT_EXPR, size_type_node,
+			   fold_convert (size_type_node, len),
+			   fold_convert (size_type_node,
+					 TYPE_SIZE_UNIT (gfc_get_char_type
+							 (fsym->ts.kind))));
+      tmp = gfc_build_memcpy_call (
+	fold_convert (pvoid_type_node,
+		      gfc_build_addr_expr (NULL_TREE, val_copy)),
+	fold_convert (pvoid_type_node, parmse->expr), bytes);
+      if (present)
+	tmp = build3_v (COND_EXPR, present, tmp,
+			build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&parmse->pre, tmp);
+      parmse->expr = fold_convert (
+	build_pointer_type (gfc_get_char_type (fsym->ts.kind)),
+	gfc_build_addr_expr (NULL_TREE, val_copy));
+      if (present)
+	parmse->expr = fold_build3_loc (input_location, COND_EXPR,
+					TREE_TYPE (parmse->expr), present,
+					parmse->expr,
+					fold_convert (TREE_TYPE (parmse->expr),
+						      null_pointer_node));
+    }
+
   /* Truncate a too long constant character actual argument.  */
   if (gfc_const_length_character_type_p (&fsym->ts)
       && e->expr_type == EXPR_CONSTANT
@@ -7049,7 +7321,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 			       (sym->ts.type == BT_CHARACTER
 				&& sym->ts.u.cl->length
 				&& sym->ts.u.cl->length->expr_type
-				   != EXPR_CONSTANT);
+				   != EXPR_CONSTANT) ||
+			       has_value_array_dummy (formal);
     }
   else
     {
@@ -7058,7 +7331,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 			       (comp->ts.type == BT_CHARACTER
 				&& comp->ts.u.cl->length
 				&& comp->ts.u.cl->length->expr_type
-				   != EXPR_CONSTANT);
+				   != EXPR_CONSTANT) ||
+			       has_value_array_dummy (formal);
     }
 
   base_object = NULL_TREE;
@@ -7384,6 +7658,11 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		/* Implement F2018, 18.3.6, list item (5), bullet point 2.  */
 		gfc_conv_gfc_desc_to_cfi_desc (&parmse, e, fsym);
 
+	      else if (fsym && fsym->attr.value && fsym->attr.dimension)
+		/* Scalar actual argument sequence associated with a VALUE
+		   array dummy.  */
+		conv_seq_assoc_value_arg (&parmse, e, fsym, &mapping);
+
 	      else if (fsym && fsym->attr.value)
 		{
 		  if (fsym->ts.type == BT_CHARACTER
@@ -7983,6 +8262,18 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		/* Implement F2018, 18.3.6, list item (5), bullet point 2.  */
 		gfc_conv_gfc_desc_to_cfi_desc (&parmse, e, fsym);
 
+	      else if (fsym && fsym->attr.value && fsym->attr.dimension
+		       && e->rank != -1)
+		/* VALUE array dummy: pass a private copy of the actual
+		   argument.  The symbol passed is that of the actual
+		   argument, so that the copy is suppressed. A null
+		   pointer passed when an optional actual argument is absent.  */
+		gfc_conv_subref_array_arg (&parmse, e, nodesc_arg, INTENT_IN,
+					   false, fsym, sym->name,
+					   e->expr_type == EXPR_VARIABLE
+					   ? e->symtree->n.sym : NULL,
+					   false, true);
+
 	      else if (e->expr_type == EXPR_VARIABLE
 		    && is_subref_array (e)
 		    && !(fsym && fsym->attr.pointer))
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index ea4395c67dd..04786b83746 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2521,7 +2521,12 @@ gfc_sym_type (gfc_symbol * sym, bool is_bind_c)
   else
     type = gfc_typenode_for_spec (&sym->ts, sym->attr.codimension);
 
-  if (sym->attr.dummy && !sym->attr.function && !sym->attr.value
+  if (sym->attr.dummy && !sym->attr.function
+      && (!sym->attr.value
+	  || sym->attr.dimension
+	  || (sym->ts.type == BT_CHARACTER
+	      && (!sym->ts.u.cl || !sym->ts.u.cl->length
+		  || sym->ts.u.cl->length->expr_type != EXPR_CONSTANT)))
       && !sym->pass_as_value)
     byref = 1;
   else
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 0bdee5820fd..7b28ecfce47 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -564,7 +564,8 @@ void gfc_conv_subref_array_arg (gfc_se *, gfc_expr *, int, sym_intent, bool,
 				const gfc_symbol *fsym = NULL,
 				const char *proc_name = NULL,
 				gfc_symbol *sym = NULL,
-				bool check_contiguous = false);
+				bool check_contiguous = false,
+				bool deep_copy = false);
 
 void gfc_conv_is_contiguous_expr (gfc_se *, gfc_expr *);
 
diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_11.f90 b/gcc/testsuite/gfortran.dg/assumed_rank_11.f90
index 46dffd0740b..ed87ca73ee7 100644
--- a/gcc/testsuite/gfortran.dg/assumed_rank_11.f90
+++ b/gcc/testsuite/gfortran.dg/assumed_rank_11.f90
@@ -42,11 +42,11 @@ subroutine orig(X) ! { dg-error "may not have the VALUE or CODIMENSION attribute
  integer :: x(..)[*]
 end
 
-subroutine val1(X)
- integer, value :: x(..)  ! { dg-error "VALUE attribute conflicts with DIMENSION attribute" }
+subroutine val1(X) ! { dg-error "may not have the VALUE or CODIMENSION attribute" }
+ integer, value :: x(..)
 end
 
-subroutine val2(X)
+subroutine val2(X) ! { dg-error "may not have the VALUE or CODIMENSION attribute" }
  integer, value :: x
- dimension :: x(..)  ! { dg-error "VALUE attribute conflicts with DIMENSION attribute" }
+ dimension :: x(..)
 end
diff --git a/gcc/testsuite/gfortran.dg/c-interop/c535a-2.f90 b/gcc/testsuite/gfortran.dg/c-interop/c535a-2.f90
index 816e69124ce..742c0f878a5 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/c535a-2.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/c535a-2.f90
@@ -71,8 +71,8 @@ subroutine s2 (b) ! { dg-error "has no IMPLICIT type" }
   integer, codimension[*] :: b(..) ! { dg-error "assumed-rank array" }
 end subroutine
 
-subroutine s5 (e) ! { dg-error "has no IMPLICIT type" }
+subroutine s5 (e) ! { dg-error "may not have the VALUE or CODIMENSION attribute" }
   implicit none
-  integer, value :: e(..) ! { dg-error "VALUE attribute conflicts with DIMENSION" }
+  integer, value :: e(..)
 end subroutine
 
diff --git a/gcc/testsuite/gfortran.dg/value_11.f90 b/gcc/testsuite/gfortran.dg/value_11.f90
new file mode 100644
index 00000000000..6056095892b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/value_11.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! character(len=n), value with a non-constant specified length (n is a
+! dummy argument) was rejected with "must have constant length".  Verify
+! that it compiles and that VALUE semantics hold.
+
+program test
+  implicit none
+  call sub_char1_n ("abc", 3)
+contains
+  subroutine sub_char1_n (x, n)
+    integer, intent(in)            :: n
+    character(len=n), value :: x
+    x(1:1) = "1"
+    if (x(1:1) /= "1") error stop 23
+  end subroutine sub_char1_n
+end program test
diff --git a/gcc/testsuite/gfortran.dg/value_12.f90 b/gcc/testsuite/gfortran.dg/value_12.f90
new file mode 100644
index 00000000000..7f42e346f64
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/value_12.f90
@@ -0,0 +1,68 @@
+! { dg-do run }
+! VALUE was rejected outright for array dummy arguments ("VALUE
+! attribute conflicts with DIMENSION attribute"), even though F2018
+! C862 only prohibits VALUE for assumed-size arrays (and coarrays).
+! Verify that assumed-shape, explicit-shape, and
+! non-contiguous array actuals are passed by VALUE correctly: the
+! callee gets a private copy, and modifications do not propagate back
+! to the actual argument, including for PARAMETER actuals.
+
+program test
+  implicit none
+  integer, parameter :: p(5) = [1,2,3,4,5]
+  character(len=*), parameter :: c1(2) = [ "abc", "def" ]
+  integer :: a(10), i
+
+  a = [(i, i=1,10)]
+
+  call sub_int_assumed_shape (p)
+  if (any (p /= [1,2,3,4,5])) stop 1
+
+  call sub_int_noncontig (a(1:10:2))
+  if (any (a /= [(i, i=1,10)])) stop 2
+
+  call sub_int_explicit (p)
+  if (any (p /= [1,2,3,4,5])) stop 3
+
+  call sub_opt_array (p)
+  call sub_opt_array ()
+
+  call sub_char_assumed_shape (c1)
+  if (c1(1) /= "abc") stop 4
+
+contains
+
+  subroutine sub_int_assumed_shape (x)
+    integer, value :: x(:)
+    x = x + 100
+    if (any (x /= [101,102,103,104,105])) stop 11
+  end subroutine
+
+  subroutine sub_int_noncontig (x)
+    integer, value :: x(:)
+    x = -1
+    if (any (x /= -1)) stop 12
+  end subroutine
+
+  subroutine sub_int_explicit (x)
+    integer, value :: x(5)
+    x(1) = -99
+    if (x(1) /= -99) stop 13
+  end subroutine
+
+  subroutine sub_opt_array (x)
+    integer, value, optional :: x(:)
+    if (present (x)) then
+      if (any (x /= [1,2,3,4,5])) stop 14
+      x = -1
+    end if
+  end subroutine
+
+  subroutine sub_char_assumed_shape (x)
+    character(len=*), value :: x(:)
+    if (len (x) /= 3) stop 15
+    x(1)(1:1) = "1"
+    if (x(1)(1:1) /= "1") stop 16
+  end subroutine
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/value_13.f90 b/gcc/testsuite/gfortran.dg/value_13.f90
new file mode 100644
index 00000000000..9388fe1f671
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/value_13.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+! PR fortran/49802
+! Assumed-shape and explicit-shape array dummies may have the VALUE
+! attribute since Fortran 2008 (F2008, C557), but assumed-size arrays
+! may not.
+
+subroutine foo (x)
+  integer, value :: x(:)    ! assumed-shape: OK
+end subroutine
+
+subroutine bar (x)
+  integer, value :: x(10)   ! explicit-shape: OK
+end subroutine
+
+subroutine baz (x) ! { dg-error "may not have the VALUE attribute" }
+  integer, value :: x(*)
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/value_14.f90 b/gcc/testsuite/gfortran.dg/value_14.f90
new file mode 100644
index 00000000000..8736b0bdc38
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/value_14.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+! PR fortran/49802
+! The caller-side copy made for an assumed-length CHARACTER VALUE dummy
+! copied a number of bytes equal to the character count, which is wrong
+! for a character kind wider than one byte.
+
+program test
+  implicit none
+  character(kind=4,len=10) :: s4
+  character(kind=1,len=10) :: s1
+
+  s4 = 4_"abcdefghij"
+  call by_value_k4 (s4)
+  if (s4 /= 4_"abcdefghij") stop 1
+
+  s1 = "abcdefghij"
+  call by_value_k1 (s1)
+  if (s1 /= "abcdefghij") stop 2
+
+contains
+
+  subroutine by_value_k4 (y)
+    character(kind=4,len=*), value :: y
+    if (len (y) /= 10) stop 3
+    if (y /= 4_"abcdefghij") stop 4
+    y = 4_"ZZZZZZZZZZ"
+  end subroutine
+
+  subroutine by_value_k1 (y)
+    character(kind=1,len=*), value :: y
+    if (y /= "abcdefghij") stop 5
+    y = "ZZZZZZZZZZ"
+  end subroutine
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/value_15.f90 b/gcc/testsuite/gfortran.dg/value_15.f90
new file mode 100644
index 00000000000..7daeb05204a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/value_15.f90
@@ -0,0 +1,67 @@
+! { dg-do run }
+! PR fortran/49802
+! Sequence association (F2023, 15.5.2.12) of a scalar actual argument
+! with an explicit-shape array dummy that has the VALUE attribute used
+! to ICE in conv_dummy_value.  The dummy receives a private copy of as
+! many elements as it declares.
+
+program test
+  implicit none
+  integer :: a(20), i
+  character(len=12) :: s
+
+  a = [(i, i=1,20)]
+  s = "abcdefghijkl"
+
+  call const_bound (a(3))
+  if (any (a /= [(i, i=1,20)])) stop 1
+
+  call dummy_bound (4, a(3))
+  if (any (a /= [(i, i=1,20)])) stop 2
+
+  call rank_two (a(5))
+  if (any (a /= [(i, i=1,20)])) stop 3
+
+  call char_elems (s)
+  if (s /= "abcdefghijkl") stop 4
+
+  call char_dummy_len (3, s)
+  if (s /= "abcdefghijkl") stop 5
+
+contains
+
+  subroutine const_bound (x)
+    integer, value :: x(5)
+    if (any (x /= [3,4,5,6,7])) stop 11
+    x = -1
+  end subroutine
+
+  subroutine dummy_bound (n, x)
+    integer, intent(in) :: n
+    integer, value :: x(n)
+    if (size (x) /= 4) stop 21
+    if (any (x /= [3,4,5,6])) stop 22
+    x = -1
+  end subroutine
+
+  subroutine rank_two (x)
+    integer, value :: x(2,3)
+    if (any (reshape (x, [6]) /= [5,6,7,8,9,10])) stop 31
+    x = -1
+  end subroutine
+
+  subroutine char_elems (x)
+    character(len=3), value :: x(4)
+    if (x(1) /= "abc" .or. x(4) /= "jkl") stop 41
+    x = "ZZZ"
+  end subroutine
+
+  subroutine char_dummy_len (n, x)
+    integer, intent(in) :: n
+    character(len=n), value :: x(4)
+    if (len (x) /= 3) stop 51
+    if (x(1) /= "abc" .or. x(4) /= "jkl") stop 52
+    x = "ZZZ"
+  end subroutine
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/value_16.f90 b/gcc/testsuite/gfortran.dg/value_16.f90
new file mode 100644
index 00000000000..93730c84b0a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/value_16.f90
@@ -0,0 +1,70 @@
+! { dg-do run }
+! PR fortran/49802
+! A VALUE array dummy of a derived type with allocatable components was
+! given a shallow copy, so the callee reached the actual argument's data
+! through the shared component pointers.  The copy must be deep.
+
+program test
+  implicit none
+  type :: inner
+    integer, allocatable :: d(:)
+  end type
+  type :: outer
+    type(inner), allocatable :: b(:)
+    character(:), allocatable :: nm
+  end type
+  type(outer) :: v(2)
+  integer :: k
+
+  do k = 1, 2
+    allocate (v(k)%b(2))
+    allocate (v(k)%b(1)%d(2), source=[k,k])
+    allocate (v(k)%b(2)%d(2), source=[10*k,10*k])
+    v(k)%nm = "orig"
+  end do
+
+  call explicit_shape (v)
+  if (any (v(1)%b(1)%d /= [1,1])) stop 1
+  if (v(1)%nm /= "orig") stop 2
+
+  call assumed_shape (v)
+  if (any (v(2)%b(2)%d /= [20,20])) stop 3
+  if (v(2)%nm /= "orig") stop 4
+
+  call opt (v)
+  call opt ()
+  if (v(1)%nm /= "orig") stop 5
+
+  call seq_assoc (v(1))
+  if (any (v(1)%b(1)%d /= [1,1])) stop 6
+  if (any (v(2)%b(1)%d /= [2,2])) stop 7
+
+contains
+
+  subroutine seq_assoc (x)
+    type(outer), value :: x(2)
+    x(1)%b(1)%d = [-1,-1]
+    x(2)%b(1)%d = [-9,-9]
+    if (any (x(1)%b(1)%d /= [-1,-1])) stop 61
+  end subroutine
+
+  subroutine explicit_shape (x)
+    type(outer), value :: x(2)
+    x(1)%b(1)%d = [-1,-1]
+    x(1)%nm = "changed"
+    if (any (x(1)%b(1)%d /= [-1,-1])) stop 11
+  end subroutine
+
+  subroutine assumed_shape (x)
+    type(outer), value :: x(:)
+    x(2)%b(2)%d = [-9,-9]
+    x(2)%nm = "changed"
+    if (x(2)%nm /= "changed") stop 21
+  end subroutine
+
+  subroutine opt (x)
+    type(outer), value, optional :: x(:)
+    if (present (x)) x(1)%nm = "changed"
+  end subroutine
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/value_17.f90 b/gcc/testsuite/gfortran.dg/value_17.f90
new file mode 100644
index 00000000000..8cafc556bbc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/value_17.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! PR fortran/49802
+! Only a scalar VALUE dummy is interoperable with a formal parameter of
+! the C prototype (F2023, 18.3.6 (4)), so an array VALUE dummy is not
+! allowed in a BIND(C) procedure.  A polymorphic array VALUE dummy is
+! not yet implemented; it used to ICE.
+
+module m
+  use iso_c_binding
+  implicit none
+  type :: t
+    integer :: i = 0
+  end type
+contains
+
+  subroutine bindc_expl (x) bind(c) ! { dg-error "not allowed in BIND\\(C\\) procedure" }
+    integer(c_int), value :: x(3)
+  end subroutine
+
+  subroutine bindc_ashape (x) bind(c) ! { dg-error "not allowed in BIND\\(C\\) procedure" }
+    integer(c_int), value :: x(:)
+  end subroutine
+
+  subroutine poly (x) ! { dg-error "not yet implemented" }
+    class(t), value :: x(:)
+  end subroutine
+
+end module
diff --git a/gcc/testsuite/gfortran.dg/value_18.f90 b/gcc/testsuite/gfortran.dg/value_18.f90
new file mode 100644
index 00000000000..967794cbe8e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/value_18.f90
@@ -0,0 +1,150 @@
+! { dg-do run }
+! PR fortran/49802
+! An absent OPTIONAL actual argument passed to an OPTIONAL dummy with the
+! VALUE attribute used to segfault: the private copy made for the dummy
+! dereferenced the actual argument unconditionally.  Both the array copy
+! and the copy made for a character dummy of assumed or non-constant
+! length must be suppressed when the actual argument is absent.
+
+module m
+  implicit none
+contains
+
+  subroutine take_as (x, present_x)
+    integer, value, optional :: x(:)
+    logical, intent(in) :: present_x
+    if (present (x) .neqv. present_x) stop 1
+    if (present (x)) then
+      if (size (x) /= 3) stop 2
+      if (any (x /= [1, 2, 3])) stop 3
+      x = -1
+      if (any (x /= -1)) stop 4
+    end if
+  end subroutine take_as
+
+  subroutine take_es (n, x, present_x)
+    integer, intent(in) :: n
+    integer, value, optional :: x(n)
+    logical, intent(in) :: present_x
+    if (present (x) .neqv. present_x) stop 5
+    if (present (x)) then
+      if (size (x) /= n) stop 6
+      if (x(1) /= 1) stop 7
+      x = 0
+      if (any (x /= 0)) stop 8
+    end if
+  end subroutine take_es
+
+  subroutine take_cs (s, present_s)
+    character(len=*), value, optional :: s
+    logical, intent(in) :: present_s
+    if (present (s) .neqv. present_s) stop 9
+    if (present (s)) then
+      if (s /= 'payload') stop 10
+      s = repeat ('Z', len (s))
+      if (s /= repeat ('Z', len (s))) stop 11
+    end if
+  end subroutine take_cs
+
+  subroutine take_ca (s, present_s)
+    character(len=*), value, optional :: s(:)
+    logical, intent(in) :: present_s
+    if (present (s) .neqv. present_s) stop 12
+    if (present (s)) then
+      if (size (s) /= 2) stop 13
+      if (any (s /= ['ab', 'cd'])) stop 14
+      s = 'ZZ'
+      if (any (s /= 'ZZ')) stop 15
+    end if
+  end subroutine take_ca
+
+  ! Relay an optional dummy on to the optional VALUE dummy.  This is what
+  ! puts a descriptor of an absent argument into the argument list.
+
+  subroutine relay_as (x, present_x)
+    integer, optional :: x(:)
+    logical, intent(in) :: present_x
+    call take_as (x, present_x)
+  end subroutine relay_as
+
+  subroutine relay_es (n, x, present_x)
+    integer, intent(in) :: n
+    integer, optional :: x(n)
+    logical, intent(in) :: present_x
+    call take_es (n, x, present_x)
+  end subroutine relay_es
+
+  ! A non-constant length is needed here: with len=* the length of an
+  ! absent actual argument is zero and the copy reads nothing.
+  subroutine relay_cs (n, s, present_s)
+    integer, intent(in) :: n
+    character(len=n), optional :: s
+    logical, intent(in) :: present_s
+    call take_cs (s, present_s)
+  end subroutine relay_cs
+
+  subroutine relay_ca (s, present_s)
+    character(len=*), optional :: s(:)
+    logical, intent(in) :: present_s
+    call take_ca (s, present_s)
+  end subroutine relay_ca
+
+  ! An optional VALUE dummy relayed on to another optional VALUE dummy.
+
+  subroutine relay_asv (x, present_x)
+    integer, value, optional :: x(:)
+    logical, intent(in) :: present_x
+    call take_as (x, present_x)
+  end subroutine relay_asv
+
+  subroutine relay_csv (n, s, present_s)
+    integer, intent(in) :: n
+    character(len=n), value, optional :: s
+    logical, intent(in) :: present_s
+    call take_cs (s, present_s)
+  end subroutine relay_csv
+
+end module m
+
+program test
+  use m
+  implicit none
+  integer :: v(3)
+  character(len=7) :: s
+  character(len=2) :: a(2)
+
+  v = [1, 2, 3]
+  s = 'payload'
+  a = ['ab', 'cd']
+
+  ! Directly, with and without the actual argument.
+  call take_as (v, .true.)
+  call take_as (present_x = .false.)
+  call take_es (3, v, .true.)
+  call take_es (3, present_x = .false.)
+  call take_cs (s, .true.)
+  call take_cs (present_s = .false.)
+  call take_ca (a, .true.)
+  call take_ca (present_s = .false.)
+
+  ! Relayed through an optional dummy.
+  call relay_as (v, .true.)
+  call relay_as (present_x = .false.)
+  call relay_es (3, v, .true.)
+  call relay_es (3, present_x = .false.)
+  call relay_cs (7, s, .true.)
+  call relay_cs (7, present_s = .false.)
+  call relay_ca (a, .true.)
+  call relay_ca (present_s = .false.)
+
+  ! Relayed through an optional VALUE dummy.
+  call relay_asv (v, .true.)
+  call relay_asv (present_x = .false.)
+  call relay_csv (7, s, .true.)
+  call relay_csv (7, present_s = .false.)
+
+  ! None of the copies may write back to the actual arguments.
+  if (any (v /= [1, 2, 3])) stop 16
+  if (s /= 'payload') stop 17
+  if (any (a /= ['ab', 'cd'])) stop 18
+end program test
diff --git a/gcc/testsuite/gfortran.dg/value_3.f90 b/gcc/testsuite/gfortran.dg/value_3.f90
index c5d2d1f27df..0a5308cb88e 100644
--- a/gcc/testsuite/gfortran.dg/value_3.f90
+++ b/gcc/testsuite/gfortran.dg/value_3.f90
@@ -1,8 +1,14 @@
 ! { dg-do compile }
+! { dg-options "-std=f2003" }
 ! Tests the constraints in the patch for PR29642, which requested the
 ! implementation of the F2003 VALUE attribute for gfortran.
 !
-! Contributed by Paul Thomas  <[email protected]> 
+! Compiled as -std=f2003 because Fortran 2008 relaxed C527 to allow the
+! VALUE attribute on explicit-shape and assumed-shape array dummies
+! (F2008, C557); bar_1 below exercises the resulting -std=f2003
+! rejection.  The acceptance case is covered separately by value_12.f90.
+!
+! Contributed by Paul Thomas  <[email protected]>
 !
 program test_value
   integer(8) :: i = 42, j   ! { dg-error "not a dummy" }
@@ -10,10 +16,10 @@ program test_value
   value :: j
 
 contains
-  subroutine bar_1 (i)
+  subroutine bar_1 (i) ! { dg-error "Fortran 2008: Array dummy argument" }
     integer(8) :: i
     dimension i(8)
-    value :: i  ! { dg-error "conflicts with DIMENSION" }
+    value :: i
     i = 0
   end subroutine bar_1
 
diff --git a/gcc/testsuite/gfortran.dg/value_5.f90 b/gcc/testsuite/gfortran.dg/value_5.f90
index 4b0dcefb340..9060bbe2193 100644
--- a/gcc/testsuite/gfortran.dg/value_5.f90
+++ b/gcc/testsuite/gfortran.dg/value_5.f90
@@ -1,9 +1,15 @@
 ! { dg-do compile }
+! { dg-options "-std=f2003" }
 ! Length of character dummy variable with VALUE attribute:
 ! - must be initialization expression or omitted
 ! - C interoperable: must be initialization expression of length one
 !   or omitted
 !
+! Compiled as -std=f2003 because Fortran 2008 relaxed C558 to allow
+! assumed-length character dummies with the VALUE attribute; that case
+! (foo4) and its rejection under -std=f2003 are exercised separately in
+! value_6.f90 and value_7.f90.
+!
 ! Contributed by Tobias Burnus
 program x
   implicit none
@@ -36,7 +42,7 @@ contains
     value :: a
   end subroutine foo3
 
-  subroutine foo4(a) ! { dg-error "VALUE attribute must have constant length" }
+  subroutine foo4(a) ! { dg-error "Assumed-length character" }
     character(*) :: a
     value :: a
   end subroutine foo4
@@ -60,7 +66,7 @@ contains
     value :: a
   end subroutine bar3
 
-  subroutine bar4(a) ! { dg-error "VALUE attribute must have constant length" }
+  subroutine bar4(a) ! { dg-error "VALUE attribute must have length one" }
     use iso_c_binding, only: c_char
     character(kind=c_char,len=*) :: a
     value :: a
diff --git a/gcc/testsuite/gfortran.dg/value_6.f90 b/gcc/testsuite/gfortran.dg/value_6.f90
new file mode 100644
index 00000000000..b3187253a9e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/value_6.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! character(len=*), value was rejected by gfortran despite being valid
+! from Fortran 2008 onwards.  Verify that it compiles and that VALUE
+! semantics are correct: modifications to the dummy do not affect the
+! actual argument, and len() returns the actual argument's length.
+
+program test
+  implicit none
+  character(len=10) :: str
+
+  str = "123456789"
+  call by_value (str)
+  if (str /= "123456789") stop 1
+
+contains
+
+  subroutine by_value (y)
+    character(len=*), value :: y
+    if (len (y) /= 10) stop 2
+    if (y /= "123456789 ") stop 3
+    y = "abcdefghij"
+    if (y /= "abcdefghij") stop 4
+    ! str is accessible via host association; VALUE must not let
+    ! the assignment to y propagate back.
+    if (str /= "123456789") stop 5
+  end subroutine
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/value_7.f90 b/gcc/testsuite/gfortran.dg/value_7.f90
new file mode 100644
index 00000000000..5e88fab2199
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/value_7.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! Fortran 2003 C558 prohibited assumed-length character with VALUE.
+! Verify that -std=f2003 rejects it.
+
+subroutine sub (y)  ! { dg-error "Assumed-length character" }
+  character(len=*), value :: y
+end subroutine
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.