Fortran: Generic processing of assumed rank objects (f202y) [PR116733]

2024-10-23  Paul Thomas  <[email protected]>

gcc/fortran
	PR fortran/116733
	* array.cc : White space corrections.
	* expr.cc (gfc_check_pointer_assign): Permit assumed rank
	target with -std=f202y. Add constraints that the data pointer
	object must have rank remapping specified and the that the data
	target be contiguous.
	* gfortran.h : Add a gfc_array_ref field 'ar' to the structure
	'gfc_association_list'.
	* interface.cc (gfc_compare_actual_formal): If -Wsurprising
	is set, emit a warning if an assumed size array is passed to an
	assumed rank dummy.
	* intrinsic.cc (do_ts29113_check): Permit an assumed rank arg.
	for reshape if -std=f202y and the argument is contiguous.
	* invoke.texi : Introduce -std=f202y. Whitespace errors.
	* lang.opt : Accept -std=f202y.
	* libgfortran.h : Define GFC_STD_F202Y.
	* match.cc (gfc_match_associate): If -std=f202y an assumed rank
	selector is allowed if it is contiguous and the associate name
	has rank remapping specified.
	* options.cc (gfc_init_options): -std=f202y is equivalent to
	-std=f2023 with experimental f202y features. White space issues
	* parse.cc (parse_associate): If the selector is assumed rank,
	use the 'ar' field of the association list to build an array
	specification.
	* primary.cc (gfc_match_varspec): Do not resolve the assumed
	rank selector of a class associate name at this stage to avoid
	the rank change.
	* resolve.cc (find_array_spec): If an array_ref dimension is -1
	reset it with the rank in the object's array_spec.
	(gfc_expression_rank): Do not check dimen types for an assumed
	rank variable expression.
	(resolve_variable): Do not emit the assumed rank context error
	if the context is pointer assignment and the variable is a
	target.
	(resolve_assoc_var): Resolve the bounds and check for missing
	bounds in the rank remap of an associate name with an assumed
	rank selector. Do not correct the rank of an associate name
	with an assumed rank selector.
	(resolve_symbol): Allow the reference to an assumed rank object
	if -std-f202y is enabled and the current operation is
	EXEC_BLOCK.
	* st.cc (gfc_free_association_list): Free bounds expressions
	of the 'ar' field, if present.
	* trans-array.cc (gfc_conv_ss_startstride): If -std=f202y and
	bounds checking activated, do not apply the assertion.
	* trans-expr.cc (gfc_trans_pointer_assignment): An assumed rank
	target has its offset set to zero.
	* trans-stmt.cc (trans_associate_var): If the selector is
	assumed rank, call gfc_trans_pointer_assignment using the 'ar'
	field in the association list as the array reference for expr1.
	The data target, expr2, is a copy of the selector expression.

gcc/testsuite/
	PR fortran/116733
	* gfortran.dg/associate_3.f03: Change error message.
	* gfortran.dg/f202y/f202y.exp: Enable tests of f202y features.
	* gfortran.dg/f202y/generic_assumed_rank_1.f90: New test.
	* gfortran.dg/f202y/generic_assumed_rank_2.f90: New test.
	* gfortran.dg/f202y/generic_assumed_rank_3.f90: New test.

Author: Paul Thomas

gcc/fortran/array.cc

@@ -869,7 +869,7 @@ gfc_set_array_spec (gfc_symbol *sym, gfc_array_spec *as, locus *error_loc)
 {
   int i;
   symbol_attribute *attr;
-  
+
   if (as == NULL)
     return true;
 
@@ -878,7 +878,7 @@ gfc_set_array_spec (gfc_symbol *sym, gfc_array_spec *as, locus *error_loc)
   attr = &sym->attr;
   if (gfc_submodule_procedure(attr))
     return true;
-  
+
   if (as->rank
       && !gfc_add_dimension (&sym->attr, sym->name, error_loc))
     return false;
@@ -2457,7 +2457,7 @@ gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result, mpz_t *end)
 	mpz_set_ui (stride, 1);
       else
 	{
-	  stride_expr = gfc_copy_expr(ar->stride[dimen]); 
+	  stride_expr = gfc_copy_expr(ar->stride[dimen]);
 
 	  if (!gfc_simplify_expr (stride_expr, 1)
 	     || stride_expr->expr_type != EXPR_CONSTANT

gcc/fortran/expr.cc

@@ -4371,9 +4371,18 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
 	  return false;
 	}
 
+      /* An assumed rank target is an experimental F202y feature.  */
+      if (rvalue->rank == -1 && !(gfc_option.allow_std & GFC_STD_F202Y))
+	{
+	  gfc_error ("The assumed rank target at %L is an experimental F202y "
+		     "feature. Use option -std=f202y to enable",
+		     &rvalue->where);
+	  return false;
+	}
+
       /* The target must be either rank one or it must be simply contiguous
 	 and F2008 must be allowed.  */
-      if (rvalue->rank != 1)
+      if (rvalue->rank != 1 && rvalue->rank != -1)
 	{
 	  if (!gfc_is_simply_contiguous (rvalue, true, false))
 	    {
@@ -4386,6 +4395,21 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
 	    return false;
 	}
     }
+  else if (rvalue->rank == -1)
+    {
+      gfc_error ("The data-target at %L is an assumed rank object and so the "
+		 "data-pointer-object %s must have a bounds remapping list "
+		 "(list of lbound:ubound for each dimension)",
+		  &rvalue->where, lvalue->symtree->name);
+      return false;
+    }
+
+  if (rvalue->rank == -1 && !gfc_is_simply_contiguous (rvalue, true, false))
+    {
+      gfc_error ("The assumed rank data-target at %L must be contiguous",
+		 &rvalue->where);
+      return false;
+    }
 
   /* Now punt if we are dealing with a NULLIFY(X) or X = NULL(X).  */
   if (rvalue->expr_type == EXPR_NULL)

gcc/fortran/gfortran.h

@@ -3034,6 +3034,8 @@ typedef struct gfc_association_list
 
   gfc_expr *target;
 
+  gfc_array_ref *ar;
+
   /* Used for inferring the derived type of an associate name, whose selector
      is a sibling derived type function that has not yet been parsed.  */
   gfc_symbol *derived_types;

gcc/fortran/interface.cc

@@ -3337,6 +3337,16 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	  goto match;
 	}
 
+      if (warn_surprising
+	  && a->expr->expr_type == EXPR_VARIABLE
+	  && a->expr->symtree->n.sym->as
+	  && a->expr->symtree->n.sym->as->type == AS_ASSUMED_SIZE
+	  && f->sym->as
+	  && f->sym->as->type == AS_ASSUMED_RANK)
+	gfc_warning (0, "The assumed-size dummy %qs is being passed at %L to "
+		     "an assumed-rank dummy %qs", a->expr->symtree->name,
+		     &a->expr->where, f->sym->name);
+
       if (a->expr->expr_type == EXPR_NULL
 	  && a->expr->ts.type == BT_UNKNOWN
 	  && f->sym->ts.type == BT_CHARACTER

gcc/fortran/intrinsic.cc

@@ -293,11 +293,15 @@ do_ts29113_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
 		     &a->expr->where, gfc_current_intrinsic);
 	  ok = false;
 	}
-      else if (a->expr->rank == -1 && !specific->inquiry)
+      else if (a->expr->rank == -1
+	       && !(specific->inquiry
+		    || (specific->id == GFC_ISYM_RESHAPE
+			&& (gfc_option.allow_std & GFC_STD_F202Y))))
 	{
 	  gfc_error ("Assumed-rank argument at %L is only permitted as actual "
-		     "argument to intrinsic inquiry functions",
-		     &a->expr->where);
+		     "argument to intrinsic inquiry functions or to RESHAPE. "
+		     "The latter is an experimental F202y feature. Use "
+		     "-std=f202y to enable", &a->expr->where);
 	  ok = false;
 	}
       else if (a->expr->rank == -1 && arg != a)
@@ -307,6 +311,13 @@ do_ts29113_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
 		     &a->expr->where, gfc_current_intrinsic);
 	  ok = false;
 	}
+      else if (a->expr->rank == -1 && specific->id == GFC_ISYM_RESHAPE
+	       && !gfc_is_simply_contiguous (a->expr, true, false))
+	{
+	  gfc_error ("Assumed rank argument to the RESHAPE intrinsic at %L "
+		     "must be contiguous", &a->expr->where);
+	  ok = false;
+	}
     }
 
   return ok;

gcc/fortran/invoke.texi

@@ -1,5 +1,5 @@
 @c Copyright (C) 2004-2024 Free Software Foundation, Inc.
-@c This is part of the GNU Fortran manual.   
+@c This is part of the GNU Fortran manual.
 @c For copying conditions, see the file gfortran.texi.
 
 @ignore
@@ -139,7 +139,7 @@ by type.  Explanations are in the following sections.
 -H -P
 -U@var{macro} -cpp -dD -dI -dM -dN -dU -fworking-directory
 -imultilib @var{dir}
--iprefix @var{file} -iquote -isysroot @var{dir} -isystem @var{dir} -nocpp 
+-iprefix @var{file} -iquote -isysroot @var{dir} -isystem @var{dir} -nocpp
 -nostdinc
 -undef
 }
@@ -312,7 +312,7 @@ JIAND, etc...). For a complete list of intrinsics see the full documentation.
 Obsolete flag.  The purpose of this option was to
 enable legacy math intrinsics such as COTAN and degree-valued trigonometric
 functions (e.g. TAND, ATAND, etc...) for compatability with older code. This
-option is no longer operable. The trigonometric functions are now either 
+option is no longer operable. The trigonometric functions are now either
 part of Fortran 2023 or GNU extensions.
 
 @opindex fdec-static
@@ -341,7 +341,7 @@ following the final comma.
 @cindex symbol names
 @cindex character set
 @item -fdollar-ok
-Allow @samp{$} as a valid non-first character in a symbol name. Symbols 
+Allow @samp{$} as a valid non-first character in a symbol name. Symbols
 that start with @samp{$} are rejected since it is unclear which rules to
 apply to implicit typing as different vendors implement different rules.
 Using @samp{$} in @code{IMPLICIT} statements is also rejected.
@@ -606,7 +606,10 @@ beyond the relevant language standard, and warnings are given for the
 Fortran 77 features that are permitted but obsolescent in later
 standards. The deprecated option @samp{-std=f2008ts} acts as an alias for
 @samp{-std=f2018}. It is only present for backwards compatibility with
-earlier gfortran versions and should not be used any more.
+earlier gfortran versions and should not be used any more. @samp{-std=f202y}
+acts as an alias for @samp{-std=f2023} and enables proposed features for
+testing Fortran 202y. As the Fortran 202y standard develops, implementation
+might change or the experimental new features might be removed.
 
 @opindex ftest-forall-temp
 @item -ftest-forall-temp
@@ -718,7 +721,7 @@ Like @option{-dD}, but emit only the macro names, not their expansions.
 @cindex debugging, preprocessor
 @item -dU
 Like @option{dD} except that only macros that are expanded, or whose
-definedness is tested in preprocessor directives, are output; the 
+definedness is tested in preprocessor directives, are output; the
 output is delayed until the use or test of the macro; and @code{'#undef'}
 directives are also output for macros tested but undefined at the time.
 
@@ -908,7 +911,7 @@ with a @option{-D} option.
 Errors are diagnostic messages that report that the GNU Fortran compiler
 cannot compile the relevant piece of source code.  The compiler will
 continue to process the program in an attempt to report further errors
-to aid in debugging, but will not produce any compiled output.  
+to aid in debugging, but will not produce any compiled output.
 
 Warnings are diagnostic messages that report constructions which
 are not inherently erroneous but which are risky or suggest there is
@@ -1027,7 +1030,7 @@ avoid such temporaries.
 @opindex Wc-binding-type
 @cindex warning, C binding type
 @item -Wc-binding-type
-Warn if the a variable might not be C interoperable.  In particular, warn if 
+Warn if the a variable might not be C interoperable.  In particular, warn if
 the variable has been declared using an intrinsic type with default kind
 instead of using a kind parameter defined for C interoperability in the
 intrinsic @code{ISO_C_Binding} module.  This option is implied by
@@ -1050,7 +1053,7 @@ error.
 @cindex warnings, conversion
 @cindex conversion
 @item -Wconversion
-Warn about implicit conversions that are likely to change the value of 
+Warn about implicit conversions that are likely to change the value of
 the expression after conversion. Implied by @option{-Wall}.
 
 @opindex Wconversion-extra
@@ -1191,7 +1194,7 @@ the desired intrinsic/procedure.  This option is implied by @option{-Wall}.
 @cindex warnings, use statements
 @cindex intrinsic
 @item -Wuse-without-only
-Warn if a @code{USE} statement has no @code{ONLY} qualifier and 
+Warn if a @code{USE} statement has no @code{ONLY} qualifier and
 thus implicitly imports all public entities of the used module.
 
 @opindex Wunused-dummy-argument
@@ -1436,8 +1439,8 @@ they are not in the default location expected by the compiler.
 @cindex options, linking
 @cindex linking, static
 
-These options come into play when the compiler links object files into an 
-executable output file. They are meaningless if the compiler is not doing 
+These options come into play when the compiler links object files into an
+executable output file. They are meaningless if the compiler is not doing
 a link step.
 
 @table @gcctabopt
@@ -1609,7 +1612,7 @@ referenced in it. Does not affect common blocks. (Some Fortran compilers
 provide this option under the name @option{-static} or @option{-save}.)
 The default, which is @option{-fautomatic}, uses the stack for local
 variables smaller than the value given by @option{-fmax-stack-var-size}.
-Use the option @option{-frecursive} to use no static memory. 
+Use the option @option{-frecursive} to use no static memory.
 
 Local variables or arrays having an explicit @code{SAVE} attribute are
 silently ignored unless the @option{-pedantic} option is added.
@@ -1880,7 +1883,7 @@ Deprecated alias for @option{-fcheck=array-temps}.
 
 @opindex fmax-array-constructor
 @item -fmax-array-constructor=@var{n}
-This option can be used to increase the upper limit permitted in 
+This option can be used to increase the upper limit permitted in
 array constructors.  The code below requires this option to expand
 the array at compile time.
 

gcc/fortran/lang.opt

@@ -7,12 +7,12 @@
 ; the terms of the GNU General Public License as published by the Free
 ; Software Foundation; either version 3, or (at your option) any later
 ; version.
-; 
+;
 ; GCC is distributed in the hope that it will be useful, but WITHOUT ANY
 ; WARRANTY; without even the implied warranty of MERCHANTABILITY or
 ; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
 ; for more details.
-; 
+;
 ; You should have received a copy of the GNU General Public License
 ; along with GCC; see the file COPYING3.  If not see
 ; <http://www.gnu.org/licenses/>.
@@ -930,6 +930,10 @@ std=f2023
 Fortran
 Conform to the ISO Fortran 2023 standard.
 
+std=f202y
+Fortran
+Enable experimental Fortran 202y features.
+
 std=f95
 Fortran
 Conform to the ISO Fortran 95 standard.

gcc/fortran/libgfortran.h

@@ -23,6 +23,7 @@ along with GCC; see the file COPYING3.  If not see
    Nevertheless, some features available in F2018 are prohibited in F2023.
    Please remember to keep those definitions in sync with
    gfortran.texi.  */
+#define GFC_STD_F202Y		(1<<14)	/* Enable proposed F202y features.  */
 #define GFC_STD_UNSIGNED	(1<<14) /* Not really a standard, but
 					   better for error handling.  */
 #define GFC_STD_F2023_DEL	(1<<13)	/* Prohibited in F2023.  */

gcc/fortran/match.cc

@@ -1925,7 +1925,29 @@ gfc_match_associate (void)
       gfc_association_list* a;
 
       /* Match the next association.  */
-      if (gfc_match (" %n =>", newAssoc->name) != MATCH_YES)
+      if (gfc_match (" %n ", newAssoc->name) != MATCH_YES)
+	{
+	  gfc_error ("Expected associate name at %C");
+	  goto assocListError;
+	}
+
+      /* Required for an assumed rank target.  */
+      if (gfc_peek_char () == '(')
+	{
+	  newAssoc->ar = gfc_get_array_ref ();
+	  if (gfc_match_array_ref (newAssoc->ar, NULL, 0, 0) != MATCH_YES)
+	    {
+	      gfc_error ("Bad bounds remapping list at %C");
+	      goto assocListError;
+	    }
+	}
+
+      if (newAssoc->ar && !(gfc_option.allow_std & GFC_STD_F202Y))
+	gfc_error_now ("The bounds remapping list at %C is an experimental "
+		       "F202y feature. Use std=f202y to enable");
+
+      /* Match the next association.  */
+      if (gfc_match (" =>", newAssoc->name) != MATCH_YES)
 	{
 	  gfc_error ("Expected association at %C");
 	  goto assocListError;
@@ -1969,6 +1991,35 @@ gfc_match_associate (void)
 	  goto assocListError;
 	}
 
+      if (newAssoc->target->expr_type == EXPR_VARIABLE
+	  && newAssoc->target->symtree->n.sym->as
+	  && newAssoc->target->symtree->n.sym->as->type == AS_ASSUMED_RANK)
+	{
+	  bool bounds_remapping_list = true;
+	  if (!newAssoc->ar)
+	    bounds_remapping_list = false;
+	  else
+	    for (int dim = 0; dim < newAssoc->ar->dimen; dim++)
+	      if (!newAssoc->ar->start[dim] || !newAssoc->ar->end[dim]
+		  || newAssoc->ar->stride[dim] != NULL)
+		bounds_remapping_list = false;
+
+	  if (!bounds_remapping_list)
+	    {
+	      gfc_error ("The associate name %s with an assumed rank "
+			 "target at %L must have a bounds remapping list "
+			 "(list of lbound:ubound for each dimension)",
+			 newAssoc->name, &newAssoc->target->where);
+	      goto assocListError;
+	    }
+
+	  if (!newAssoc->target->symtree->n.sym->attr.contiguous)
+	    {
+	      gfc_error ("The assumed rank target at %C must be contiguous");
+	      goto assocListError;
+	    }
+	}
+
       /* The `variable' field is left blank for now; because the target is not
 	 yet resolved, we can't use gfc_has_vector_subscript to determine it
 	 for now.  This is set during resolution.  */