This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[patch, libgfortran] [4.3/4.4/4.5 Regression] reading array of structures from namelist fails


Hi all,

This patch fixes this regression by adding an additional flag to identify when array qualifiers have been seen for a derived type component. This flag is then used to identify when to reset the current namelist pointer to the correct namelist pointer (i.e. setting nl to first_nl).

The patch also cleans up the code by consolidating these flag tests in one place just before the call to read the object. I attempted to clean this up so that it is most readable. The logic is somewhat subtle to say the least.

As anyone figured out the half-life decay time for namelist bugs? :)

Regression tested on x86-64. New test case provided.

OK for trunk and then back port to 4.4 and 4.3?

Regards,

Jerry

2010-02-02 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.
Index: list_read.c
===================================================================
--- list_read.c	(revision 156423)
+++ list_read.c	(working copy)
@@ -2566,7 +2566,7 @@ nml_get_obj_data (st_parameter_dt *dtp, namelist_i
   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_i
       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 (first_nl != NULL && first_nl->var_rank > 0)
-    nl = first_nl;
-  
+  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 (nml_read_obj (dtp, nl, 0, pprev_nl, nml_err_msg, nml_err_msg_size,
 		    clow, chigh) == FAILURE)
     goto nml_err_ret;

Attachment: namelist_60.f90
Description: Text document


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]