OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/42901 (reading array of structures from namelist fails) 

2010-02-04  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: r156507
This commit is contained in:
Jerry DeLisle 2010-02-05 04:47:12 +00:00
parent 15234f94a0
commit 19c6b16e93
2 changed files with 34 additions and 19 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-04 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-21 Release Manager
* GCC 4.4.3 released.

46
libgfortran/io/list_read.c
View File

@ -287,10 +287,10 @@ static void
eat_line (st_parameter_dt *dtp)
{
char c;
if (!is_internal_unit (dtp))
do
c = next_char (dtp);
while (c != '\n');
do
c = next_char (dtp);
while (c != '\n');
}
@ -2563,7 +2563,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;
@ -2612,11 +2612,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? */
@ -2698,10 +2699,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);
}
@ -2726,6 +2728,7 @@ get_name:
root_nl = nl;
component_flag = 1;
c = next_char (dtp);
goto get_name;
}
@ -2766,15 +2769,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 == '(')
@ -2819,10 +2813,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;