diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/fortran/check.c | 12 | ||||
| -rw-r--r-- | gcc/fortran/expr.c | 9 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 2 | ||||
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 3 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/coarray_collectives_8.f90 | 14 |
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 |