From 3b111bd757f065188029914f9a7b21c1e1c3ccfe Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date: Mon, 26 May 2014 15:19:36 +0000
Subject: [PATCH] [multiple changes]

2014-05-26  Tobias Burnus  <burnus@net-b.de>

	PR fortran/55117
	* trans-io.c (nml_full_name, transfer_namelist_element): Insert
	a '+' rather then '%' to differentiate namelist variable names
	that are based on extended derived types.

2014-05-26  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/55117
	* io/list_read.c (extended_look_ahead): New helper function to
	scan the namelist name and look for matches with the new '+'
	extended type parent indicator.  (str_comp_extended): New
	helper function to compare the namelist name with the varname
	namelist. (find_nml_name): Use the new helper functions to match
	the extended type varnames.

From-SVN: r210934
---
 gcc/fortran/ChangeLog      |  7 +++++++
 gcc/fortran/trans-io.c     |  9 +++++----
 libgfortran/ChangeLog      | 10 ++++++++++
 libgfortran/io/list_read.c | 37 +++++++++++++++++++++++++++++++++++++
 4 files changed, 59 insertions(+), 4 deletions(-)

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 88c26ad3986..0a830a7ed6e 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2014-05-26  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/55117
+	* trans-io.c (nml_full_name, transfer_namelist_element): Insert
+	a '+' rather then '%' to differentiate namelist variable names
+	that are based on extended derived types.
+
 2014-05-25  Tobias Burnus  <burnus@net-b.de>
 
 	* check.c (gfc_check_num_images): New.
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index d15159857d0..fb6f69fa49c 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -1452,10 +1452,10 @@ gfc_trans_wait (gfc_code * code)
 
 
 /* nml_full_name builds up the fully qualified name of a
-   derived type component.  */
+   derived type component. '+' is used to denote a type extension.  */
 
 static char*
-nml_full_name (const char* var_name, const char* cmp_name)
+nml_full_name (const char* var_name, const char* cmp_name, bool parent)
 {
   int full_name_length;
   char * full_name;
@@ -1463,7 +1463,7 @@ nml_full_name (const char* var_name, const char* cmp_name)
   full_name_length = strlen (var_name) + strlen (cmp_name) + 1;
   full_name = XCNEWVEC (char, full_name_length + 1);
   strcpy (full_name, var_name);
-  full_name = strcat (full_name, "%");
+  full_name = strcat (full_name, parent ? "+" : "%");
   full_name = strcat (full_name, cmp_name);
   return full_name;
 }
@@ -1634,7 +1634,8 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
 
       for (cmp = ts->u.derived->components; cmp; cmp = cmp->next)
 	{
-	  char *full_name = nml_full_name (var_name, cmp->name);
+	  char *full_name = nml_full_name (var_name, cmp->name,
+					   ts->u.derived->attr.extension);
 	  transfer_namelist_element (block,
 				     full_name,
 				     NULL, cmp, expr);
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index cead92d2ed8..efa6f053a0d 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,13 @@
+2014-05-26  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR libgfortran/55117
+	* io/list_read.c (extended_look_ahead): New helper function to
+	scan the namelist name and look for matches with the new '+'
+	extended type parent indicator.  (str_comp_extended): New
+	helper function to compare the namelist name with the varname
+	namelist. (find_nml_name): Use the new helper functions to match
+	the extended type varnames.	
+
 2014-05-23  Jerry DeLisle  <jvdelisle@gcc.gnu>
 
 	PR libfortran/61173
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 5ccd0220ac1..13e38f48afb 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -2557,6 +2557,38 @@ err_ret:
   return false;
 }
 
+
+static bool
+extended_look_ahead (char *p, char *q)
+{
+  char *r, *s;
+
+  /* Scan ahead to find a '%' in the p string.  */
+  for(r = p, s = q; *r && *s; s++)
+    if ((*s == '%' || *s == '+') && strcmp (r + 1, s + 1) == 0)
+      return true;
+  return false;
+}
+
+
+static bool
+strcmp_extended_type (char *p, char *q)
+{
+  char *r, *s;
+  
+  for (r = p, s = q; *r && *s; r++, s++)
+    {
+      if (*r != *s)
+	{
+	  if (*r == '%' && *s == '+' && extended_look_ahead (r, s))
+	    return true;
+	  break;
+	}
+    }
+  return false;
+}
+
+
 static namelist_info *
 find_nml_node (st_parameter_dt *dtp, char * var_name)
 {
@@ -2568,6 +2600,11 @@ find_nml_node (st_parameter_dt *dtp, char * var_name)
 	  t->touched = 1;
 	  return t;
 	}
+      if (strcmp_extended_type (var_name, t->var_name))
+	{
+	  t->touched = 1;
+	  return t;
+	}
       t = t->next;
     }
   return NULL;