Re: [gfortran/patch] Support NAMELIST I/O of derived type variables (compiler side)

[Paul Brook <paul at codesourcery dot com>]

On Thursday 12 August 2004 08:25, Victor Leikehman wrote:
> This is the compiler side part of the fix that adds support of NAMELIST I/O
> of derived type variables. ?Library fix to appear in a separate message.
>
> Some remarks:
>
> 1. I am not entirely satisfied with the name "build_namelist".
> ?Improvements are welcome.

Maybe transfer_namelist, which is consistent with the existing transfer_expr.

> 2. In a similar fix to transfer_expr, Paul added call to gfc_evaluate_now.
> ? ?I don't understand if it should be here as well.

It should, see below.

> 3. String support was broken (passed only the first character). ?I pass
> ? ?now the string length in the kind field. ?Not sure if this is the right
> ? ?approach.

It isn't the right approach. Character variables can have different type 
kinds, though we only currently support one.

> 4. Array support is still broken. ?Volunteers are welcome.

<silence> :-)

> + static void
> + build_namelist (stmtblock_t * block, gfc_typespec * ts, tree addr_expr,
> + ? ? ? ? ? ? ? ? tree string, tree string_length)
> + {
> + ? tree tmp, args, arg2;
> + ? tree expr;
> +
> + ? assert (POINTER_TYPE_P (TREE_TYPE (addr_expr)));
> +
> + ? if (ts->type == BT_DERIVED)
> + ? ? {
> + ? ? ? gfc_component *c;
> + ? ? ? expr = gfc_build_indirect_ref (addr_expr);
> +
> + ? ? ? for (c = ts->derived->components; c; c = c->next)
> + ? ? ? ? {
> + ? ? ? ? ? tree field = c->backend_decl;
> + ? ? ? ? ? assert (field && TREE_CODE (field) == FIELD_DECL);
> + ? ? ? ? ? tmp = build (COMPONENT_REF, TREE_TYPE (field), expr, field,
> NULL_TREE); +
> + ? ? ? ? ? if (c->dimension)
> + ? ? ? ? ? ? gfc_todo_error ("NAMELIST IO of array in derived type");
> + ? ?
> + ? ? ? ? ? build_namelist (block, &c->ts,
> + ? ? ? ? ? ? ? ? ? ? ? ? ? gfc_build_addr_expr (NULL, tmp), string,
> string_length); +

Don't take the address if c->pointer is set.

<snip>

> + ? if (ts->type != BT_CHARACTER)
> + ? ? ? arg2 = build_int_2 (ts->kind, 0);
> + ? else
> + ? ? {
> + ? ? ? expr = gfc_build_indirect_ref (addr_expr);
> + ? ? ? assert (TREE_CODE (TREE_TYPE (expr)) == ARRAY_TYPE);
> + ? ? ? arg2 = TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (expr)));
> + ? ? }

Pass an extra string length parameter to st_set_nml_val_char for the string 
length.

<>
> *************** build_dt (tree * function, gfc_code * co
<>
> --- 1017,1033 ----
> ? ? ? ? ?if (last_dt == READ)
> ? ? ? ? ? ? set_flag (&block, ioparm_namelist_read_mode);
> ?
> ! ? ? ? ?for (nml = dt->namelist->namelist; nml; nml = nml->next)
> ! ? ? ? ? ?{
> ! ? ? ? ? ? ?gfc_init_se (&se, NULL);
> ! ? ? ? ? ? ?gfc_init_se (&se2, NULL);
> ! ? ? ? ? ? ?nmlvar = get_new_var_expr (nml->sym);
> ! ? ? ? ? ? ?nmlname = gfc_new_nml_name_expr (nml->sym->name);
> ! ? ? ? ? ? ?gfc_conv_expr_reference (&se2, nmlname);
> ! ? ? ? ? ? ?gfc_conv_expr_reference (&se, nmlvar);

Add gfc_evaluate_now(se->expr, &se->pre); here.
 ?
> ! ? ? ? ? ? ?build_namelist (&block, &nml->sym->ts, se.expr, se2.expr,
> se2.string_length); ! ? ? ? ? ?}
> ? ? ? }

Paul