+2010-02-03 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+ PR libfortran/42901
+ * io/list_read.c (nml_get_obj_data): Add new qualifier flag, clean up
+ code, and adjust logic to set namelist info pointer correctly for array
+ qualifiers of derived type components.
+
2010-01-15 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/42742
namelist_info * first_nl = NULL;
namelist_info * root_nl = NULL;
int dim, parsed_rank;
- int component_flag;
+ int component_flag, qualifier_flag;
index_type clow, chigh;
int non_zero_rank_count;
break;
}
- /* Untouch all nodes of the namelist and reset the flag that is set for
+ /* Untouch all nodes of the namelist and reset the flags that are set for
derived type components. */
nml_untouch_nodes (dtp);
component_flag = 0;
+ qualifier_flag = 0;
non_zero_rank_count = 0;
/* Get the object name - should '!' and '\n' be permitted separators? */
" for namelist variable %s", nl->var_name);
goto nml_err_ret;
}
-
if (parsed_rank > 0)
non_zero_rank_count++;
+ qualifier_flag = 1;
+
c = next_char (dtp);
unget_char (dtp, c);
}
root_nl = nl;
component_flag = 1;
+
c = next_char (dtp);
goto get_name;
}
unget_char (dtp, c);
}
- /* If a derived type touch its components and restore the root
- namelist_info if we have parsed a qualified derived type
- component. */
-
- if (nl->type == GFC_DTYPE_DERIVED)
- nml_touch_nodes (nl);
- if (component_flag && nl->var_rank > 0 && nl->next)
- nl = first_nl;
-
/* Make sure no extraneous qualifiers are there. */
if (c == '(')
nl->var_name);
goto nml_err_ret;
}
+ /* If a derived type, touch its components and restore the root
+ namelist_info if we have parsed a qualified derived type
+ component. */
+
+ if (nl->type == GFC_DTYPE_DERIVED)
+ nml_touch_nodes (nl);
+
+ if (first_nl)
+ {
+ if (first_nl->var_rank == 0)
+ {
+ if (component_flag && qualifier_flag)
+ nl = first_nl;
+ }
+ else
+ nl = first_nl;
+ }
- if (first_nl != NULL && first_nl->var_rank > 0)
- nl = first_nl;
-
if (nml_read_obj (dtp, nl, 0, pprev_nl, nml_err_msg, nml_err_msg_size,
clow, chigh) == FAILURE)
goto nml_err_ret;