From 892726ee4cd3bc659a82d688e67c864bdb596a62 Mon Sep 17 00:00:00 2001 From: jvdelisle Date: Thu, 4 Feb 2010 01:49:41 +0000 Subject: 2010-02-03 Jerry DeLisle 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 --- libgfortran/ChangeLog | 7 +++++++ libgfortran/io/list_read.c | 38 +++++++++++++++++++++++--------------- 2 files changed, 30 insertions(+), 15 deletions(-) (limited to 'libgfortran') 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 + + 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 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; -- cgit v1.2.1