This is the mail archive of the mailing list for the GCC project.

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Patch, Fortran] Some coarray fixes

This patch primarily adds a check that the "A" argument (= source/result) of a collective is definable. I found the issue when a co_* test case didn't work with vector subscripts. (gfortran doesn't do a copy-out.)

The patch additionally fixes one issue I found on the way: gfc_check_vardef_context with context == NULL segfaulted for vector subscripts.

And I fixed two issues I encountered with coindexed strings:

a) gfc_conv_string_tmp requires that the "type" argument is a pointer â otherwise, it will ICE. (See also other uses of that function) b) get_scalar_to_descriptor_type: If the argument is a pointer, the type and hence the dtype is wrong.

I found those while writing a test case for coindexed strings and type conversion; I will later submit the test case together with some other coarray-related patches, but to clean up my trunk and to make strings already usable, I have included those bits of the patch already.

Build and regtested on x86-64-gnu-linux.
OK for the trunk?

2014-06-21  Tobias Burnus  <>

	* check.c (check_co_minmaxsum): Add definable check.
	* expr.c (gfc_check_vardef_context): Fix context == NULL case.
	* trans-expr.c (get_scalar_to_descriptor_type): Handle pointer arguments.
	* trans-intrinsic.c (gfc_conv_intrinsic_caf_get): Fix generation of temporary

2014-06-21  Tobias Burnus  <>

	* gfortran.dg/coarray_collectives_7.f90: New.

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index bd3eff6..10944eb 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1307,6 +1307,18 @@ check_co_minmaxsum (gfc_expr *a, gfc_expr *result_image, gfc_expr *stat,
   if (!variable_check (a, 0, false))
     return false;
+  if (!gfc_check_vardef_context (a, false, false, false, "argument 'A' with "
+				 "INTENT(INOUT)"))
+    return false;
+  if (gfc_has_vector_subscript (a))
+    {
+      gfc_error ("Argument 'A' with INTENT(INOUT) at %L of the intrinsic "
+		 "subroutine %s shall not have a vector subscript",
+		 &a->where, gfc_current_intrinsic);
+      return false;
+    }
   if (result_image != NULL)
       if (!type_check (result_image, 1, BT_INTEGER))
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index f0238c1..feb089e 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4956,10 +4956,11 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
 			  en = n->expr;
 			  if (gfc_dep_compare_expr (ec, en) == 0)
-			      gfc_error_now ("Elements with the same value at %L"
-					     " and %L in vector subscript"
-					     " in a variable definition"
-					     " context (%s)", &(ec->where),
+			      if (context)
+				gfc_error_now ("Elements with the same value at %L"
+					       " and %L in vector subscript"
+					       " in a variable definition"
+					       " context (%s)", &(ec->where),
 					     &(en->where), context);
 			      return false;
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index d67d737..7ee0206 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -57,6 +57,8 @@ get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr)
+  if (POINTER_TYPE_P (TREE_TYPE (scalar)))
+    scalar = TREE_TYPE (scalar);
   return gfc_get_array_type_bounds (TREE_TYPE (scalar), 0, 0, NULL, NULL, 1,
 				    akind, !(attr.pointer ||;
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 548fd9f..a0c7421 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1258,7 +1258,8 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind)
 	  gfc_clear_attr (&attr);
 	  if (array_expr->ts.type == BT_CHARACTER)
-	    res_var = gfc_conv_string_tmp (se, type, argse.string_length);
+	    res_var = gfc_conv_string_tmp (se, build_pointer_type (type),
+					   argse.string_length);
 	    res_var = gfc_create_var (type, "caf_res");
 	  dst_var = gfc_conv_scalar_to_descriptor (&argse, res_var, attr);
diff --git a/gcc/testsuite/gfortran.dg/coarray_collectives_8.f90 b/gcc/testsuite/gfortran.dg/coarray_collectives_8.f90
new file mode 100644
index 0000000..aa97b7f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_collectives_7.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib" }
+! As SOURCE is INTENT(INOUT), it must be definable,
+! cf. J3/14-147
+intrinsic :: co_sum, co_min, co_max
+integer :: vec(3), idx(3)
+call co_sum(vec(idx)) ! { dg-error "Argument 'A' with INTENT\\(INOUT\\) at .1. of the intrinsic subroutine co_sum shall not have a vector subscript" }
+call co_min(vec([1,3,2])) ! { dg-error "Argument 'A' with INTENT\\(INOUT\\) at .1. of the intrinsic subroutine co_min shall not have a vector subscript" }
+call co_sum(vec([1,1,1])) ! { dg-error "Elements with the same value at .1. and .2. in vector subscript in a variable definition context \\(argument 'A' with INTENT\\(INOUT\\)\\)" }

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]