diff options
| author | Tobias Burnus <burnus@net-b.de> | 2013-04-04 09:22:24 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2013-04-04 09:22:24 +0200 |
| commit | 6082753edc5406f746a196b8bb201c323fea2d8e (patch) | |
| tree | b31894bfd5f4beb3214c091e72ce78063a0a97af /gcc/fortran/check.c | |
| parent | b40192276fe996535b0a3de24ce3e748179aa667 (diff) | |
| download | gcc-6082753edc5406f746a196b8bb201c323fea2d8e.zip gcc-6082753edc5406f746a196b8bb201c323fea2d8e.tar.gz gcc-6082753edc5406f746a196b8bb201c323fea2d8e.tar.bz2 | |
re PR fortran/50269 (Wrongly rejects element of assumed-shape array in C_LOC)
2013-04-04 Tobias Burnus <burnus@net-b.de>
PR fortran/50269
* gcc/fortran/check.c (is_c_interoperable,
gfc_check_c_loc): Correct c_loc array checking
for Fortran 2003 and Fortran 2008.
2013-04-04 Tobias Burnus <burnus@net-b.de>
PR fortran/50269
* gfortran.dg/c_loc_test_21.f90: New.
* gfortran.dg/c_loc_test_19.f90: Update dg-error.
* gfortran.dg/c_loc_tests_10.f03: Update dg-error.
* gfortran.dg/c_loc_tests_11.f03: Update dg-error.
* gfortran.dg/c_loc_tests_4.f03: Update dg-error.
* gfortran.dg/c_loc_tests_16.f90: Update dg-error.
From-SVN: r197468
Diffstat (limited to 'gcc/fortran/check.c')
| -rw-r--r-- | gcc/fortran/check.c | 27 |
1 files changed, 22 insertions, 5 deletions
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 99174bc..5df5d2f 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -3649,11 +3649,12 @@ gfc_check_sizeof (gfc_expr *arg) /* Check whether an expression is interoperable. When returning false, msg is set to a string telling why the expression is not interoperable, otherwise, it is set to NULL. The msg string can be used in diagnostics. - If all_len_okay is true, all length-type parameters (for character) are - allowed. Required for C_LOC (cf. Fortran 2003corr5 or Fortran 2008). */ + If c_loc is true, character with len > 1 are allowed (cf. Fortran + 2003corr5); additionally, assumed-shape/assumed-rank/deferred-shape + arrays are permitted. */ static bool -is_c_interoperable (gfc_expr *expr, const char **msg, bool all_len_okay) +is_c_interoperable (gfc_expr *expr, const char **msg, bool c_loc) { *msg = NULL; @@ -3706,7 +3707,7 @@ is_c_interoperable (gfc_expr *expr, const char **msg, bool all_len_okay) && gfc_simplify_expr (expr, 0) == FAILURE) gfc_internal_error ("is_c_interoperable(): gfc_simplify_expr failed"); - if (!all_len_okay && expr->ts.u.cl + if (!c_loc && expr->ts.u.cl && (!expr->ts.u.cl->length || expr->ts.u.cl->length->expr_type != EXPR_CONSTANT || mpz_cmp_si (expr->ts.u.cl->length->value.integer, 1) != 0)) @@ -3726,7 +3727,7 @@ is_c_interoperable (gfc_expr *expr, const char **msg, bool all_len_okay) return false; } - if (expr->rank > 0 && expr->expr_type != EXPR_ARRAY) + if (!c_loc && expr->rank > 0 && expr->expr_type != EXPR_ARRAY) { gfc_array_ref *ar = gfc_find_array_ref (expr); if (ar->type != AR_FULL) @@ -4043,6 +4044,22 @@ gfc_check_c_loc (gfc_expr *x) " argument to C_LOC: %s", &x->where, msg) == FAILURE) return FAILURE; } + else if (x->rank > 0 && gfc_notification_std (GFC_STD_F2008)) + { + gfc_array_ref *ar = gfc_find_array_ref (x); + + if (ar->as->type != AS_EXPLICIT && ar->as->type != AS_ASSUMED_SIZE + && !attr.allocatable + && gfc_notify_std (GFC_STD_F2008, "Array of interoperable type at %L " + "to C_LOC which is nonallocatable and neither " + "assumed size nor explicit size", &x->where) + == FAILURE) + return FAILURE; + else if (ar->type != AR_FULL + && gfc_notify_std (GFC_STD_F2008, "Array section at %L " + "to C_LOC", &x->where) == FAILURE) + return FAILURE; + } return SUCCESS; } |