diff options
| author | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2010-02-04 01:49:41 +0000 |
|---|---|---|
| committer | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2010-02-04 01:49:41 +0000 |
| commit | e3e2cdd182e890304a87adde7a107ca2220b1e82 (patch) | |
| tree | 7c8261f1179c9d5327450575d57efb332c47f520 /libgfortran/io | |
| parent | 264c5d9a0f1a24e88f5678cc33a8bb3ccb08f774 (diff) | |
| download | gcc-e3e2cdd182e890304a87adde7a107ca2220b1e82.zip gcc-e3e2cdd182e890304a87adde7a107ca2220b1e82.tar.gz gcc-e3e2cdd182e890304a87adde7a107ca2220b1e82.tar.bz2 | |
re PR fortran/42901 (reading array of structures from namelist fails)
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.
From-SVN: r156487
Diffstat (limited to 'libgfortran/io')
| -rw-r--r-- | libgfortran/io/list_read.c | 38 |
1 files changed, 23 insertions, 15 deletions
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index c281e34..e918b30 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -2566,7 +2566,7 @@ nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl, 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; @@ -2615,11 +2615,12 @@ nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl, 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? */ @@ -2701,10 +2702,11 @@ get_name: " 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); } @@ -2729,6 +2731,7 @@ get_name: root_nl = nl; component_flag = 1; + c = next_char (dtp); goto get_name; } @@ -2769,15 +2772,6 @@ 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 == '(') @@ -2822,10 +2816,24 @@ get_name: 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; |