git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

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
This commit is contained in:
Jerry DeLisle 2010-02-04 01:49:41 +00:00
parent 264c5d9a0f
commit e3e2cdd182
2 changed files with 30 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
libgfortran/ChangeLog
View File

@ -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> 2010-01-15 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/42742 PR libfortran/42742

38
libgfortran/io/list_read.c
View File

@ -2566,7 +2566,7 @@ nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl,
namelist_info * first_nl = NULL; namelist_info * first_nl = NULL;
namelist_info * root_nl = NULL; namelist_info * root_nl = NULL;
int dim, parsed_rank; int dim, parsed_rank;
int component_flag; int component_flag, qualifier_flag;
index_type clow, chigh; index_type clow, chigh;
int non_zero_rank_count; int non_zero_rank_count;
@ -2615,11 +2615,12 @@ nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl,
break; 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. */ derived type components. */
nml_untouch_nodes (dtp); nml_untouch_nodes (dtp);
component_flag = 0; component_flag = 0;
qualifier_flag = 0;
non_zero_rank_count = 0; non_zero_rank_count = 0;
/* Get the object name - should '!' and '\n' be permitted separators? */ /* Get the object name - should '!' and '\n' be permitted separators? */
@ -2701,10 +2702,11 @@ get_name:
" for namelist variable %s", nl->var_name); " for namelist variable %s", nl->var_name);
goto nml_err_ret; goto nml_err_ret;
} }
if (parsed_rank > 0) if (parsed_rank > 0)
non_zero_rank_count++; non_zero_rank_count++;
qualifier_flag = 1;
c = next_char (dtp); c = next_char (dtp);
unget_char (dtp, c); unget_char (dtp, c);
} }
@ -2729,6 +2731,7 @@ get_name:
root_nl = nl; root_nl = nl;
component_flag = 1; component_flag = 1;
c = next_char (dtp); c = next_char (dtp);
goto get_name; goto get_name;
} }
@ -2769,15 +2772,6 @@ get_name:
unget_char (dtp, c); 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. */ /* Make sure no extraneous qualifiers are there. */
if (c == '(') if (c == '(')
@ -2822,10 +2816,24 @@ get_name:
nl->var_name); nl->var_name);
goto nml_err_ret; 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, if (nml_read_obj (dtp, nl, 0, pprev_nl, nml_err_msg, nml_err_msg_size,
clow, chigh) == FAILURE) clow, chigh) == FAILURE)
goto nml_err_ret; goto nml_err_ret;