diff options
| author | jvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4> | 2010-02-04 01:49:41 +0000 |
|---|---|---|
| committer | jvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4> | 2010-02-04 01:49:41 +0000 |
| commit | 892726ee4cd3bc659a82d688e67c864bdb596a62 (patch) | |
| tree | 7c8261f1179c9d5327450575d57efb332c47f520 /libgfortran | |
| parent | 288c5d15efdb0e472b952e2c190007b361b7e356 (diff) | |
| download | gcc-892726ee4cd3bc659a82d688e67c864bdb596a62.tar.gz | |
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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@156487 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'libgfortran')
| -rw-r--r-- | libgfortran/ChangeLog | 7 | ||||
| -rw-r--r-- | libgfortran/io/list_read.c | 38 |
2 files changed, 30 insertions, 15 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 2c9a8a83d97..c77b018e8dd 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,10 @@ +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 diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index c281e34eacf..e918b30e697 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; |