aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTobias Burnus <burnus@net-b.de>2014-06-25 22:26:42 +0200
committerTobias Burnus <burnus@gcc.gnu.org>2014-06-25 22:26:42 +0200
commitaa9ca5ca4f3e9e272a7dcc518d037927b319bb27 (patch)
treea15b037bed16a18aeac9a00c6147d44c259deb02
parentdb88b449589fa989c1f72e4796d2bce291b6cedf (diff)
downloadgcc-aa9ca5ca4f3e9e272a7dcc518d037927b319bb27.zip
gcc-aa9ca5ca4f3e9e272a7dcc518d037927b319bb27.tar.gz
gcc-aa9ca5ca4f3e9e272a7dcc518d037927b319bb27.tar.bz2
check.c (check_co_minmaxsum): Add definable check.
gcc/fortran/ 2014-06-25 Tobias Burnus <burnus@net-b.de> * 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 strings. gcc/testsuite/ 2014-06-25 Tobias Burnus <burnus@net-b.de> * gfortran.dg/coarray_collectives_7.f90: New. From-SVN: r211992
-rw-r--r--gcc/fortran/ChangeLog8
-rw-r--r--gcc/fortran/check.c12
-rw-r--r--gcc/fortran/expr.c9
-rw-r--r--gcc/fortran/trans-expr.c2
-rw-r--r--gcc/fortran/trans-intrinsic.c3
-rw-r--r--gcc/testsuite/ChangeLog4
-rw-r--r--gcc/testsuite/gfortran.dg/coarray_collectives_8.f9014
7 files changed, 47 insertions, 5 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b4bbb0a8..12606ff 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2014-06-25 Tobias Burnus <burnus@net-b.de>
+
+ * 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
+ strings.
+
2014-06-25 Jakub Jelinek <jakub@redhat.com>
* trans.h (gfc_omp_clause_linear_ctor): New prototype.
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)
else
akind = GFC_ARRAY_ASSUMED_SHAPE_CONT;
+ 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 || attr.target));
}
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);
else
res_var = gfc_create_var (type, "caf_res");
dst_var = gfc_conv_scalar_to_descriptor (&argse, res_var, attr);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 62c13c2..7046ff7 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2014-06-25 Tobias Burnus <burnus@net-b.de>
+
+ * gfortran.dg/coarray_collectives_7.f90: New.
+
2014-06-25 Bernd Edlinger <bernd.edlinger@hotmail.de>
* gcc.c-torture/execute/20140622-1.c: New test.
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_8.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\\)\\)" }
+end