diff options
Diffstat (limited to 'gcc/fortran/parse.cc')
-rw-r--r-- | gcc/fortran/parse.cc | 96 |
1 files changed, 46 insertions, 50 deletions
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc index e103ebe..abd3a42 100644 --- a/gcc/fortran/parse.cc +++ b/gcc/fortran/parse.cc @@ -5133,6 +5133,7 @@ parse_associate (void) { gfc_symbol* sym; gfc_expr *target; + int rank; if (gfc_get_sym_tree (a->name, NULL, &a->st, false)) gcc_unreachable (); @@ -5196,62 +5197,57 @@ parse_associate (void) } } - if (target->rank) + rank = target->rank; + /* Fixup cases where the ranks are mismatched. */ + if (sym->ts.type == BT_CLASS && CLASS_DATA (sym)) { - int rank = 0; - rank = target->rank; - /* When the rank is greater than zero then sym will be an array. */ - if (sym->ts.type == BT_CLASS && CLASS_DATA (sym)) + if ((!CLASS_DATA (sym)->as && rank != 0) + || (CLASS_DATA (sym)->as + && CLASS_DATA (sym)->as->rank != rank)) { - if ((!CLASS_DATA (sym)->as && rank != 0) - || (CLASS_DATA (sym)->as - && CLASS_DATA (sym)->as->rank != rank)) + /* Don't just (re-)set the attr and as in the sym.ts, + because this modifies the target's attr and as. Copy the + data and do a build_class_symbol. */ + symbol_attribute attr = CLASS_DATA (target)->attr; + int corank = gfc_get_corank (target); + gfc_typespec type; + + if (rank || corank) { - /* Don't just (re-)set the attr and as in the sym.ts, - because this modifies the target's attr and as. Copy the - data and do a build_class_symbol. */ - symbol_attribute attr = CLASS_DATA (target)->attr; - int corank = gfc_get_corank (target); - gfc_typespec type; - - if (rank || corank) - { - as = gfc_get_array_spec (); - as->type = AS_DEFERRED; - as->rank = rank; - as->corank = corank; - attr.dimension = rank ? 1 : 0; - attr.codimension = corank ? 1 : 0; - } - else - { - as = NULL; - attr.dimension = attr.codimension = 0; - } - attr.class_ok = 0; - type = CLASS_DATA (sym)->ts; - if (!gfc_build_class_symbol (&type, - &attr, &as)) - gcc_unreachable (); - sym->ts = type; - sym->ts.type = BT_CLASS; - sym->attr.class_ok = 1; + as = gfc_get_array_spec (); + as->type = AS_DEFERRED; + as->rank = rank; + as->corank = corank; + attr.dimension = rank ? 1 : 0; + attr.codimension = corank ? 1 : 0; } else - sym->attr.class_ok = 1; - } - else if ((!sym->as && rank != 0) - || (sym->as && sym->as->rank != rank)) - { - as = gfc_get_array_spec (); - as->type = AS_DEFERRED; - as->rank = rank; - as->corank = gfc_get_corank (target); - sym->as = as; - sym->attr.dimension = 1; - if (as->corank) - sym->attr.codimension = 1; + { + as = NULL; + attr.dimension = attr.codimension = 0; + } + attr.class_ok = 0; + type = CLASS_DATA (sym)->ts; + if (!gfc_build_class_symbol (&type, &attr, &as)) + gcc_unreachable (); + sym->ts = type; + sym->ts.type = BT_CLASS; + sym->attr.class_ok = 1; } + else + sym->attr.class_ok = 1; + } + else if ((!sym->as && rank != 0) + || (sym->as && sym->as->rank != rank)) + { + as = gfc_get_array_spec (); + as->type = AS_DEFERRED; + as->rank = rank; + as->corank = gfc_get_corank (target); + sym->as = as; + sym->attr.dimension = 1; + if (as->corank) + sym->attr.codimension = 1; } } |