[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
This commit is contained in:
parent
d93461f724
commit
3b111bd757
|
@ -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.
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
|
Loading…
Reference in New Issue