diff options
| author | Steven G. Kargl <kargl@gcc.gnu.org> | 2017-12-28 20:19:01 +0000 |
|---|---|---|
| committer | Steven G. Kargl <kargl@gcc.gnu.org> | 2017-12-28 20:19:01 +0000 |
| commit | 4e48b472ed4ee625e68bcf5080d050151d6e3ab4 (patch) | |
| tree | 6fb75aacacf917291267381d138b2f350fa8683c /gcc/fortran/match.c | |
| parent | 208413c7b4d3a2360ba4864f00ceaf720b4f67c7 (diff) | |
| download | gcc-4e48b472ed4ee625e68bcf5080d050151d6e3ab4.zip gcc-4e48b472ed4ee625e68bcf5080d050151d6e3ab4.tar.gz gcc-4e48b472ed4ee625e68bcf5080d050151d6e3ab4.tar.bz2 | |
re PR fortran/83548 (Compilation Error using logical function in parameter)
2017-12-28 Steven G. Kargl <kargl@gcc.gnu.org>
PR Fortran/83548
* match.c (gfc_match_type_spec): Check for LOGICAL conflict in
type-spec versus LOGICAL intrinsic subprogram.
2017-12-28 Steven G. Kargl <kargl@gcc.gnu.org>
PR Fortran/83548
* gfortran.dg/array_constructor_type_22.f03: New test.
From-SVN: r256022
Diffstat (limited to 'gcc/fortran/match.c')
| -rw-r--r-- | gcc/fortran/match.c | 30 |
1 files changed, 17 insertions, 13 deletions
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index f7de5d5..d251a4d 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -2102,27 +2102,31 @@ gfc_match_type_spec (gfc_typespec *ts) return m; } - if (gfc_match ("logical") == MATCH_YES) - { - ts->type = BT_LOGICAL; - ts->kind = gfc_default_logical_kind; - goto kind_selector; - } - /* REAL is a real pain because it can be a type, intrinsic subprogram, or list item in a type-list of an OpenMP reduction clause. Need to differentiate REAL([KIND]=scalar-int-initialization-expr) from - REAL(A,[KIND]) and REAL(KIND,A). */ + REAL(A,[KIND]) and REAL(KIND,A). Logically, when this code was + written the use of LOGICAL as a type-spec or intrinsic subprogram + was overlooked. */ m = gfc_match (" %n", name); - if (m == MATCH_YES && strcmp (name, "real") == 0) + if (m == MATCH_YES + && (strcmp (name, "real") == 0 || strcmp (name, "logical") == 0)) { char c; gfc_expr *e; locus where; - ts->type = BT_REAL; - ts->kind = gfc_default_real_kind; + if (*name == 'r') + { + ts->type = BT_REAL; + ts->kind = gfc_default_real_kind; + } + else + { + ts->type = BT_LOGICAL; + ts->kind = gfc_default_logical_kind; + } gfc_gobble_whitespace (); @@ -2154,7 +2158,7 @@ gfc_match_type_spec (gfc_typespec *ts) c = gfc_next_char (); if (c == '=') { - if (strcmp(name, "a") == 0) + if (strcmp(name, "a") == 0 || strcmp(name, "l") == 0) return MATCH_NO; else if (strcmp(name, "kind") == 0) goto found; @@ -2194,7 +2198,7 @@ found: gfc_next_char (); /* Burn the ')'. */ ts->kind = (int) mpz_get_si (e->value.integer); - if (gfc_validate_kind (BT_REAL, ts->kind , true) == -1) + if (gfc_validate_kind (ts->type, ts->kind , true) == -1) { gfc_error ("Invalid type-spec at %C"); return MATCH_ERROR; |