]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
[multiple changes]
authorJerry DeLisle <jvdelisle@gcc.gnu.org>
Mon, 26 May 2014 15:19:36 +0000 (15:19 +0000)
committerJerry DeLisle <jvdelisle@gcc.gnu.org>
Mon, 26 May 2014 15:19:36 +0000 (15:19 +0000)
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
gcc/fortran/trans-io.c
libgfortran/ChangeLog
libgfortran/io/list_read.c

index 88c26ad3986f3d47ee0ecd9309ab763433932ce9..0a830a7ed6ebb49a16dd136f27011bdc4f06b8d5 100644 (file)
@@ -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.
index d15159857d00a1fc5c66c4b6a2c7199a98a99805..fb6f69fa49c7a878aa0ddffc730200db69b2a213 100644 (file)
@@ -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);
index cead92d2ed8671a275fbf2a676ea484c96ae07f8..efa6f053a0d49ca5111fc0e7b08b42a3783dc0d8 100644 (file)
@@ -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
index 5ccd0220ac1567c783fa7411d051e09cca022194..13e38f48afb0b0f0c4e33a2f649206ed32bc64b1 100644 (file)
@@ -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;