2009-08-13 Janus Weil <janus@gcc.gnu.org>

	PR fortran/40941
	* gfortran.h (gfc_typespec): Put 'derived' and 'cl' into union.
	* decl.c (build_struct): Make sure 'cl' is only used
	if type is BT_CHARACTER.
	* symbol.c (gfc_set_default_type): Ditto.
	* resolve.c (resolve_symbol, resolve_fl_derived): Ditto.
	(resolve_equivalence,resolve_equivalence_derived): Make sure 'derived'
	is only used if type is BT_DERIVED.
	* trans-io.c (transfer_expr): Make sure 'derived' is only used if type
	is BT_DERIVED or BT_INTEGER (special case: C_PTR/C_FUNPTR).
	* array.c: Mechanical replacements to accomodate union in gfc_typespec.
	* check.c: Ditto.
	* data.c: Ditto.
	* decl.c: Ditto.
	* dump-parse-tree.c: Ditto.
	* expr.c: Ditto.
	* interface.c: Ditto.
	* iresolve.c: Ditto.
	* match.c: Ditto.
	* misc.c: Ditto.
	* module.c: Ditto.
	* openmp.c: Ditto.
	* parse.c: Ditto.
	* primary.c: Ditto.
	* resolve.c: Ditto.
	* simplify.c: Ditto.
	* symbol.c: Ditto.
	* target-memory.c: Ditto.
	* trans-array.c: Ditto.
	* trans-common.c: Ditto.
	* trans-const.c: Ditto.
	* trans-decl.c: Ditto.
	* trans-expr.c: Ditto.
	* trans-intrinsic.c: Ditto.
	* trans-io.c: Ditto.
	* trans-stmt.c: Ditto.
	* trans-types.c: Ditto.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@150725 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a07ee12..f48729e 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,45 @@
 2009-08-13  Janus Weil  <janus@gcc.gnu.org>
 
 2009-08-13  Janus Weil  <janus@gcc.gnu.org>
 

+       PR fortran/40941
+       * gfortran.h (gfc_typespec): Put 'derived' and 'cl' into union.
+       * decl.c (build_struct): Make sure 'cl' is only used
+       if type is BT_CHARACTER.
+       * symbol.c (gfc_set_default_type): Ditto.
+       * resolve.c (resolve_symbol, resolve_fl_derived): Ditto.
+       (resolve_equivalence,resolve_equivalence_derived): Make sure 'derived'
+       is only used if type is BT_DERIVED.
+       * trans-io.c (transfer_expr): Make sure 'derived' is only used if type
+       is BT_DERIVED or BT_INTEGER (special case: C_PTR/C_FUNPTR).
+       * array.c: Mechanical replacements to accomodate union in gfc_typespec.
+       * check.c: Ditto.
+       * data.c: Ditto.
+       * decl.c: Ditto.
+       * dump-parse-tree.c: Ditto.
+       * expr.c: Ditto.
+       * interface.c: Ditto.
+       * iresolve.c: Ditto.
+       * match.c: Ditto.
+       * misc.c: Ditto.
+       * module.c: Ditto.
+       * openmp.c: Ditto.
+       * parse.c: Ditto.
+       * primary.c: Ditto.
+       * resolve.c: Ditto.
+       * simplify.c: Ditto.
+       * symbol.c: Ditto.
+       * target-memory.c: Ditto.
+       * trans-array.c: Ditto.
+       * trans-common.c: Ditto.
+       * trans-const.c: Ditto.
+       * trans-decl.c: Ditto.
+       * trans-expr.c: Ditto.
+       * trans-intrinsic.c: Ditto.
+       * trans-io.c: Ditto.
+       * trans-stmt.c: Ditto.
+       * trans-types.c: Ditto.
+
+2009-08-13  Janus Weil  <janus@gcc.gnu.org>
+

        PR fortran/40995
        * resolve.c (resolve_symbol): Move some checking code to
        resolve_intrinsic, and call this from here.
        PR fortran/40995
        * resolve.c (resolve_symbol): Move some checking code to
        resolve_intrinsic, and call this from here.

diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index 2fee465..2e12a14 100644 (file)
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -968,8 +968,8 @@ done:
   else
     expr->ts.type = BT_UNKNOWN;
   
   else
     expr->ts.type = BT_UNKNOWN;
   

-  if (expr->ts.cl)
-    expr->ts.cl->length_from_typespec = seen_ts;
+  if (expr->ts.u.cl)
+    expr->ts.u.cl->length_from_typespec = seen_ts;

 
   expr->where = where;
   expr->rank = 1;
 
   expr->where = where;
   expr->rank = 1;


@@ -1588,25 +1588,25 @@ gfc_resolve_character_array_constructor (gfc_expr *expr)
   gcc_assert (expr->expr_type == EXPR_ARRAY);
   gcc_assert (expr->ts.type == BT_CHARACTER);
 
   gcc_assert (expr->expr_type == EXPR_ARRAY);
   gcc_assert (expr->ts.type == BT_CHARACTER);
 

-  if (expr->ts.cl == NULL)
+  if (expr->ts.u.cl == NULL)

     {
       for (p = expr->value.constructor; p; p = p->next)
     {
       for (p = expr->value.constructor; p; p = p->next)

-       if (p->expr->ts.cl != NULL)
+       if (p->expr->ts.u.cl != NULL)

          {
            /* Ensure that if there is a char_len around that it is
               used; otherwise the middle-end confuses them!  */
          {
            /* Ensure that if there is a char_len around that it is
               used; otherwise the middle-end confuses them!  */

-           expr->ts.cl = p->expr->ts.cl;
+           expr->ts.u.cl = p->expr->ts.u.cl;

            goto got_charlen;
          }
 
            goto got_charlen;
          }
 

-      expr->ts.cl = gfc_new_charlen (gfc_current_ns);
+      expr->ts.u.cl = gfc_new_charlen (gfc_current_ns);

     }
 
 got_charlen:
 
   found_length = -1;
 
     }
 
 got_charlen:
 
   found_length = -1;
 

-  if (expr->ts.cl->length == NULL)
+  if (expr->ts.u.cl->length == NULL)

     {
       /* Check that all constant string elements have the same length until
         we reach the end or find a variable-length one.  */
     {
       /* Check that all constant string elements have the same length until
         we reach the end or find a variable-length one.  */


@@ -1630,11 +1630,11 @@ got_charlen:
                - mpz_get_ui (ref->u.ss.start->value.integer) + 1;
              current_length = (int) j;
            }
                - mpz_get_ui (ref->u.ss.start->value.integer) + 1;
              current_length = (int) j;
            }

-         else if (p->expr->ts.cl && p->expr->ts.cl->length
-                  && p->expr->ts.cl->length->expr_type == EXPR_CONSTANT)
+         else if (p->expr->ts.u.cl && p->expr->ts.u.cl->length
+                  && p->expr->ts.u.cl->length->expr_type == EXPR_CONSTANT)

            {
              long j;
            {
              long j;

-             j = mpz_get_si (p->expr->ts.cl->length->value.integer);
+             j = mpz_get_si (p->expr->ts.u.cl->length->value.integer);

              current_length = (int) j;
            }
          else
              current_length = (int) j;
            }
          else


@@ -1658,18 +1658,18 @@ got_charlen:
       gcc_assert (found_length != -1);
 
       /* Update the character length of the array constructor.  */
       gcc_assert (found_length != -1);
 
       /* Update the character length of the array constructor.  */

-      expr->ts.cl->length = gfc_int_expr (found_length);
+      expr->ts.u.cl->length = gfc_int_expr (found_length);

     }
   else 
     {
       /* We've got a character length specified.  It should be an integer,
         otherwise an error is signalled elsewhere.  */
     }
   else 
     {
       /* We've got a character length specified.  It should be an integer,
         otherwise an error is signalled elsewhere.  */

-      gcc_assert (expr->ts.cl->length);
+      gcc_assert (expr->ts.u.cl->length);

 
       /* If we've got a constant character length, pad according to this.
         gfc_extract_int does check for BT_INTEGER and EXPR_CONSTANT and sets
         max_length only if they pass.  */
 
       /* If we've got a constant character length, pad according to this.
         gfc_extract_int does check for BT_INTEGER and EXPR_CONSTANT and sets
         max_length only if they pass.  */

-      gfc_extract_int (expr->ts.cl->length, &found_length);
+      gfc_extract_int (expr->ts.u.cl->length, &found_length);

 
       /* Now pad/truncate the elements accordingly to the specified character
         length.  This is ok inside this conditional, as in the case above
 
       /* Now pad/truncate the elements accordingly to the specified character
         length.  This is ok inside this conditional, as in the case above


@@ -1683,16 +1683,16 @@ got_charlen:
              int current_length = -1;
              bool has_ts;
 
              int current_length = -1;
              bool has_ts;
 

-             if (p->expr->ts.cl && p->expr->ts.cl->length)
+             if (p->expr->ts.u.cl && p->expr->ts.u.cl->length)

              {
              {

-               cl = p->expr->ts.cl->length;
+               cl = p->expr->ts.u.cl->length;

                gfc_extract_int (cl, &current_length);
              }
 
              /* If gfc_extract_int above set current_length, we implicitly
                 know the type is BT_INTEGER and it's EXPR_CONSTANT.  */
 
                gfc_extract_int (cl, &current_length);
              }
 
              /* If gfc_extract_int above set current_length, we implicitly
                 know the type is BT_INTEGER and it's EXPR_CONSTANT.  */
 

-             has_ts = (expr->ts.cl && expr->ts.cl->length_from_typespec);
+             has_ts = (expr->ts.u.cl && expr->ts.u.cl->length_from_typespec);

 
              if (! cl
                  || (current_length != -1 && current_length < found_length))
 
              if (! cl
                  || (current_length != -1 && current_length < found_length))

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 779af20..6e2ce41 100644 (file)
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -410,20 +410,20 @@ gfc_check_same_strlen (const gfc_expr *a, const gfc_expr *b, const char *name)
    long len_a, len_b;
    len_a = len_b = -1;
 
    long len_a, len_b;
    len_a = len_b = -1;
 

-   if (a->ts.cl && a->ts.cl->length
-       && a->ts.cl->length->expr_type == EXPR_CONSTANT)
-     len_a = mpz_get_si (a->ts.cl->length->value.integer);
+   if (a->ts.u.cl && a->ts.u.cl->length
+       && a->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+     len_a = mpz_get_si (a->ts.u.cl->length->value.integer);

    else if (a->expr_type == EXPR_CONSTANT
    else if (a->expr_type == EXPR_CONSTANT

-           && (a->ts.cl == NULL || a->ts.cl->length == NULL))
+           && (a->ts.u.cl == NULL || a->ts.u.cl->length == NULL))

      len_a = a->value.character.length;
    else
      return SUCCESS;
 
      len_a = a->value.character.length;
    else
      return SUCCESS;
 

-   if (b->ts.cl && b->ts.cl->length
-       && b->ts.cl->length->expr_type == EXPR_CONSTANT)
-     len_b = mpz_get_si (b->ts.cl->length->value.integer);
+   if (b->ts.u.cl && b->ts.u.cl->length
+       && b->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+     len_b = mpz_get_si (b->ts.u.cl->length->value.integer);

    else if (b->expr_type == EXPR_CONSTANT
    else if (b->expr_type == EXPR_CONSTANT

-           && (b->ts.cl == NULL || b->ts.cl->length == NULL))
+           && (b->ts.u.cl == NULL || b->ts.u.cl->length == NULL))

      len_b = b->value.character.length;
    else
      return SUCCESS;
      len_b = b->value.character.length;
    else
      return SUCCESS;


@@ -1400,12 +1400,12 @@ gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind)
        {
          /* Check that the argument is length one.  Non-constant lengths
             can't be checked here, so assume they are ok.  */
        {
          /* Check that the argument is length one.  Non-constant lengths
             can't be checked here, so assume they are ok.  */

-         if (c->ts.cl && c->ts.cl->length)
+         if (c->ts.u.cl && c->ts.u.cl->length)

            {
              /* If we already have a length for this expression then use it.  */
            {
              /* If we already have a length for this expression then use it.  */

-             if (c->ts.cl->length->expr_type != EXPR_CONSTANT)
+             if (c->ts.u.cl->length->expr_type != EXPR_CONSTANT)

                return SUCCESS;
                return SUCCESS;

-             i = mpz_get_si (c->ts.cl->length->value.integer);
+             i = mpz_get_si (c->ts.u.cl->length->value.integer);

            }
          else 
            return SUCCESS;
            }
          else 
            return SUCCESS;

diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c
index 5829c7f..6cddb3c 100644 (file)
--- a/gcc/fortran/data.c
+++ b/gcc/fortran/data.c
@@ -154,7 +154,7 @@ create_character_intializer (gfc_expr *init, gfc_typespec *ts,
   int len, start, end;
   gfc_char_t *dest;
            
   int len, start, end;
   gfc_char_t *dest;
            

-  gfc_extract_int (ts->cl->length, &len);
+  gfc_extract_int (ts->u.cl->length, &len);

 
   if (init == NULL)
     {
 
   if (init == NULL)
     {


@@ -379,7 +379,7 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
              /* Setup the expression to hold the constructor.  */
              expr->expr_type = EXPR_STRUCTURE;
              expr->ts.type = BT_DERIVED;
              /* Setup the expression to hold the constructor.  */
              expr->expr_type = EXPR_STRUCTURE;
              expr->ts.type = BT_DERIVED;

-             expr->ts.derived = ref->u.c.sym;
+             expr->ts.u.derived = ref->u.c.sym;

            }
          else
            gcc_assert (expr->expr_type == EXPR_STRUCTURE);
            }
          else
            gcc_assert (expr->expr_type == EXPR_STRUCTURE);


@@ -417,7 +417,7 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
 
   if (ref || last_ts->type == BT_CHARACTER)
     {
 
   if (ref || last_ts->type == BT_CHARACTER)
     {

-      if (lvalue->ts.cl->length == NULL && !(ref && ref->u.ss.length != NULL))
+      if (lvalue->ts.u.cl->length == NULL && !(ref && ref->u.ss.length != NULL))

        return FAILURE;
       expr = create_character_intializer (init, last_ts, ref, rvalue);
     }
        return FAILURE;
       expr = create_character_intializer (init, last_ts, ref, rvalue);
     }


@@ -569,7 +569,7 @@ gfc_assign_data_value_range (gfc_expr *lvalue, gfc_expr *rvalue,
              /* Setup the expression to hold the constructor.  */
              expr->expr_type = EXPR_STRUCTURE;
              expr->ts.type = BT_DERIVED;
              /* Setup the expression to hold the constructor.  */
              expr->expr_type = EXPR_STRUCTURE;
              expr->ts.type = BT_DERIVED;

-             expr->ts.derived = ref->u.c.sym;
+             expr->ts.u.derived = ref->u.c.sym;

            }
          else
            gcc_assert (expr->expr_type == EXPR_STRUCTURE);
            }
          else
            gcc_assert (expr->expr_type == EXPR_STRUCTURE);


@@ -716,7 +716,7 @@ formalize_structure_cons (gfc_expr *expr)
     return;
 
   head = tail = NULL;
     return;
 
   head = tail = NULL;

-  for (order = expr->ts.derived->components; order; order = order->next)
+  for (order = expr->ts.u.derived->components; order; order = order->next)

     {
       /* Find the next component.  */
       last = NULL;
     {
       /* Find the next component.  */
       last = NULL;

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index abe2147..b1c1517 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -622,8 +622,8 @@ char_len_param_value (gfc_expr **expr)
              if (e->symtree->n.sym->ts.type == BT_UNKNOWN)
                goto syntax;
              if (e->symtree->n.sym->ts.type == BT_CHARACTER
              if (e->symtree->n.sym->ts.type == BT_UNKNOWN)
                goto syntax;
              if (e->symtree->n.sym->ts.type == BT_CHARACTER

-                 && e->symtree->n.sym->ts.cl
-                 && e->symtree->n.sym->ts.cl->length->ts.type == BT_UNKNOWN)
+                 && e->symtree->n.sym->ts.u.cl
+                 && e->symtree->n.sym->ts.u.cl->length->ts.type == BT_UNKNOWN)

                goto syntax;
            }
        }
                goto syntax;
            }
        }


@@ -938,7 +938,7 @@ verify_c_interop_param (gfc_symbol *sym)
                           "because derived type '%s' is not C interoperable",
                           sym->name, &(sym->declared_at),
                           sym->ns->proc_name->name, 
                           "because derived type '%s' is not C interoperable",
                           sym->name, &(sym->declared_at),
                           sym->ns->proc_name->name, 

-                          sym->ts.derived->name);
+                          sym->ts.u.derived->name);

              else
                gfc_warning ("Variable '%s' at %L is a parameter to the "
                             "BIND(C) procedure '%s' but may not be C "
              else
                gfc_warning ("Variable '%s' at %L is a parameter to the "
                             "BIND(C) procedure '%s' but may not be C "


@@ -951,7 +951,7 @@ verify_c_interop_param (gfc_symbol *sym)
              length of 1.  */
           if (sym->ts.type == BT_CHARACTER)
            {
              length of 1.  */
           if (sym->ts.type == BT_CHARACTER)
            {

-             gfc_charlen *cl = sym->ts.cl;
+             gfc_charlen *cl = sym->ts.u.cl;

              if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT
                   || mpz_cmp_si (cl->length->value.integer, 1) != 0)
                {
              if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT
                   || mpz_cmp_si (cl->length->value.integer, 1) != 0)
                {


@@ -1045,7 +1045,7 @@ build_sym (const char *name, gfc_charlen *cl,
     return FAILURE;
 
   if (sym->ts.type == BT_CHARACTER)
     return FAILURE;
 
   if (sym->ts.type == BT_CHARACTER)

-    sym->ts.cl = cl;
+    sym->ts.u.cl = cl;

 
   /* Add dimension attribute if present.  */
   if (gfc_set_array_spec (sym, *as, var_locus) == FAILURE)
 
   /* Add dimension attribute if present.  */
   if (gfc_set_array_spec (sym, *as, var_locus) == FAILURE)


@@ -1253,42 +1253,42 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
          && gfc_check_assign_symbol (sym, init) == FAILURE)
        return FAILURE;
 
          && gfc_check_assign_symbol (sym, init) == FAILURE)
        return FAILURE;
 

-      if (sym->ts.type == BT_CHARACTER && sym->ts.cl
+      if (sym->ts.type == BT_CHARACTER && sym->ts.u.cl

            && init->ts.type == BT_CHARACTER)
        {
          /* Update symbol character length according initializer.  */
          if (gfc_check_assign_symbol (sym, init) == FAILURE)
            return FAILURE;
 
            && init->ts.type == BT_CHARACTER)
        {
          /* Update symbol character length according initializer.  */
          if (gfc_check_assign_symbol (sym, init) == FAILURE)
            return FAILURE;
 

-         if (sym->ts.cl->length == NULL)
+         if (sym->ts.u.cl->length == NULL)

            {
              int clen;
              /* If there are multiple CHARACTER variables declared on the
                 same line, we don't want them to share the same length.  */
            {
              int clen;
              /* If there are multiple CHARACTER variables declared on the
                 same line, we don't want them to share the same length.  */

-             sym->ts.cl = gfc_new_charlen (gfc_current_ns);
+             sym->ts.u.cl = gfc_new_charlen (gfc_current_ns);

 
              if (sym->attr.flavor == FL_PARAMETER)
                {
                  if (init->expr_type == EXPR_CONSTANT)
                    {
                      clen = init->value.character.length;
 
              if (sym->attr.flavor == FL_PARAMETER)
                {
                  if (init->expr_type == EXPR_CONSTANT)
                    {
                      clen = init->value.character.length;

-                     sym->ts.cl->length = gfc_int_expr (clen);
+                     sym->ts.u.cl->length = gfc_int_expr (clen);

                    }
                  else if (init->expr_type == EXPR_ARRAY)
                    {
                      gfc_expr *p = init->value.constructor->expr;
                      clen = p->value.character.length;
                    }
                  else if (init->expr_type == EXPR_ARRAY)
                    {
                      gfc_expr *p = init->value.constructor->expr;
                      clen = p->value.character.length;

-                     sym->ts.cl->length = gfc_int_expr (clen);
+                     sym->ts.u.cl->length = gfc_int_expr (clen);

                    }
                    }

-                 else if (init->ts.cl && init->ts.cl->length)
-                   sym->ts.cl->length =
-                               gfc_copy_expr (sym->value->ts.cl->length);
+                 else if (init->ts.u.cl && init->ts.u.cl->length)
+                   sym->ts.u.cl->length =
+                               gfc_copy_expr (sym->value->ts.u.cl->length);

                }
            }
          /* Update initializer character length according symbol.  */
                }
            }
          /* Update initializer character length according symbol.  */

-         else if (sym->ts.cl->length->expr_type == EXPR_CONSTANT)
+         else if (sym->ts.u.cl->length->expr_type == EXPR_CONSTANT)

            {
            {

-             int len = mpz_get_si (sym->ts.cl->length->value.integer);
+             int len = mpz_get_si (sym->ts.u.cl->length->value.integer);

              gfc_constructor * p;
 
              if (init->expr_type == EXPR_CONSTANT)
              gfc_constructor * p;
 
              if (init->expr_type == EXPR_CONSTANT)


@@ -1297,8 +1297,8 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
                {
                  /* Build a new charlen to prevent simplification from
                     deleting the length before it is resolved.  */
                {
                  /* Build a new charlen to prevent simplification from
                     deleting the length before it is resolved.  */

-                 init->ts.cl = gfc_new_charlen (gfc_current_ns);
-                 init->ts.cl->length = gfc_copy_expr (sym->ts.cl->length);
+                 init->ts.u.cl = gfc_new_charlen (gfc_current_ns);
+                 init->ts.u.cl->length = gfc_copy_expr (sym->ts.u.cl->length);

 
                  for (p = init->value.constructor; p; p = p->next)
                    gfc_set_constant_character_len (len, p->expr, -1);
 
                  for (p = init->value.constructor; p; p = p->next)
                    gfc_set_constant_character_len (len, p->expr, -1);


@@ -1389,7 +1389,7 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
   /* If the current symbol is of the same derived type that we're
      constructing, it must have the pointer attribute.  */
   if (current_ts.type == BT_DERIVED
   /* If the current symbol is of the same derived type that we're
      constructing, it must have the pointer attribute.  */
   if (current_ts.type == BT_DERIVED

-      && current_ts.derived == gfc_current_block ()
+      && current_ts.u.derived == gfc_current_block ()

       && current_attr.pointer == 0)
     {
       gfc_error ("Component at %C must have the POINTER attribute");
       && current_attr.pointer == 0)
     {
       gfc_error ("Component at %C must have the POINTER attribute");


@@ -1410,7 +1410,8 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
     return FAILURE;
 
   c->ts = current_ts;
     return FAILURE;
 
   c->ts = current_ts;

-  c->ts.cl = cl;
+  if (c->ts.type == BT_CHARACTER)
+    c->ts.u.cl = cl;

   c->attr = current_attr;
 
   c->initializer = *init;
   c->attr = current_attr;
 
   c->initializer = *init;


@@ -1423,27 +1424,27 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
 
   /* Should this ever get more complicated, combine with similar section
      in add_init_expr_to_sym into a separate function.  */
 
   /* Should this ever get more complicated, combine with similar section
      in add_init_expr_to_sym into a separate function.  */

-  if (c->ts.type == BT_CHARACTER && !c->attr.pointer && c->initializer && c->ts.cl
-      && c->ts.cl->length && c->ts.cl->length->expr_type == EXPR_CONSTANT)
+  if (c->ts.type == BT_CHARACTER && !c->attr.pointer && c->initializer && c->ts.u.cl
+      && c->ts.u.cl->length && c->ts.u.cl->length->expr_type == EXPR_CONSTANT)

     {
       int len;
 
     {
       int len;
 

-      gcc_assert (c->ts.cl && c->ts.cl->length);
-      gcc_assert (c->ts.cl->length->expr_type == EXPR_CONSTANT);
-      gcc_assert (c->ts.cl->length->ts.type == BT_INTEGER);
+      gcc_assert (c->ts.u.cl && c->ts.u.cl->length);
+      gcc_assert (c->ts.u.cl->length->expr_type == EXPR_CONSTANT);
+      gcc_assert (c->ts.u.cl->length->ts.type == BT_INTEGER);

 
 

-      len = mpz_get_si (c->ts.cl->length->value.integer);
+      len = mpz_get_si (c->ts.u.cl->length->value.integer);

 
       if (c->initializer->expr_type == EXPR_CONSTANT)
        gfc_set_constant_character_len (len, c->initializer, -1);
 
       if (c->initializer->expr_type == EXPR_CONSTANT)
        gfc_set_constant_character_len (len, c->initializer, -1);

-      else if (mpz_cmp (c->ts.cl->length->value.integer,
-                       c->initializer->ts.cl->length->value.integer))
+      else if (mpz_cmp (c->ts.u.cl->length->value.integer,
+                       c->initializer->ts.u.cl->length->value.integer))

        {
          bool has_ts;
          gfc_constructor *ctor = c->initializer->value.constructor;
 
        {
          bool has_ts;
          gfc_constructor *ctor = c->initializer->value.constructor;
 

-         has_ts = (c->initializer->ts.cl
-                   && c->initializer->ts.cl->length_from_typespec);
+         has_ts = (c->initializer->ts.u.cl
+                   && c->initializer->ts.u.cl->length_from_typespec);

 
          if (ctor)
            {
 
          if (ctor)
            {


@@ -1609,14 +1610,14 @@ variable_decl (int elem)
           element.  Also copy assumed lengths.  */
        case MATCH_NO:
          if (elem > 1
           element.  Also copy assumed lengths.  */
        case MATCH_NO:
          if (elem > 1

-             && (current_ts.cl->length == NULL
-                 || current_ts.cl->length->expr_type != EXPR_CONSTANT))
+             && (current_ts.u.cl->length == NULL
+                 || current_ts.u.cl->length->expr_type != EXPR_CONSTANT))

            {
              cl = gfc_new_charlen (gfc_current_ns);
            {
              cl = gfc_new_charlen (gfc_current_ns);

-             cl->length = gfc_copy_expr (current_ts.cl->length);
+             cl->length = gfc_copy_expr (current_ts.u.cl->length);

            }
          else
            }
          else

-           cl = current_ts.cl;
+           cl = current_ts.u.cl;

 
          break;
 
 
          break;
 


@@ -1634,8 +1635,8 @@ variable_decl (int elem)
        {
          sym->ts.type = current_ts.type;
          sym->ts.kind = current_ts.kind;
        {
          sym->ts.type = current_ts.type;
          sym->ts.kind = current_ts.kind;

-         sym->ts.cl = cl;
-         sym->ts.derived = current_ts.derived;
+         sym->ts.u.cl = cl;
+         sym->ts.u.derived = current_ts.u.derived;

          sym->ts.is_c_interop = current_ts.is_c_interop;
          sym->ts.is_iso_c = current_ts.is_iso_c;
          m = MATCH_YES;
          sym->ts.is_c_interop = current_ts.is_c_interop;
          sym->ts.is_iso_c = current_ts.is_iso_c;
          m = MATCH_YES;


@@ -1707,13 +1708,13 @@ variable_decl (int elem)
   if (current_ts.type == BT_DERIVED
       && gfc_current_ns->proc_name
       && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY
   if (current_ts.type == BT_DERIVED
       && gfc_current_ns->proc_name
       && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY

-      && current_ts.derived->ns != gfc_current_ns)
+      && current_ts.u.derived->ns != gfc_current_ns)

     {
       gfc_symtree *st;
     {
       gfc_symtree *st;

-      st = gfc_find_symtree (gfc_current_ns->sym_root, current_ts.derived->name);
-      if (!(current_ts.derived->attr.imported
+      st = gfc_find_symtree (gfc_current_ns->sym_root, current_ts.u.derived->name);
+      if (!(current_ts.u.derived->attr.imported

                && st != NULL
                && st != NULL

-               && st->n.sym == current_ts.derived)
+               && st->n.sym == current_ts.u.derived)

            && !gfc_current_ns->has_import_set)
        {
            gfc_error ("the type of '%s' at %C has not been declared within the "
            && !gfc_current_ns->has_import_set)
        {
            gfc_error ("the type of '%s' at %C has not been declared within the "


@@ -2241,7 +2242,7 @@ done:
   else
     cl->length = len;
 
   else
     cl->length = len;
 

-  ts->cl = cl;
+  ts->u.cl = cl;

   ts->kind = kind == 0 ? gfc_default_character_kind : kind;
 
   /* We have to know if it was a c interoperable kind so we can
   ts->kind = kind == 0 ? gfc_default_character_kind : kind;
 
   /* We have to know if it was a c interoperable kind so we can


@@ -2387,10 +2388,10 @@ gfc_match_type_spec (gfc_typespec *ts, int implicit_flag)
      found, add it to the typespec.  */  
   if (gfc_matching_function)
     {
      found, add it to the typespec.  */  
   if (gfc_matching_function)
     {

-      ts->derived = NULL;
+      ts->u.derived = NULL;

       if (gfc_current_state () != COMP_INTERFACE
            && !gfc_find_symbol (name, NULL, 1, &sym) && sym)
       if (gfc_current_state () != COMP_INTERFACE
            && !gfc_find_symbol (name, NULL, 1, &sym) && sym)

-       ts->derived = sym;
+       ts->u.derived = sym;

       return MATCH_YES;
     }
 
       return MATCH_YES;
     }
 


@@ -2423,7 +2424,7 @@ gfc_match_type_spec (gfc_typespec *ts, int implicit_flag)
     return MATCH_ERROR;
 
   gfc_set_sym_referenced (sym);
     return MATCH_ERROR;
 
   gfc_set_sym_referenced (sym);

-  ts->derived = sym;
+  ts->u.derived = sym;

 
   return MATCH_YES;
 
 
   return MATCH_YES;
 


@@ -2614,11 +2615,11 @@ gfc_match_implicit (void)
          if ((c == '\n') || (c == ','))
            {
              /* Check for CHARACTER with no length parameter.  */
          if ((c == '\n') || (c == ','))
            {
              /* Check for CHARACTER with no length parameter.  */

-             if (ts.type == BT_CHARACTER && !ts.cl)
+             if (ts.type == BT_CHARACTER && !ts.u.cl)

                {
                  ts.kind = gfc_default_character_kind;
                {
                  ts.kind = gfc_default_character_kind;

-                 ts.cl = gfc_new_charlen (gfc_current_ns);
-                 ts.cl->length = gfc_int_expr (1);
+                 ts.u.cl = gfc_new_charlen (gfc_current_ns);
+                 ts.u.cl->length = gfc_int_expr (1);

                }
 
              /* Record the Successful match.  */
                }
 
              /* Record the Successful match.  */


@@ -3330,8 +3331,8 @@ set_com_block_bind_c (gfc_common_head *com_block, int is_bind_c)
 gfc_try
 verify_c_interop (gfc_typespec *ts)
 {
 gfc_try
 verify_c_interop (gfc_typespec *ts)
 {

-  if (ts->type == BT_DERIVED && ts->derived != NULL)
-    return (ts->derived->ts.is_c_interop ? SUCCESS : FAILURE);
+  if (ts->type == BT_DERIVED && ts->u.derived != NULL)
+    return (ts->u.derived->ts.is_c_interop ? SUCCESS : FAILURE);

   else if (ts->is_c_interop != 1)
     return FAILURE;
   
   else if (ts->is_c_interop != 1)
     return FAILURE;
   


@@ -3473,9 +3474,9 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
 
       /* BIND(C) functions can not return a character string.  */
       if (bind_c_function && tmp_sym->ts.type == BT_CHARACTER)
 
       /* BIND(C) functions can not return a character string.  */
       if (bind_c_function && tmp_sym->ts.type == BT_CHARACTER)

-       if (tmp_sym->ts.cl == NULL || tmp_sym->ts.cl->length == NULL
-           || tmp_sym->ts.cl->length->expr_type != EXPR_CONSTANT
-           || mpz_cmp_si (tmp_sym->ts.cl->length->value.integer, 1) != 0)
+       if (tmp_sym->ts.u.cl == NULL || tmp_sym->ts.u.cl->length == NULL
+           || tmp_sym->ts.u.cl->length->expr_type != EXPR_CONSTANT
+           || mpz_cmp_si (tmp_sym->ts.u.cl->length->value.integer, 1) != 0)

          gfc_error ("Return type of BIND(C) function '%s' at %L cannot "
                         "be a character string", tmp_sym->name,
                         &(tmp_sym->declared_at));
          gfc_error ("Return type of BIND(C) function '%s' at %L cannot "
                         "be a character string", tmp_sym->name,
                         &(tmp_sym->declared_at));


@@ -3679,7 +3680,7 @@ gfc_match_data_decl (void)
 
   if (current_ts.type == BT_DERIVED && gfc_current_state () != COMP_DERIVED)
     {
 
   if (current_ts.type == BT_DERIVED && gfc_current_state () != COMP_DERIVED)
     {

-      sym = gfc_use_derived (current_ts.derived);
+      sym = gfc_use_derived (current_ts.u.derived);

 
       if (sym == NULL)
        {
 
       if (sym == NULL)
        {


@@ -3687,7 +3688,7 @@ gfc_match_data_decl (void)
          goto cleanup;
        }
 
          goto cleanup;
        }
 

-      current_ts.derived = sym;
+      current_ts.u.derived = sym;

     }
 
   m = match_attr_spec ();
     }
 
   m = match_attr_spec ();


@@ -3697,21 +3698,21 @@ gfc_match_data_decl (void)
       goto cleanup;
     }
 
       goto cleanup;
     }
 

-  if (current_ts.type == BT_DERIVED && current_ts.derived->components == NULL
-      && !current_ts.derived->attr.zero_comp)
+  if (current_ts.type == BT_DERIVED && current_ts.u.derived->components == NULL
+      && !current_ts.u.derived->attr.zero_comp)

     {
 
       if (current_attr.pointer && gfc_current_state () == COMP_DERIVED)
        goto ok;
 
     {
 
       if (current_attr.pointer && gfc_current_state () == COMP_DERIVED)
        goto ok;
 

-      gfc_find_symbol (current_ts.derived->name,
-                      current_ts.derived->ns->parent, 1, &sym);
+      gfc_find_symbol (current_ts.u.derived->name,
+                      current_ts.u.derived->ns->parent, 1, &sym);

 
       /* Any symbol that we find had better be a type definition
         which has its components defined.  */
       if (sym != NULL && sym->attr.flavor == FL_DERIVED
 
       /* Any symbol that we find had better be a type definition
         which has its components defined.  */
       if (sym != NULL && sym->attr.flavor == FL_DERIVED

-         && (current_ts.derived->components != NULL
-             || current_ts.derived->attr.zero_comp))
+         && (current_ts.u.derived->components != NULL
+             || current_ts.u.derived->attr.zero_comp))

        goto ok;
 
       /* Now we have an error, which we signal, and then fix up
        goto ok;
 
       /* Now we have an error, which we signal, and then fix up


@@ -6202,30 +6203,30 @@ do_parm (void)
     }
 
   if (sym->ts.type == BT_CHARACTER
     }
 
   if (sym->ts.type == BT_CHARACTER

-      && sym->ts.cl != NULL
-      && sym->ts.cl->length != NULL
-      && sym->ts.cl->length->expr_type == EXPR_CONSTANT
+      && sym->ts.u.cl != NULL
+      && sym->ts.u.cl->length != NULL
+      && sym->ts.u.cl->length->expr_type == EXPR_CONSTANT

       && init->expr_type == EXPR_CONSTANT
       && init->ts.type == BT_CHARACTER)
     gfc_set_constant_character_len (
       && init->expr_type == EXPR_CONSTANT
       && init->ts.type == BT_CHARACTER)
     gfc_set_constant_character_len (

-      mpz_get_si (sym->ts.cl->length->value.integer), init, -1);
-  else if (sym->ts.type == BT_CHARACTER && sym->ts.cl != NULL
-          && sym->ts.cl->length == NULL)
+      mpz_get_si (sym->ts.u.cl->length->value.integer), init, -1);
+  else if (sym->ts.type == BT_CHARACTER && sym->ts.u.cl != NULL
+          && sym->ts.u.cl->length == NULL)

        {
          int clen;
          if (init->expr_type == EXPR_CONSTANT)
            {
              clen = init->value.character.length;
        {
          int clen;
          if (init->expr_type == EXPR_CONSTANT)
            {
              clen = init->value.character.length;

-             sym->ts.cl->length = gfc_int_expr (clen);
+             sym->ts.u.cl->length = gfc_int_expr (clen);

            }
          else if (init->expr_type == EXPR_ARRAY)
            {
              gfc_expr *p = init->value.constructor->expr;
              clen = p->value.character.length;
            }
          else if (init->expr_type == EXPR_ARRAY)
            {
              gfc_expr *p = init->value.constructor->expr;
              clen = p->value.character.length;

-             sym->ts.cl->length = gfc_int_expr (clen);
+             sym->ts.u.cl->length = gfc_int_expr (clen);

            }
            }

-         else if (init->ts.cl && init->ts.cl->length)
-           sym->ts.cl->length = gfc_copy_expr (sym->value->ts.cl->length);
+         else if (init->ts.u.cl && init->ts.u.cl->length)
+           sym->ts.u.cl->length = gfc_copy_expr (sym->value->ts.u.cl->length);

        }
 
   sym->value = init;
        }
 
   sym->value = init;


@@ -6762,7 +6763,7 @@ gfc_match_derived_decl (void)
       gfc_set_sym_referenced (extended);
 
       p->ts.type = BT_DERIVED;
       gfc_set_sym_referenced (extended);
 
       p->ts.type = BT_DERIVED;

-      p->ts.derived = extended;
+      p->ts.u.derived = extended;

       p->initializer = gfc_default_initializer (&p->ts);
 
       /* Provide the links between the extended type and its extension.  */
       p->initializer = gfc_default_initializer (&p->ts);
 
       /* Provide the links between the extended type and its extension.  */

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 2a411d4..5802cdc 100644 (file)
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -85,11 +85,11 @@ show_typespec (gfc_typespec *ts)
   switch (ts->type)
     {
     case BT_DERIVED:
   switch (ts->type)
     {
     case BT_DERIVED:

-      fprintf (dumpfile, "%s", ts->derived->name);
+      fprintf (dumpfile, "%s", ts->u.derived->name);

       break;
 
     case BT_CHARACTER:
       break;
 
     case BT_CHARACTER:

-      show_expr (ts->cl->length);
+      show_expr (ts->u.cl->length);

       break;
 
     default:
       break;
 
     default:


@@ -354,7 +354,7 @@ show_expr (gfc_expr *p)
       break;
 
     case EXPR_STRUCTURE:
       break;
 
     case EXPR_STRUCTURE:

-      fprintf (dumpfile, "%s(", p->ts.derived->name);
+      fprintf (dumpfile, "%s(", p->ts.u.derived->name);

       show_constructor (p->value.constructor);
       fputc (')', dumpfile);
       break;
       show_constructor (p->value.constructor);
       fputc (')', dumpfile);
       break;

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index b8d54e7..85c0cea 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -1504,14 +1504,14 @@ simplify_const_ref (gfc_expr *p)
                      else
                        string_len = 0;
 
                      else
                        string_len = 0;
 

-                     if (!p->ts.cl)
+                     if (!p->ts.u.cl)

                        {
                        {

-                         p->ts.cl = gfc_get_charlen ();
-                         p->ts.cl->next = NULL;
-                         p->ts.cl->length = NULL;
+                         p->ts.u.cl = gfc_get_charlen ();
+                         p->ts.u.cl->next = NULL;
+                         p->ts.u.cl->length = NULL;

                        }
                        }

-                     gfc_free_expr (p->ts.cl->length);
-                     p->ts.cl->length = gfc_int_expr (string_len);
+                     gfc_free_expr (p->ts.u.cl->length);
+                     p->ts.u.cl->length = gfc_int_expr (string_len);

                    }
                }
              gfc_free_ref_list (p->ref);
                    }
                }
              gfc_free_ref_list (p->ref);


@@ -1681,8 +1681,8 @@ gfc_simplify_expr (gfc_expr *p, int type)
          gfc_free (p->value.character.string);
          p->value.character.string = s;
          p->value.character.length = end - start;
          gfc_free (p->value.character.string);
          p->value.character.string = s;
          p->value.character.length = end - start;

-         p->ts.cl = gfc_new_charlen (gfc_current_ns);
-         p->ts.cl->length = gfc_int_expr (p->value.character.length);
+         p->ts.u.cl = gfc_new_charlen (gfc_current_ns);
+         p->ts.u.cl->length = gfc_int_expr (p->value.character.length);

          gfc_free_ref_list (p->ref);
          p->ref = NULL;
          p->expr_type = EXPR_CONSTANT;
          gfc_free_ref_list (p->ref);
          p->ref = NULL;
          p->expr_type = EXPR_CONSTANT;


@@ -2102,7 +2102,7 @@ check_inquiry (gfc_expr *e, int not_restricted)
           with LEN, as required by the standard.  */
        if (i == 5 && not_restricted
            && ap->expr->symtree->n.sym->ts.type == BT_CHARACTER
           with LEN, as required by the standard.  */
        if (i == 5 && not_restricted
            && ap->expr->symtree->n.sym->ts.type == BT_CHARACTER

-           && ap->expr->symtree->n.sym->ts.cl->length == NULL)
+           && ap->expr->symtree->n.sym->ts.u.cl->length == NULL)

          {
            gfc_error ("Assumed character length variable '%s' in constant "
                       "expression at %L", e->symtree->n.sym->name, &e->where);
          {
            gfc_error ("Assumed character length variable '%s' in constant "
                       "expression at %L", e->symtree->n.sym->name, &e->where);


@@ -3337,7 +3337,7 @@ gfc_default_initializer (gfc_typespec *ts)
   gfc_component *c;
 
   /* See if we have a default initializer.  */
   gfc_component *c;
 
   /* See if we have a default initializer.  */

-  for (c = ts->derived->components; c; c = c->next)
+  for (c = ts->u.derived->components; c; c = c->next)

     if (c->initializer || c->attr.allocatable)
       break;
 
     if (c->initializer || c->attr.allocatable)
       break;
 


@@ -3348,10 +3348,10 @@ gfc_default_initializer (gfc_typespec *ts)
   init = gfc_get_expr ();
   init->expr_type = EXPR_STRUCTURE;
   init->ts = *ts;
   init = gfc_get_expr ();
   init->expr_type = EXPR_STRUCTURE;
   init->ts = *ts;

-  init->where = ts->derived->declared_at;
+  init->where = ts->u.derived->declared_at;

 
   tail = NULL;
 
   tail = NULL;

-  for (c = ts->derived->components; c; c = c->next)
+  for (c = ts->u.derived->components; c; c = c->next)

     {
       if (tail == NULL)
        init->value.constructor = tail = gfc_get_constructor ();
     {
       if (tail == NULL)
        init->value.constructor = tail = gfc_get_constructor ();


@@ -3421,10 +3421,10 @@ gfc_traverse_expr (gfc_expr *expr, gfc_symbol *sym,
     return true;
 
   if (expr->ts.type == BT_CHARACTER
     return true;
 
   if (expr->ts.type == BT_CHARACTER

-       && expr->ts.cl
-       && expr->ts.cl->length
-       && expr->ts.cl->length->expr_type != EXPR_CONSTANT
-       && gfc_traverse_expr (expr->ts.cl->length, sym, func, f))
+       && expr->ts.u.cl
+       && expr->ts.u.cl->length
+       && expr->ts.u.cl->length->expr_type != EXPR_CONSTANT
+       && gfc_traverse_expr (expr->ts.u.cl->length, sym, func, f))

     return true;
 
   switch (expr->expr_type)
     return true;
 
   switch (expr->expr_type)


@@ -3502,11 +3502,11 @@ gfc_traverse_expr (gfc_expr *expr, gfc_symbol *sym,
 
        case REF_COMPONENT:
          if (ref->u.c.component->ts.type == BT_CHARACTER
 
        case REF_COMPONENT:
          if (ref->u.c.component->ts.type == BT_CHARACTER

-               && ref->u.c.component->ts.cl
-               && ref->u.c.component->ts.cl->length
-               && ref->u.c.component->ts.cl->length->expr_type
+               && ref->u.c.component->ts.u.cl
+               && ref->u.c.component->ts.u.cl->length
+               && ref->u.c.component->ts.u.cl->length->expr_type

                     != EXPR_CONSTANT
                     != EXPR_CONSTANT

-               && gfc_traverse_expr (ref->u.c.component->ts.cl->length,
+               && gfc_traverse_expr (ref->u.c.component->ts.u.cl->length,

                                      sym, func, f))
            return true;
 
                                      sym, func, f))
            return true;
 

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index cb456bc..17a0a53 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -833,13 +833,19 @@ gfc_charlen;
 
 #define gfc_get_charlen() XCNEW (gfc_charlen)
 
 
 #define gfc_get_charlen() XCNEW (gfc_charlen)
 

-/* Type specification structure.  FIXME: derived and cl could be union???  */
+/* Type specification structure.  */

 typedef struct
 {
   bt type;
   int kind;
 typedef struct
 {
   bt type;
   int kind;

-  struct gfc_symbol *derived;
-  gfc_charlen *cl;     /* For character types only.  */
+
+  union
+  {
+    struct gfc_symbol *derived;        /* For derived types only.  */
+    gfc_charlen *cl;           /* For character types only.  */
+  }
+  u;
+

   struct gfc_symbol *interface;        /* For PROCEDURE declarations.  */
   unsigned int is_class:1;
   int is_c_interop;
   struct gfc_symbol *interface;        /* For PROCEDURE declarations.  */
   unsigned int is_class:1;
   int is_c_interop;

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index daa46d8..60096e2 100644 (file)
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -410,17 +410,17 @@ gfc_compare_derived_types (gfc_symbol *derived1, gfc_symbol *derived2)
 
       /* Make sure that link lists do not put this function into an 
         endless recursive loop!  */
 
       /* Make sure that link lists do not put this function into an 
         endless recursive loop!  */

-      if (!(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.derived)
-           && !(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.derived)
+      if (!(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived)
+           && !(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived)

            && gfc_compare_types (&dt1->ts, &dt2->ts) == 0)
        return 0;
 
            && gfc_compare_types (&dt1->ts, &dt2->ts) == 0)
        return 0;
 

-      else if ((dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.derived)
-               && !(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.derived))
+      else if ((dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived)
+               && !(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived))

        return 0;
 
        return 0;
 

-      else if (!(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.derived)
-               && (dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.derived))
+      else if (!(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived)
+               && (dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived))

        return 0;
 
       dt1 = dt1->next;
        return 0;
 
       dt1 = dt1->next;


@@ -454,10 +454,10 @@ gfc_compare_types (gfc_typespec *ts1, gfc_typespec *ts2)
     return (ts1->kind == ts2->kind);
 
   /* Compare derived types.  */
     return (ts1->kind == ts2->kind);
 
   /* Compare derived types.  */

-  if (ts1->derived == ts2->derived)
+  if (ts1->u.derived == ts2->u.derived)

     return 1;
 
     return 1;
 

-  return gfc_compare_derived_types (ts1->derived ,ts2->derived);
+  return gfc_compare_derived_types (ts1->u.derived ,ts2->u.derived);

 }
 
 
 }
 
 


@@ -1386,9 +1386,9 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
     return 1;
 
   if (formal->ts.type == BT_DERIVED
     return 1;
 
   if (formal->ts.type == BT_DERIVED

-      && formal->ts.derived && formal->ts.derived->ts.is_iso_c
+      && formal->ts.u.derived && formal->ts.u.derived->ts.is_iso_c

       && actual->ts.type == BT_DERIVED
       && actual->ts.type == BT_DERIVED

-      && actual->ts.derived && actual->ts.derived->ts.is_iso_c)
+      && actual->ts.u.derived && actual->ts.u.derived->ts.is_iso_c)

     return 1;
 
   if (actual->ts.type == BT_PROCEDURE)
     return 1;
 
   if (actual->ts.type == BT_PROCEDURE)


@@ -1551,9 +1551,9 @@ get_sym_storage_size (gfc_symbol *sym)
 
   if (sym->ts.type == BT_CHARACTER)
     {
 
   if (sym->ts.type == BT_CHARACTER)
     {

-      if (sym->ts.cl && sym->ts.cl->length
-          && sym->ts.cl->length->expr_type == EXPR_CONSTANT)
-       strlen = mpz_get_ui (sym->ts.cl->length->value.integer);
+      if (sym->ts.u.cl && sym->ts.u.cl->length
+          && sym->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+       strlen = mpz_get_ui (sym->ts.u.cl->length->value.integer);

       else
        return 0;
     }
       else
        return 0;
     }


@@ -1599,11 +1599,11 @@ get_expr_storage_size (gfc_expr *e)
   
   if (e->ts.type == BT_CHARACTER)
     {
   
   if (e->ts.type == BT_CHARACTER)
     {

-      if (e->ts.cl && e->ts.cl->length
-          && e->ts.cl->length->expr_type == EXPR_CONSTANT)
-       strlen = mpz_get_si (e->ts.cl->length->value.integer);
+      if (e->ts.u.cl && e->ts.u.cl->length
+          && e->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+       strlen = mpz_get_si (e->ts.u.cl->length->value.integer);

       else if (e->expr_type == EXPR_CONSTANT
       else if (e->expr_type == EXPR_CONSTANT

-              && (e->ts.cl == NULL || e->ts.cl->length == NULL))
+              && (e->ts.u.cl == NULL || e->ts.u.cl->length == NULL))

        strlen = e->value.character.length;
       else
        return 0;
        strlen = e->value.character.length;
       else
        return 0;


@@ -1869,28 +1869,28 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
         and assumed-shape dummies, the string length needs to match
         exactly.  */
       if (a->expr->ts.type == BT_CHARACTER
         and assumed-shape dummies, the string length needs to match
         exactly.  */
       if (a->expr->ts.type == BT_CHARACTER

-          && a->expr->ts.cl && a->expr->ts.cl->length
-          && a->expr->ts.cl->length->expr_type == EXPR_CONSTANT
-          && f->sym->ts.cl && f->sym->ts.cl && f->sym->ts.cl->length
-          && f->sym->ts.cl->length->expr_type == EXPR_CONSTANT
+          && a->expr->ts.u.cl && a->expr->ts.u.cl->length
+          && a->expr->ts.u.cl->length->expr_type == EXPR_CONSTANT
+          && f->sym->ts.u.cl && f->sym->ts.u.cl && f->sym->ts.u.cl->length
+          && f->sym->ts.u.cl->length->expr_type == EXPR_CONSTANT

           && (f->sym->attr.pointer || f->sym->attr.allocatable
               || (f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE))
           && (f->sym->attr.pointer || f->sym->attr.allocatable
               || (f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE))

-          && (mpz_cmp (a->expr->ts.cl->length->value.integer,
-                       f->sym->ts.cl->length->value.integer) != 0))
+          && (mpz_cmp (a->expr->ts.u.cl->length->value.integer,
+                       f->sym->ts.u.cl->length->value.integer) != 0))

         {
           if (where && (f->sym->attr.pointer || f->sym->attr.allocatable))
             gfc_warning ("Character length mismatch (%ld/%ld) between actual "
                          "argument and pointer or allocatable dummy argument "
                          "'%s' at %L",
         {
           if (where && (f->sym->attr.pointer || f->sym->attr.allocatable))
             gfc_warning ("Character length mismatch (%ld/%ld) between actual "
                          "argument and pointer or allocatable dummy argument "
                          "'%s' at %L",

-                         mpz_get_si (a->expr->ts.cl->length->value.integer),
-                         mpz_get_si (f->sym->ts.cl->length->value.integer),
+                         mpz_get_si (a->expr->ts.u.cl->length->value.integer),
+                         mpz_get_si (f->sym->ts.u.cl->length->value.integer),

                          f->sym->name, &a->expr->where);
           else if (where)
             gfc_warning ("Character length mismatch (%ld/%ld) between actual "
                          "argument and assumed-shape dummy argument '%s' "
                          "at %L",
                          f->sym->name, &a->expr->where);
           else if (where)
             gfc_warning ("Character length mismatch (%ld/%ld) between actual "
                          "argument and assumed-shape dummy argument '%s' "
                          "at %L",

-                         mpz_get_si (a->expr->ts.cl->length->value.integer),
-                         mpz_get_si (f->sym->ts.cl->length->value.integer),
+                         mpz_get_si (a->expr->ts.u.cl->length->value.integer),
+                         mpz_get_si (f->sym->ts.u.cl->length->value.integer),

                          f->sym->name, &a->expr->where);
           return 0;
         }
                          f->sym->name, &a->expr->where);
           return 0;
         }

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 5bb24a4..1c180eb 100644 (file)
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -62,16 +62,16 @@ gfc_get_string (const char *format, ...)
 static void
 check_charlen_present (gfc_expr *source)
 {
 static void
 check_charlen_present (gfc_expr *source)
 {

-  if (source->ts.cl == NULL)
-    source->ts.cl = gfc_new_charlen (gfc_current_ns);
+  if (source->ts.u.cl == NULL)
+    source->ts.u.cl = gfc_new_charlen (gfc_current_ns);

 
   if (source->expr_type == EXPR_CONSTANT)
     {
 
   if (source->expr_type == EXPR_CONSTANT)
     {

-      source->ts.cl->length = gfc_int_expr (source->value.character.length);
+      source->ts.u.cl->length = gfc_int_expr (source->value.character.length);

       source->rank = 0;
     }
   else if (source->expr_type == EXPR_ARRAY)
       source->rank = 0;
     }
   else if (source->expr_type == EXPR_ARRAY)

-    source->ts.cl->length =
+    source->ts.u.cl->length =

        gfc_int_expr (source->value.constructor->expr->value.character.length);
 }
 
        gfc_int_expr (source->value.constructor->expr->value.character.length);
 }
 


@@ -161,8 +161,8 @@ gfc_resolve_char_achar (gfc_expr *f, gfc_expr *x, gfc_expr *kind,
   f->ts.type = BT_CHARACTER;
   f->ts.kind = (kind == NULL)
             ? gfc_default_character_kind : mpz_get_si (kind->value.integer);
   f->ts.type = BT_CHARACTER;
   f->ts.kind = (kind == NULL)
             ? gfc_default_character_kind : mpz_get_si (kind->value.integer);

-  f->ts.cl = gfc_new_charlen (gfc_current_ns);
-  f->ts.cl->length = gfc_int_expr (1);
+  f->ts.u.cl = gfc_new_charlen (gfc_current_ns);
+  f->ts.u.cl->length = gfc_int_expr (1);

 
   f->value.function.name = gfc_get_string (name, f->ts.kind,
                                           gfc_type_letter (x->ts.type),
 
   f->value.function.name = gfc_get_string (name, f->ts.kind,
                                           gfc_type_letter (x->ts.type),


@@ -651,8 +651,8 @@ gfc_resolve_ctime (gfc_expr *f, gfc_expr *time)
     {
       ts.type = BT_INTEGER;
       ts.kind = 8;
     {
       ts.type = BT_INTEGER;
       ts.kind = 8;

-      ts.derived = NULL;
-      ts.cl = NULL;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;

       gfc_convert_type (time, &ts, 2);
     }
 
       gfc_convert_type (time, &ts, 2);
     }
 


@@ -1058,8 +1058,8 @@ gfc_resolve_index_func (gfc_expr *f, gfc_expr *str,
     {
       ts.type = BT_LOGICAL;
       ts.kind = gfc_default_integer_kind;
     {
       ts.type = BT_LOGICAL;
       ts.kind = gfc_default_integer_kind;

-      ts.derived = NULL;
-      ts.cl = NULL;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;

       gfc_convert_type (back, &ts, 2);
     }
 
       gfc_convert_type (back, &ts, 2);
     }
 


@@ -1125,8 +1125,8 @@ gfc_resolve_isatty (gfc_expr *f, gfc_expr *u)
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_c_int_kind;
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_c_int_kind;

-      ts.derived = NULL;
-      ts.cl = NULL;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;

       gfc_convert_type (u, &ts, 2);
     }
 
       gfc_convert_type (u, &ts, 2);
     }
 


@@ -2175,8 +2175,8 @@ gfc_resolve_fgetc (gfc_expr *f, gfc_expr *u, gfc_expr *c ATTRIBUTE_UNUSED)
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_c_int_kind;
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_c_int_kind;

-      ts.derived = NULL;
-      ts.cl = NULL;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;

       gfc_convert_type (u, &ts, 2);
     }
 
       gfc_convert_type (u, &ts, 2);
     }
 


@@ -2205,8 +2205,8 @@ gfc_resolve_fputc (gfc_expr *f, gfc_expr *u, gfc_expr *c ATTRIBUTE_UNUSED)
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_c_int_kind;
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_c_int_kind;

-      ts.derived = NULL;
-      ts.cl = NULL;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;

       gfc_convert_type (u, &ts, 2);
     }
 
       gfc_convert_type (u, &ts, 2);
     }
 


@@ -2235,8 +2235,8 @@ gfc_resolve_ftell (gfc_expr *f, gfc_expr *u)
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_c_int_kind;
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_c_int_kind;

-      ts.derived = NULL;
-      ts.cl = NULL;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;

       gfc_convert_type (u, &ts, 2);
     }
 
       gfc_convert_type (u, &ts, 2);
     }
 


@@ -2341,16 +2341,16 @@ gfc_resolve_transfer (gfc_expr *f, gfc_expr *source ATTRIBUTE_UNUSED,
   static char transfer0[] = "__transfer0", transfer1[] = "__transfer1";
 
   if (mold->ts.type == BT_CHARACTER
   static char transfer0[] = "__transfer0", transfer1[] = "__transfer1";
 
   if (mold->ts.type == BT_CHARACTER

-       && !mold->ts.cl->length
+       && !mold->ts.u.cl->length

        && gfc_is_constant_expr (mold))
     {
       int len;
       if (mold->expr_type == EXPR_CONSTANT)
        && gfc_is_constant_expr (mold))
     {
       int len;
       if (mold->expr_type == EXPR_CONSTANT)

-       mold->ts.cl->length = gfc_int_expr (mold->value.character.length);
+       mold->ts.u.cl->length = gfc_int_expr (mold->value.character.length);

       else
        {
          len = mold->value.constructor->expr->value.character.length;
       else
        {
          len = mold->value.constructor->expr->value.character.length;

-         mold->ts.cl->length = gfc_int_expr (len);
+         mold->ts.u.cl->length = gfc_int_expr (len);

        }
     }
 
        }
     }
 


@@ -2498,8 +2498,8 @@ gfc_resolve_ttynam (gfc_expr *f, gfc_expr *unit)
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_c_int_kind;
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_c_int_kind;

-      ts.derived = NULL;
-      ts.cl = NULL;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;

       gfc_convert_type (unit, &ts, 2);
     }
 
       gfc_convert_type (unit, &ts, 2);
     }
 


@@ -3077,8 +3077,8 @@ gfc_resolve_ctime_sub (gfc_code *c)
     {
       ts.type = BT_INTEGER;
       ts.kind = 8;
     {
       ts.type = BT_INTEGER;
       ts.kind = 8;

-      ts.derived = NULL;
-      ts.cl = NULL;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;

       gfc_convert_type (c->ext.actual->expr, &ts, 2);
     }
 
       gfc_convert_type (c->ext.actual->expr, &ts, 2);
     }
 


@@ -3180,8 +3180,8 @@ gfc_resolve_fgetc_sub (gfc_code *c)
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_c_int_kind;
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_c_int_kind;

-      ts.derived = NULL;
-      ts.cl = NULL;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;

       gfc_convert_type (u, &ts, 2);
     }
 
       gfc_convert_type (u, &ts, 2);
     }
 


@@ -3225,8 +3225,8 @@ gfc_resolve_fputc_sub (gfc_code *c)
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_c_int_kind;
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_c_int_kind;

-      ts.derived = NULL;
-      ts.cl = NULL;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;

       gfc_convert_type (u, &ts, 2);
     }
 
       gfc_convert_type (u, &ts, 2);
     }
 


@@ -3274,8 +3274,8 @@ gfc_resolve_fseek_sub (gfc_code *c)
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_c_int_kind;
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_c_int_kind;

-      ts.derived = NULL;
-      ts.cl = NULL;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;

       gfc_convert_type (unit, &ts, 2);
     }
 
       gfc_convert_type (unit, &ts, 2);
     }
 


@@ -3283,8 +3283,8 @@ gfc_resolve_fseek_sub (gfc_code *c)
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_intio_kind;
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_intio_kind;

-      ts.derived = NULL;
-      ts.cl = NULL;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;

       gfc_convert_type (offset, &ts, 2);
     }
 
       gfc_convert_type (offset, &ts, 2);
     }
 


@@ -3292,8 +3292,8 @@ gfc_resolve_fseek_sub (gfc_code *c)
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_c_int_kind;
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_c_int_kind;

-      ts.derived = NULL;
-      ts.cl = NULL;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;

       gfc_convert_type (whence, &ts, 2);
     }
 
       gfc_convert_type (whence, &ts, 2);
     }
 


@@ -3316,8 +3316,8 @@ gfc_resolve_ftell_sub (gfc_code *c)
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_c_int_kind;
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_c_int_kind;

-      ts.derived = NULL;
-      ts.cl = NULL;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;

       gfc_convert_type (unit, &ts, 2);
     }
 
       gfc_convert_type (unit, &ts, 2);
     }
 


@@ -3336,8 +3336,8 @@ gfc_resolve_ttynam_sub (gfc_code *c)
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_c_int_kind;
     {
       ts.type = BT_INTEGER;
       ts.kind = gfc_c_int_kind;

-      ts.derived = NULL;
-      ts.cl = NULL;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;

       gfc_convert_type (c->ext.actual->expr, &ts, 2);
     }
 
       gfc_convert_type (c->ext.actual->expr, &ts, 2);
     }
 

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index b9b9d54..3c6ef49 100644 (file)
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -2264,7 +2264,7 @@ gfc_match_allocate (void)
        }
 
       if (tail->expr->ts.type == BT_DERIVED)
        }
 
       if (tail->expr->ts.type == BT_DERIVED)

-       tail->expr->ts.derived = gfc_use_derived (tail->expr->ts.derived);
+       tail->expr->ts.u.derived = gfc_use_derived (tail->expr->ts.u.derived);

 
       /* FIXME: disable the checking on derived types and arrays.  */
       if (!(tail->expr->ref
 
       /* FIXME: disable the checking on derived types and arrays.  */
       if (!(tail->expr->ref


@@ -3214,7 +3214,7 @@ gfc_match_namelist (void)
              gfc_error_check ();
            }
 
              gfc_error_check ();
            }
 

-         if (sym->ts.type == BT_CHARACTER && sym->ts.cl->length == NULL)
+         if (sym->ts.type == BT_CHARACTER && sym->ts.u.cl->length == NULL)

            {
              gfc_error ("Assumed character length '%s' in namelist '%s' at "
                         "%C is not allowed", sym->name, group_name->name);
            {
              gfc_error ("Assumed character length '%s' in namelist '%s' at "
                         "%C is not allowed", sym->name, group_name->name);

diff --git a/gcc/fortran/misc.c b/gcc/fortran/misc.c
index 7e4b481..f80c9fa 100644 (file)
--- a/gcc/fortran/misc.c
+++ b/gcc/fortran/misc.c
@@ -67,9 +67,9 @@ void
 gfc_clear_ts (gfc_typespec *ts)
 {
   ts->type = BT_UNKNOWN;
 gfc_clear_ts (gfc_typespec *ts)
 {
   ts->type = BT_UNKNOWN;

-  ts->derived = NULL;
+  ts->u.derived = NULL;

   ts->kind = 0;
   ts->kind = 0;

-  ts->cl = NULL;
+  ts->u.cl = NULL;

   ts->interface = NULL;
   ts->is_class = 0;
   /* flag that says if the type is C interoperable */
   ts->interface = NULL;
   ts->is_class = 0;
   /* flag that says if the type is C interoperable */


@@ -184,7 +184,7 @@ gfc_typename (gfc_typespec *ts)
       sprintf (buffer, "HOLLERITH");
       break;
     case BT_DERIVED:
       sprintf (buffer, "HOLLERITH");
       break;
     case BT_DERIVED:

-      sprintf (buffer, "TYPE(%s)", ts->derived->name);
+      sprintf (buffer, "TYPE(%s)", ts->u.derived->name);

       break;
     case BT_PROCEDURE:
       strcpy (buffer, "PROCEDURE");
       break;
     case BT_PROCEDURE:
       strcpy (buffer, "PROCEDURE");

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 5d64fd1..fe05dff 100644 (file)
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -2038,7 +2038,7 @@ mio_typespec (gfc_typespec *ts)
   if (ts->type != BT_DERIVED)
     mio_integer (&ts->kind);
   else
   if (ts->type != BT_DERIVED)
     mio_integer (&ts->kind);
   else

-    mio_symbol_ref (&ts->derived);
+    mio_symbol_ref (&ts->u.derived);

 
   /* Add info for C interop and is_iso_c.  */
   mio_integer (&ts->is_c_interop);
 
   /* Add info for C interop and is_iso_c.  */
   mio_integer (&ts->is_c_interop);


@@ -2054,12 +2054,12 @@ mio_typespec (gfc_typespec *ts)
 
   if (ts->type != BT_CHARACTER)
     {
 
   if (ts->type != BT_CHARACTER)
     {

-      /* ts->cl is only valid for BT_CHARACTER.  */
+      /* ts->u.cl is only valid for BT_CHARACTER.  */

       mio_lparen ();
       mio_rparen ();
     }
   else
       mio_lparen ();
       mio_rparen ();
     }
   else

-    mio_charlen (&ts->cl);
+    mio_charlen (&ts->u.cl);

 
   mio_rparen ();
 }
 
   mio_rparen ();
 }

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 320fb65..d60121c 100644 (file)
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -873,7 +873,7 @@ resolve_omp_clauses (gfc_code *code)
                if (!n->sym->attr.threadprivate)
                  gfc_error ("Non-THREADPRIVATE object '%s' in COPYIN clause"
                             " at %L", n->sym->name, &code->loc);
                if (!n->sym->attr.threadprivate)
                  gfc_error ("Non-THREADPRIVATE object '%s' in COPYIN clause"
                             " at %L", n->sym->name, &code->loc);

-               if (n->sym->ts.type == BT_DERIVED && n->sym->ts.derived->attr.alloc_comp)
+               if (n->sym->ts.type == BT_DERIVED && n->sym->ts.u.derived->attr.alloc_comp)

                  gfc_error ("COPYIN clause object '%s' at %L has ALLOCATABLE components",
                             n->sym->name, &code->loc);
              }
                  gfc_error ("COPYIN clause object '%s' at %L has ALLOCATABLE components",
                             n->sym->name, &code->loc);
              }


@@ -884,7 +884,7 @@ resolve_omp_clauses (gfc_code *code)
                if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
                  gfc_error ("Assumed size array '%s' in COPYPRIVATE clause "
                             "at %L", n->sym->name, &code->loc);
                if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
                  gfc_error ("Assumed size array '%s' in COPYPRIVATE clause "
                             "at %L", n->sym->name, &code->loc);

-               if (n->sym->ts.type == BT_DERIVED && n->sym->ts.derived->attr.alloc_comp)
+               if (n->sym->ts.type == BT_DERIVED && n->sym->ts.u.derived->attr.alloc_comp)

                  gfc_error ("COPYPRIVATE clause object '%s' at %L has ALLOCATABLE components",
                             n->sym->name, &code->loc);
              }
                  gfc_error ("COPYPRIVATE clause object '%s' at %L has ALLOCATABLE components",
                             n->sym->name, &code->loc);
              }


@@ -916,7 +916,7 @@ resolve_omp_clauses (gfc_code *code)
                                 n->sym->name, name, &code->loc);
                    /* Variables in REDUCTION-clauses must be of intrinsic type (flagged below).  */
                    if ((list < OMP_LIST_REDUCTION_FIRST || list > OMP_LIST_REDUCTION_LAST) &&
                                 n->sym->name, name, &code->loc);
                    /* Variables in REDUCTION-clauses must be of intrinsic type (flagged below).  */
                    if ((list < OMP_LIST_REDUCTION_FIRST || list > OMP_LIST_REDUCTION_LAST) &&

-                       n->sym->ts.type == BT_DERIVED && n->sym->ts.derived->attr.alloc_comp)
+                       n->sym->ts.type == BT_DERIVED && n->sym->ts.u.derived->attr.alloc_comp)

                      gfc_error ("%s clause object '%s' has ALLOCATABLE components at %L",
                                 name, n->sym->name, &code->loc);
                    if (n->sym->attr.cray_pointer)
                      gfc_error ("%s clause object '%s' has ALLOCATABLE components at %L",
                                 name, n->sym->name, &code->loc);
                    if (n->sym->attr.cray_pointer)

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index e4463bd..2552fcd 100644 (file)
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -2049,24 +2049,24 @@ endType:
     {
       /* Look for allocatable components.  */
       if (c->attr.allocatable
     {
       /* Look for allocatable components.  */
       if (c->attr.allocatable

-         || (c->ts.type == BT_DERIVED && c->ts.derived->attr.alloc_comp))
+         || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.alloc_comp))

        sym->attr.alloc_comp = 1;
 
       /* Look for pointer components.  */
       if (c->attr.pointer
        sym->attr.alloc_comp = 1;
 
       /* Look for pointer components.  */
       if (c->attr.pointer

-         || (c->ts.type == BT_DERIVED && c->ts.derived->attr.pointer_comp))
+         || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.pointer_comp))

        sym->attr.pointer_comp = 1;
 
       /* Look for procedure pointer components.  */
       if (c->attr.proc_pointer
          || (c->ts.type == BT_DERIVED
        sym->attr.pointer_comp = 1;
 
       /* Look for procedure pointer components.  */
       if (c->attr.proc_pointer
          || (c->ts.type == BT_DERIVED

-             && c->ts.derived->attr.proc_pointer_comp))
+             && c->ts.u.derived->attr.proc_pointer_comp))

        sym->attr.proc_pointer_comp = 1;
 
       /* Look for private components.  */
       if (sym->component_access == ACCESS_PRIVATE
          || c->attr.access == ACCESS_PRIVATE
        sym->attr.proc_pointer_comp = 1;
 
       /* Look for private components.  */
       if (sym->component_access == ACCESS_PRIVATE
          || c->attr.access == ACCESS_PRIVATE

-         || (c->ts.type == BT_DERIVED && c->ts.derived->attr.private_comp))
+         || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.private_comp))

        sym->attr.private_comp = 1;
     }
 
        sym->attr.private_comp = 1;
     }
 


@@ -2320,7 +2320,7 @@ match_deferred_characteristics (gfc_typespec * ts)
     {
       ts->kind = 0;
 
     {
       ts->kind = 0;
 

-      if (!ts->derived || !ts->derived->components)
+      if (!ts->u.derived || !ts->u.derived->components)

        m = MATCH_ERROR;
     }
 
        m = MATCH_ERROR;
     }
 


@@ -2360,8 +2360,8 @@ check_function_result_typed (void)
 
   /* Check type-parameters, at the moment only CHARACTER lengths possible.  */
   /* TODO:  Extend when KIND type parameters are implemented.  */
 
   /* Check type-parameters, at the moment only CHARACTER lengths possible.  */
   /* TODO:  Extend when KIND type parameters are implemented.  */

-  if (ts->type == BT_CHARACTER && ts->cl && ts->cl->length)
-    gfc_expr_check_typed (ts->cl->length, gfc_current_ns, true);
+  if (ts->type == BT_CHARACTER && ts->u.cl && ts->u.cl->length)
+    gfc_expr_check_typed (ts->u.cl->length, gfc_current_ns, true);

 }
 
 
 }
 
 


@@ -2540,7 +2540,7 @@ declSt:
 
       gfc_current_block ()->ts.kind = 0;
       /* Keep the derived type; if it's bad, it will be discovered later.  */
 
       gfc_current_block ()->ts.kind = 0;
       /* Keep the derived type; if it's bad, it will be discovered later.  */

-      if (!(ts->type == BT_DERIVED && ts->derived))
+      if (!(ts->type == BT_DERIVED && ts->u.derived))

        ts->type = BT_UNKNOWN;
     }
 
        ts->type = BT_UNKNOWN;
     }
 

diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 0d52c6c..e0021c5 100644 (file)
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -1770,7 +1770,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
   if (sym->ts.type != BT_DERIVED || gfc_match_char ('%') != MATCH_YES)
     goto check_substring;
 
   if (sym->ts.type != BT_DERIVED || gfc_match_char ('%') != MATCH_YES)
     goto check_substring;
 

-  sym = sym->ts.derived;
+  sym = sym->ts.u.derived;

 
   for (;;)
     {
 
   for (;;)
     {


@@ -1864,7 +1864,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
          || gfc_match_char ('%') != MATCH_YES)
        break;
 
          || gfc_match_char ('%') != MATCH_YES)
        break;
 

-      sym = component->ts.derived;
+      sym = component->ts.u.derived;

     }
 
 check_substring:
     }
 
 check_substring:


@@ -1881,7 +1881,7 @@ check_substring:
 
   if (primary->ts.type == BT_CHARACTER)
     {
 
   if (primary->ts.type == BT_CHARACTER)
     {

-      switch (match_substring (primary->ts.cl, equiv_flag, &substring))
+      switch (match_substring (primary->ts.u.cl, equiv_flag, &substring))

        {
        case MATCH_YES:
          if (tail == NULL)
        {
        case MATCH_YES:
          if (tail == NULL)


@@ -1893,7 +1893,7 @@ check_substring:
            primary->expr_type = EXPR_SUBSTRING;
 
          if (substring)
            primary->expr_type = EXPR_SUBSTRING;
 
          if (substring)

-           primary->ts.cl = NULL;
+           primary->ts.u.cl = NULL;

 
          break;
 
 
          break;
 


@@ -1990,7 +1990,7 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
               follows.  */
            if (ts->type == BT_CHARACTER
                && ref->next && ref->next->type == REF_SUBSTRING)
               follows.  */
            if (ts->type == BT_CHARACTER
                && ref->next && ref->next->type == REF_SUBSTRING)

-               ts->cl = NULL;
+               ts->u.cl = NULL;

          }
 
        pointer = ref->u.c.component->attr.pointer;
          }
 
        pointer = ref->u.c.component->attr.pointer;


@@ -2106,7 +2106,7 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head,
          value->where = gfc_current_locus;
 
          if (build_actual_constructor (comp_head, &value->value.constructor,
          value->where = gfc_current_locus;
 
          if (build_actual_constructor (comp_head, &value->value.constructor,

-                                       comp->ts.derived) == FAILURE)
+                                       comp->ts.u.derived) == FAILURE)

            {
              gfc_free_expr (value);
              return FAILURE;
            {
              gfc_free_expr (value);
              return FAILURE;


@@ -2284,13 +2284,13 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result,
                && sym->attr.extension
                && (comp_tail->val->ts.type != BT_DERIVED
                      ||
                && sym->attr.extension
                && (comp_tail->val->ts.type != BT_DERIVED
                      ||

-                   comp_tail->val->ts.derived != this_comp->ts.derived))
+                   comp_tail->val->ts.u.derived != this_comp->ts.u.derived))

            {
              gfc_current_locus = where;
              gfc_free_expr (comp_tail->val);
              comp_tail->val = NULL;
 
            {
              gfc_current_locus = where;
              gfc_free_expr (comp_tail->val);
              comp_tail->val = NULL;
 

-             m = gfc_match_structure_constructor (comp->ts.derived, 
+             m = gfc_match_structure_constructor (comp->ts.u.derived, 

                                                   &comp_tail->val, true);
              if (m == MATCH_NO)
                goto syntax;
                                                   &comp_tail->val, true);
              if (m == MATCH_NO)
                goto syntax;


@@ -2335,7 +2335,7 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result,
   e->expr_type = EXPR_STRUCTURE;
 
   e->ts.type = BT_DERIVED;
   e->expr_type = EXPR_STRUCTURE;
 
   e->ts.type = BT_DERIVED;

-  e->ts.derived = sym;
+  e->ts.u.derived = sym;

   e->where = where;
 
   e->value.constructor = ctor_head;
   e->where = where;
 
   e->value.constructor = ctor_head;


@@ -2758,7 +2758,7 @@ gfc_match_rvalue (gfc_expr **result)
             that we're not sure is a variable yet.  */
 
          if ((implicit_char || sym->ts.type == BT_CHARACTER)
             that we're not sure is a variable yet.  */
 
          if ((implicit_char || sym->ts.type == BT_CHARACTER)

-             && match_substring (sym->ts.cl, 0, &e->ref) == MATCH_YES)
+             && match_substring (sym->ts.u.cl, 0, &e->ref) == MATCH_YES)

            {
 
              e->expr_type = EXPR_VARIABLE;
            {
 
              e->expr_type = EXPR_VARIABLE;


@@ -2780,7 +2780,7 @@ gfc_match_rvalue (gfc_expr **result)
 
              e->ts = sym->ts;
              if (e->ref)
 
              e->ts = sym->ts;
              if (e->ref)

-               e->ts.cl = NULL;
+               e->ts.u.cl = NULL;

              m = MATCH_YES;
              break;
            }
              m = MATCH_YES;
              break;
            }


@@ -2957,7 +2957,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag)
             type may still have to be resolved.  */
 
          if (sym->ts.type == BT_DERIVED
             type may still have to be resolved.  */
 
          if (sym->ts.type == BT_DERIVED

-             && gfc_use_derived (sym->ts.derived) == NULL)
+             && gfc_use_derived (sym->ts.u.derived) == NULL)

            return MATCH_ERROR;
          break;
        }
            return MATCH_ERROR;
          break;
        }

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index bc71af1..9baef62 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -103,16 +103,16 @@ is_sym_host_assoc (gfc_symbol *sym, gfc_namespace *ns)
 static gfc_try
 resolve_typespec_used (gfc_typespec* ts, locus* where, const char* name)
 {
 static gfc_try
 resolve_typespec_used (gfc_typespec* ts, locus* where, const char* name)
 {

-  if (ts->type == BT_DERIVED && ts->derived->attr.abstract)
+  if (ts->type == BT_DERIVED && ts->u.derived->attr.abstract)

     {
       if (where)
        {
          if (name)
            gfc_error ("'%s' at %L is of the ABSTRACT type '%s'",
     {
       if (where)
        {
          if (name)
            gfc_error ("'%s' at %L is of the ABSTRACT type '%s'",

-                      name, where, ts->derived->name);
+                      name, where, ts->u.derived->name);

          else
            gfc_error ("ABSTRACT type '%s' used at %L",
          else
            gfc_error ("ABSTRACT type '%s' used at %L",

-                      ts->derived->name, where);
+                      ts->u.derived->name, where);

        }
 
       return FAILURE;
        }
 
       return FAILURE;


@@ -294,7 +294,7 @@ resolve_formal_arglist (gfc_symbol *proc)
 
          if (sym->ts.type == BT_CHARACTER)
            {
 
          if (sym->ts.type == BT_CHARACTER)
            {

-             gfc_charlen *cl = sym->ts.cl;
+             gfc_charlen *cl = sym->ts.u.cl;

              if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT)
                {
                  gfc_error ("Character-valued argument '%s' of statement "
              if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT)
                {
                  gfc_error ("Character-valued argument '%s' of statement "


@@ -372,7 +372,7 @@ resolve_contained_fntype (gfc_symbol *sym, gfc_namespace *ns)
 
   if (sym->result->ts.type == BT_CHARACTER)
     {
 
   if (sym->result->ts.type == BT_CHARACTER)
     {

-      gfc_charlen *cl = sym->result->ts.cl;
+      gfc_charlen *cl = sym->result->ts.u.cl;

       if (!cl || !cl->length)
        gfc_error ("Character-valued internal function '%s' at %L must "
                   "not be assumed length", sym->name, &sym->declared_at);
       if (!cl || !cl->length)
        gfc_error ("Character-valued internal function '%s' at %L must "
                   "not be assumed length", sym->name, &sym->declared_at);


@@ -552,16 +552,16 @@ resolve_entries (gfc_namespace *ns)
             the same string length, i.e. both len=*, or both len=4.
             Having both len=<variable> is also possible, but difficult to
             check at compile time.  */
             the same string length, i.e. both len=*, or both len=4.
             Having both len=<variable> is also possible, but difficult to
             check at compile time.  */

-         else if (ts->type == BT_CHARACTER && ts->cl && fts->cl
-                  && (((ts->cl->length && !fts->cl->length)
-                       ||(!ts->cl->length && fts->cl->length))
-                      || (ts->cl->length
-                          && ts->cl->length->expr_type
-                             != fts->cl->length->expr_type)
-                      || (ts->cl->length
-                          && ts->cl->length->expr_type == EXPR_CONSTANT
-                          && mpz_cmp (ts->cl->length->value.integer,
-                                      fts->cl->length->value.integer) != 0)))
+         else if (ts->type == BT_CHARACTER && ts->u.cl && fts->u.cl
+                  && (((ts->u.cl->length && !fts->u.cl->length)
+                       ||(!ts->u.cl->length && fts->u.cl->length))
+                      || (ts->u.cl->length
+                          && ts->u.cl->length->expr_type
+                             != fts->u.cl->length->expr_type)
+                      || (ts->u.cl->length
+                          && ts->u.cl->length->expr_type == EXPR_CONSTANT
+                          && mpz_cmp (ts->u.cl->length->value.integer,
+                                      fts->u.cl->length->value.integer) != 0)))

            gfc_notify_std (GFC_STD_GNU, "Extension: Function %s at %L with "
                            "entries returning variables of different "
                            "string lengths", ns->entries->sym->name,
            gfc_notify_std (GFC_STD_GNU, "Extension: Function %s at %L with "
                            "entries returning variables of different "
                            "string lengths", ns->entries->sym->name,


@@ -688,7 +688,7 @@ has_default_initializer (gfc_symbol *der)
   for (c = der->components; c; c = c->next)
     if ((c->ts.type != BT_DERIVED && c->initializer)
        || (c->ts.type == BT_DERIVED
   for (c = der->components; c; c = c->next)
     if ((c->ts.type != BT_DERIVED && c->initializer)
        || (c->ts.type == BT_DERIVED

-           && (!c->attr.pointer && has_default_initializer (c->ts.derived))))
+           && (!c->attr.pointer && has_default_initializer (c->ts.u.derived))))

       break;
 
   return c != NULL;
       break;
 
   return c != NULL;


@@ -718,16 +718,16 @@ resolve_common_vars (gfc_symbol *sym, bool named_common)
       if (csym->ts.type != BT_DERIVED)
        continue;
 
       if (csym->ts.type != BT_DERIVED)
        continue;
 

-      if (!(csym->ts.derived->attr.sequence
-           || csym->ts.derived->attr.is_bind_c))
+      if (!(csym->ts.u.derived->attr.sequence
+           || csym->ts.u.derived->attr.is_bind_c))

        gfc_error_now ("Derived type variable '%s' in COMMON at %L "
                       "has neither the SEQUENCE nor the BIND(C) "
                       "attribute", csym->name, &csym->declared_at);
        gfc_error_now ("Derived type variable '%s' in COMMON at %L "
                       "has neither the SEQUENCE nor the BIND(C) "
                       "attribute", csym->name, &csym->declared_at);

-      if (csym->ts.derived->attr.alloc_comp)
+      if (csym->ts.u.derived->attr.alloc_comp)

        gfc_error_now ("Derived type variable '%s' in COMMON at %L "
                       "has an ultimate component that is "
                       "allocatable", csym->name, &csym->declared_at);
        gfc_error_now ("Derived type variable '%s' in COMMON at %L "
                       "has an ultimate component that is "
                       "allocatable", csym->name, &csym->declared_at);

-      if (has_default_initializer (csym->ts.derived))
+      if (has_default_initializer (csym->ts.u.derived))

        gfc_error_now ("Derived type variable '%s' in COMMON at %L "
                       "may not have default initializer", csym->name,
                       &csym->declared_at);
        gfc_error_now ("Derived type variable '%s' in COMMON at %L "
                       "may not have default initializer", csym->name,
                       &csym->declared_at);


@@ -826,15 +826,15 @@ resolve_structure_cons (gfc_expr *expr)
   if (expr->ref)
     comp = expr->ref->u.c.sym->components;
   else
   if (expr->ref)
     comp = expr->ref->u.c.sym->components;
   else

-    comp = expr->ts.derived->components;
+    comp = expr->ts.u.derived->components;

 
   /* See if the user is trying to invoke a structure constructor for one of
      the iso_c_binding derived types.  */
 
   /* See if the user is trying to invoke a structure constructor for one of
      the iso_c_binding derived types.  */

-  if (expr->ts.derived && expr->ts.derived->ts.is_iso_c && cons
+  if (expr->ts.u.derived && expr->ts.u.derived->ts.is_iso_c && cons

       && cons->expr != NULL)
     {
       gfc_error ("Components of structure constructor '%s' at %L are PRIVATE",
       && cons->expr != NULL)
     {
       gfc_error ("Components of structure constructor '%s' at %L are PRIVATE",

-                expr->ts.derived->name, &(expr->where));
+                expr->ts.u.derived->name, &(expr->where));

       return FAILURE;
     }
 
       return FAILURE;
     }
 


@@ -2191,9 +2191,9 @@ is_scalar_expr_ptr (gfc_expr *expr)
                     its length is one.  */
                  if (expr->ts.type == BT_CHARACTER)
                    {
                     its length is one.  */
                  if (expr->ts.type == BT_CHARACTER)
                    {

-                     if (expr->ts.cl == NULL
-                         || expr->ts.cl->length == NULL
-                         || mpz_cmp_si (expr->ts.cl->length->value.integer, 1)
+                     if (expr->ts.u.cl == NULL
+                         || expr->ts.u.cl->length == NULL
+                         || mpz_cmp_si (expr->ts.u.cl->length->value.integer, 1)

                          != 0)
                         retval = FAILURE;
                    }
                          != 0)
                         retval = FAILURE;
                    }


@@ -2224,9 +2224,9 @@ is_scalar_expr_ptr (gfc_expr *expr)
   else if (expr->ts.type == BT_CHARACTER && expr->rank == 0)
     {
       /* Character string.  Make sure it's of length 1.  */
   else if (expr->ts.type == BT_CHARACTER && expr->rank == 0)
     {
       /* Character string.  Make sure it's of length 1.  */

-      if (expr->ts.cl == NULL
-          || expr->ts.cl->length == NULL
-          || mpz_cmp_si (expr->ts.cl->length->value.integer, 1) != 0)
+      if (expr->ts.u.cl == NULL
+          || expr->ts.u.cl->length == NULL
+          || mpz_cmp_si (expr->ts.u.cl->length->value.integer, 1) != 0)

         retval = FAILURE;
     }
   else if (expr->rank != 0)
         retval = FAILURE;
     }
   else if (expr->rank != 0)


@@ -2376,12 +2376,12 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
                          any type should be ok if the variable is of a C
                          interoperable type.  */
                      if (arg_ts->type == BT_CHARACTER)
                          any type should be ok if the variable is of a C
                          interoperable type.  */
                      if (arg_ts->type == BT_CHARACTER)

-                       if (arg_ts->cl != NULL
-                           && (arg_ts->cl->length == NULL
-                               || arg_ts->cl->length->expr_type
+                       if (arg_ts->u.cl != NULL
+                           && (arg_ts->u.cl->length == NULL
+                               || arg_ts->u.cl->length->expr_type

                                   != EXPR_CONSTANT
                                || mpz_cmp_si
                                   != EXPR_CONSTANT
                                || mpz_cmp_si

-                                   (arg_ts->cl->length->value.integer, 1)
+                                   (arg_ts->u.cl->length->value.integer, 1)

                                   != 0)
                            && is_scalar_expr_ptr (args->expr) != SUCCESS)
                          {
                                   != 0)
                            && is_scalar_expr_ptr (args->expr) != SUCCESS)
                          {


@@ -2536,8 +2536,8 @@ resolve_function (gfc_expr *expr)
                              &expr->value.function.actual, 0);
 
   if (sym && sym->ts.type == BT_CHARACTER
                              &expr->value.function.actual, 0);
 
   if (sym && sym->ts.type == BT_CHARACTER

-      && sym->ts.cl
-      && sym->ts.cl->length == NULL
+      && sym->ts.u.cl
+      && sym->ts.u.cl->length == NULL

       && !sym->attr.dummy
       && expr->value.function.esym == NULL
       && !sym->attr.contained)
       && !sym->attr.dummy
       && expr->value.function.esym == NULL
       && !sym->attr.contained)


@@ -2687,7 +2687,7 @@ resolve_function (gfc_expr *expr)
   if (expr->ts.type == BT_CHARACTER && expr->value.function.esym
       && expr->value.function.esym->attr.use_assoc)
     {
   if (expr->ts.type == BT_CHARACTER && expr->value.function.esym
       && expr->value.function.esym->attr.use_assoc)
     {

-      gfc_expr_set_symbols_referenced (expr->ts.cl->length);
+      gfc_expr_set_symbols_referenced (expr->ts.u.cl->length);

     }
 
   if (t == SUCCESS
     }
 
   if (t == SUCCESS


@@ -3396,7 +3396,7 @@ resolve_operator (gfc_expr *e)
     case INTRINSIC_PARENTHESES:
       e->ts = op1->ts;
       if (e->ts.type == BT_CHARACTER)
     case INTRINSIC_PARENTHESES:
       e->ts = op1->ts;
       if (e->ts.type == BT_CHARACTER)

-       e->ts.cl = op1->ts.cl;
+       e->ts.u.cl = op1->ts.u.cl;

       break;
 
     default:
       break;
 
     default:


@@ -3924,7 +3924,7 @@ find_array_spec (gfc_expr *e)
 
       case REF_COMPONENT:
        if (derived == NULL)
 
       case REF_COMPONENT:
        if (derived == NULL)

-         derived = e->symtree->n.sym->ts.derived;
+         derived = e->symtree->n.sym->ts.u.derived;

 
        c = derived->components;
 
 
        c = derived->components;
 


@@ -3933,7 +3933,7 @@ find_array_spec (gfc_expr *e)
            {
              /* Track the sequence of component references.  */
              if (c->ts.type == BT_DERIVED)
            {
              /* Track the sequence of component references.  */
              if (c->ts.type == BT_DERIVED)

-               derived = c->ts.derived;
+               derived = c->ts.u.derived;

              break;
            }
 
              break;
            }
 


@@ -4116,10 +4116,10 @@ gfc_resolve_substring_charlen (gfc_expr *e)
 
   gcc_assert (char_ref->next == NULL);
 
 
   gcc_assert (char_ref->next == NULL);
 

-  if (e->ts.cl)
+  if (e->ts.u.cl)

     {
     {

-      if (e->ts.cl->length)
-       gfc_free_expr (e->ts.cl->length);
+      if (e->ts.u.cl->length)
+       gfc_free_expr (e->ts.u.cl->length);

       else if (e->expr_type == EXPR_VARIABLE
                 && e->symtree->n.sym->attr.dummy)
        return;
       else if (e->expr_type == EXPR_VARIABLE
                 && e->symtree->n.sym->attr.dummy)
        return;


@@ -4128,8 +4128,8 @@ gfc_resolve_substring_charlen (gfc_expr *e)
   e->ts.type = BT_CHARACTER;
   e->ts.kind = gfc_default_character_kind;
 
   e->ts.type = BT_CHARACTER;
   e->ts.kind = gfc_default_character_kind;
 

-  if (!e->ts.cl)
-    e->ts.cl = gfc_new_charlen (gfc_current_ns);
+  if (!e->ts.u.cl)
+    e->ts.u.cl = gfc_new_charlen (gfc_current_ns);

 
   if (char_ref->u.ss.start)
     start = gfc_copy_expr (char_ref->u.ss.start);
 
   if (char_ref->u.ss.start)
     start = gfc_copy_expr (char_ref->u.ss.start);


@@ -4139,7 +4139,7 @@ gfc_resolve_substring_charlen (gfc_expr *e)
   if (char_ref->u.ss.end)
     end = gfc_copy_expr (char_ref->u.ss.end);
   else if (e->expr_type == EXPR_VARIABLE)
   if (char_ref->u.ss.end)
     end = gfc_copy_expr (char_ref->u.ss.end);
   else if (e->expr_type == EXPR_VARIABLE)

-    end = gfc_copy_expr (e->symtree->n.sym->ts.cl->length);
+    end = gfc_copy_expr (e->symtree->n.sym->ts.u.cl->length);

   else
     end = NULL;
 
   else
     end = NULL;
 


@@ -4147,15 +4147,15 @@ gfc_resolve_substring_charlen (gfc_expr *e)
     return;
 
   /* Length = (end - start +1).  */
     return;
 
   /* Length = (end - start +1).  */

-  e->ts.cl->length = gfc_subtract (end, start);
-  e->ts.cl->length = gfc_add (e->ts.cl->length, gfc_int_expr (1));
+  e->ts.u.cl->length = gfc_subtract (end, start);
+  e->ts.u.cl->length = gfc_add (e->ts.u.cl->length, gfc_int_expr (1));

 
 

-  e->ts.cl->length->ts.type = BT_INTEGER;
-  e->ts.cl->length->ts.kind = gfc_charlen_int_kind;
+  e->ts.u.cl->length->ts.type = BT_INTEGER;
+  e->ts.u.cl->length->ts.kind = gfc_charlen_int_kind;

 
   /* Make sure that the length is simplified.  */
 
   /* Make sure that the length is simplified.  */

-  gfc_simplify_expr (e->ts.cl->length, 1);
-  gfc_resolve_expr (e->ts.cl->length);
+  gfc_simplify_expr (e->ts.u.cl->length, 1);
+  gfc_resolve_expr (e->ts.u.cl->length);

 }
 
 
 }
 
 


@@ -4447,7 +4447,7 @@ resolve_variable (gfc_expr *e)
       /* Now do the same check on the specification expressions.  */
       specification_expr = 1;
       if (sym->ts.type == BT_CHARACTER
       /* Now do the same check on the specification expressions.  */
       specification_expr = 1;
       if (sym->ts.type == BT_CHARACTER

-         && gfc_resolve_expr (sym->ts.cl->length) == FAILURE)
+         && gfc_resolve_expr (sym->ts.u.cl->length) == FAILURE)

        t = FAILURE;
 
       if (sym->as)
        t = FAILURE;
 
       if (sym->as)


@@ -4592,26 +4592,26 @@ gfc_resolve_character_operator (gfc_expr *e)
 
   gcc_assert (e->value.op.op == INTRINSIC_CONCAT);
 
 
   gcc_assert (e->value.op.op == INTRINSIC_CONCAT);
 

-  if (op1->ts.cl && op1->ts.cl->length)
-    e1 = gfc_copy_expr (op1->ts.cl->length);
+  if (op1->ts.u.cl && op1->ts.u.cl->length)
+    e1 = gfc_copy_expr (op1->ts.u.cl->length);

   else if (op1->expr_type == EXPR_CONSTANT)
     e1 = gfc_int_expr (op1->value.character.length);
 
   else if (op1->expr_type == EXPR_CONSTANT)
     e1 = gfc_int_expr (op1->value.character.length);
 

-  if (op2->ts.cl && op2->ts.cl->length)
-    e2 = gfc_copy_expr (op2->ts.cl->length);
+  if (op2->ts.u.cl && op2->ts.u.cl->length)
+    e2 = gfc_copy_expr (op2->ts.u.cl->length);

   else if (op2->expr_type == EXPR_CONSTANT)
     e2 = gfc_int_expr (op2->value.character.length);
 
   else if (op2->expr_type == EXPR_CONSTANT)
     e2 = gfc_int_expr (op2->value.character.length);
 

-  e->ts.cl = gfc_new_charlen (gfc_current_ns);
+  e->ts.u.cl = gfc_new_charlen (gfc_current_ns);

 
   if (!e1 || !e2)
     return;
 
 
   if (!e1 || !e2)
     return;
 

-  e->ts.cl->length = gfc_add (e1, e2);
-  e->ts.cl->length->ts.type = BT_INTEGER;
-  e->ts.cl->length->ts.kind = gfc_charlen_int_kind;
-  gfc_simplify_expr (e->ts.cl->length, 0);
-  gfc_resolve_expr (e->ts.cl->length);
+  e->ts.u.cl->length = gfc_add (e1, e2);
+  e->ts.u.cl->length->ts.type = BT_INTEGER;
+  e->ts.u.cl->length->ts.kind = gfc_charlen_int_kind;
+  gfc_simplify_expr (e->ts.u.cl->length, 0);
+  gfc_resolve_expr (e->ts.u.cl->length);

 
   return;
 }
 
   return;
 }


@@ -4636,12 +4636,12 @@ fixup_charlen (gfc_expr *e)
        gfc_resolve_character_array_constructor (e);
 
     case EXPR_SUBSTRING:
        gfc_resolve_character_array_constructor (e);
 
     case EXPR_SUBSTRING:

-      if (!e->ts.cl && e->ref)
+      if (!e->ts.u.cl && e->ref)

        gfc_resolve_substring_charlen (e);
 
     default:
        gfc_resolve_substring_charlen (e);
 
     default:

-      if (!e->ts.cl)
-       e->ts.cl = gfc_new_charlen (gfc_current_ns);
+      if (!e->ts.u.cl)
+       e->ts.u.cl = gfc_new_charlen (gfc_current_ns);

 
       break;
     }
 
       break;
     }


@@ -4817,10 +4817,10 @@ check_typebound_baseobject (gfc_expr* e)
     return FAILURE;
 
   gcc_assert (base->ts.type == BT_DERIVED);
     return FAILURE;
 
   gcc_assert (base->ts.type == BT_DERIVED);

-  if (base->ts.derived->attr.abstract)
+  if (base->ts.u.derived->attr.abstract)

     {
       gfc_error ("Base object for type-bound procedure call at %L is of"
     {
       gfc_error ("Base object for type-bound procedure call at %L is of"

-                " ABSTRACT type '%s'", &e->where, base->ts.derived->name);
+                " ABSTRACT type '%s'", &e->where, base->ts.u.derived->name);

       return FAILURE;
     }
 
       return FAILURE;
     }
 


@@ -5111,7 +5111,7 @@ gfc_resolve_expr (gfc_expr *e)
            expression_rank (e);
        }
 
            expression_rank (e);
        }
 

-      if (e->ts.type == BT_CHARACTER && e->ts.cl == NULL && e->ref
+      if (e->ts.type == BT_CHARACTER && e->ts.u.cl == NULL && e->ref

          && e->ref->type != REF_SUBSTRING)
        gfc_resolve_substring_charlen (e);
 
          && e->ref->type != REF_SUBSTRING)
        gfc_resolve_substring_charlen (e);
 


@@ -5171,7 +5171,7 @@ gfc_resolve_expr (gfc_expr *e)
       gfc_internal_error ("gfc_resolve_expr(): Bad expression type");
     }
 
       gfc_internal_error ("gfc_resolve_expr(): Bad expression type");
     }
 

-  if (e->ts.type == BT_CHARACTER && t == SUCCESS && !e->ts.cl)
+  if (e->ts.type == BT_CHARACTER && t == SUCCESS && !e->ts.u.cl)

     fixup_charlen (e);
 
   return t;
     fixup_charlen (e);
 
   return t;


@@ -5414,7 +5414,7 @@ derived_inaccessible (gfc_symbol *sym)
 
   for (c = sym->components; c; c = c->next)
     {
 
   for (c = sym->components; c; c = c->next)
     {

-       if (c->ts.type == BT_DERIVED && derived_inaccessible (c->ts.derived))
+       if (c->ts.type == BT_DERIVED && derived_inaccessible (c->ts.u.derived))

          return 1;
     }
 
          return 1;
     }
 


@@ -6344,21 +6344,21 @@ resolve_transfer (gfc_code *code)
     {
       /* Check that transferred derived type doesn't contain POINTER
         components.  */
     {
       /* Check that transferred derived type doesn't contain POINTER
         components.  */

-      if (ts->derived->attr.pointer_comp)
+      if (ts->u.derived->attr.pointer_comp)

        {
          gfc_error ("Data transfer element at %L cannot have "
                     "POINTER components", &code->loc);
          return;
        }
 
        {
          gfc_error ("Data transfer element at %L cannot have "
                     "POINTER components", &code->loc);
          return;
        }
 

-      if (ts->derived->attr.alloc_comp)
+      if (ts->u.derived->attr.alloc_comp)

        {
          gfc_error ("Data transfer element at %L cannot have "
                     "ALLOCATABLE components", &code->loc);
          return;
        }
 
        {
          gfc_error ("Data transfer element at %L cannot have "
                     "ALLOCATABLE components", &code->loc);
          return;
        }
 

-      if (derived_inaccessible (ts->derived))
+      if (derived_inaccessible (ts->u.derived))

        {
          gfc_error ("Data transfer element at %L cannot have "
                     "PRIVATE components",&code->loc);
        {
          gfc_error ("Data transfer element at %L cannot have "
                     "PRIVATE components",&code->loc);


@@ -6925,7 +6925,7 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
         and rhs is the same symbol as the lhs.  */
       if (rhs->expr_type == EXPR_VARIABLE
            && rhs->symtree->n.sym->ts.type == BT_DERIVED
         and rhs is the same symbol as the lhs.  */
       if (rhs->expr_type == EXPR_VARIABLE
            && rhs->symtree->n.sym->ts.type == BT_DERIVED

-           && has_default_initializer (rhs->symtree->n.sym->ts.derived)
+           && has_default_initializer (rhs->symtree->n.sym->ts.u.derived)

            && (lhs->symtree->n.sym == rhs->symtree->n.sym))
         code->ext.actual->next->expr = gfc_get_parentheses (rhs);
 
            && (lhs->symtree->n.sym == rhs->symtree->n.sym))
         code->ext.actual->next->expr = gfc_get_parentheses (rhs);
 


@@ -6974,18 +6974,18 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
   if (lhs->ts.type == BT_CHARACTER
        && gfc_option.warn_character_truncation)
     {
   if (lhs->ts.type == BT_CHARACTER
        && gfc_option.warn_character_truncation)
     {

-      if (lhs->ts.cl != NULL
-           && lhs->ts.cl->length != NULL
-           && lhs->ts.cl->length->expr_type == EXPR_CONSTANT)
-       llen = mpz_get_si (lhs->ts.cl->length->value.integer);
+      if (lhs->ts.u.cl != NULL
+           && lhs->ts.u.cl->length != NULL
+           && lhs->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+       llen = mpz_get_si (lhs->ts.u.cl->length->value.integer);

 
       if (rhs->expr_type == EXPR_CONSTANT)
        rlen = rhs->value.character.length;
 
 
       if (rhs->expr_type == EXPR_CONSTANT)
        rlen = rhs->value.character.length;
 

-      else if (rhs->ts.cl != NULL
-                && rhs->ts.cl->length != NULL
-                && rhs->ts.cl->length->expr_type == EXPR_CONSTANT)
-       rlen = mpz_get_si (rhs->ts.cl->length->value.integer);
+      else if (rhs->ts.u.cl != NULL
+                && rhs->ts.u.cl->length != NULL
+                && rhs->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+       rlen = mpz_get_si (rhs->ts.u.cl->length->value.integer);

 
       if (rlen && llen && rlen > llen)
        gfc_warning_now ("CHARACTER expression will be truncated "
 
       if (rlen && llen && rlen > llen)
        gfc_warning_now ("CHARACTER expression will be truncated "


@@ -7022,7 +7022,7 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
 
       if (lhs->ts.type == BT_DERIVED
            && lhs->expr_type == EXPR_VARIABLE
 
       if (lhs->ts.type == BT_DERIVED
            && lhs->expr_type == EXPR_VARIABLE

-           && lhs->ts.derived->attr.pointer_comp
+           && lhs->ts.u.derived->attr.pointer_comp

            && gfc_impure_variable (rhs->symtree->n.sym))
        {
          gfc_error ("The impure variable at %L is assigned to "
            && gfc_impure_variable (rhs->symtree->n.sym))
        {
          gfc_error ("The impure variable at %L is assigned to "


@@ -7716,7 +7716,7 @@ apply_default_init (gfc_symbol *sym)
   if (sym->attr.flavor != FL_VARIABLE && !sym->attr.function)
     return;
 
   if (sym->attr.flavor != FL_VARIABLE && !sym->attr.function)
     return;
 

-  if (sym->ts.type == BT_DERIVED && sym->ts.derived)
+  if (sym->ts.type == BT_DERIVED && sym->ts.u.derived)

     init = gfc_default_initializer (&sym->ts);
 
   if (init == NULL)
     init = gfc_default_initializer (&sym->ts);
 
   if (init == NULL)


@@ -7861,10 +7861,10 @@ build_default_init_expr (gfc_symbol *sym)
       /* For characters, the length must be constant in order to 
         create a default initializer.  */
       if (gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON
       /* For characters, the length must be constant in order to 
         create a default initializer.  */
       if (gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON

-         && sym->ts.cl->length
-         && sym->ts.cl->length->expr_type == EXPR_CONSTANT)
+         && sym->ts.u.cl->length
+         && sym->ts.u.cl->length->expr_type == EXPR_CONSTANT)

        {
        {

-         char_len = mpz_get_si (sym->ts.cl->length->value.integer);
+         char_len = mpz_get_si (sym->ts.u.cl->length->value.integer);

          init_expr->value.character.length = char_len;
          init_expr->value.character.string = gfc_get_wide_string (char_len+1);
          for (i = 0; i < char_len; i++)
          init_expr->value.character.length = char_len;
          init_expr->value.character.string = gfc_get_wide_string (char_len+1);
          for (i = 0; i < char_len; i++)


@@ -7977,17 +7977,17 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag)
      associated by the presence of another class I symbol in the same
      namespace.  14.6.1.3 of the standard and the discussion on
      comp.lang.fortran.  */
      associated by the presence of another class I symbol in the same
      namespace.  14.6.1.3 of the standard and the discussion on
      comp.lang.fortran.  */

-  if (sym->ns != sym->ts.derived->ns
+  if (sym->ns != sym->ts.u.derived->ns

       && sym->ns->proc_name->attr.if_source != IFSRC_IFBODY)
     {
       gfc_symbol *s;
       && sym->ns->proc_name->attr.if_source != IFSRC_IFBODY)
     {
       gfc_symbol *s;

-      gfc_find_symbol (sym->ts.derived->name, sym->ns, 0, &s);
+      gfc_find_symbol (sym->ts.u.derived->name, sym->ns, 0, &s);

       if (s && s->attr.flavor != FL_DERIVED)
        {
          gfc_error ("The type '%s' cannot be host associated at %L "
                     "because it is blocked by an incompatible object "
                     "of the same name declared at %L",
       if (s && s->attr.flavor != FL_DERIVED)
        {
          gfc_error ("The type '%s' cannot be host associated at %L "
                     "because it is blocked by an incompatible object "
                     "of the same name declared at %L",

-                    sym->ts.derived->name, &sym->declared_at,
+                    sym->ts.u.derived->name, &sym->declared_at,

                     &s->declared_at);
          return FAILURE;
        }
                     &s->declared_at);
          return FAILURE;
        }


@@ -8005,7 +8005,7 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag)
       && sym->ns->proc_name->attr.flavor == FL_MODULE
       && !sym->ns->save_all && !sym->attr.save
       && !sym->attr.pointer && !sym->attr.allocatable
       && sym->ns->proc_name->attr.flavor == FL_MODULE
       && !sym->ns->save_all && !sym->attr.save
       && !sym->attr.pointer && !sym->attr.allocatable

-      && has_default_initializer (sym->ts.derived))
+      && has_default_initializer (sym->ts.u.derived))

     {
       gfc_error("Object '%s' at %L must have the SAVE attribute for "
                "default initialization of a component",
     {
       gfc_error("Object '%s' at %L must have the SAVE attribute for "
                "default initialization of a component",


@@ -8016,10 +8016,10 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag)
   if (sym->ts.is_class)
     {
       /* C502.  */
   if (sym->ts.is_class)
     {
       /* C502.  */

-      if (!type_is_extensible (sym->ts.derived))
+      if (!type_is_extensible (sym->ts.u.derived))

        {
          gfc_error ("Type '%s' of CLASS variable '%s' at %L is not extensible",
        {
          gfc_error ("Type '%s' of CLASS variable '%s' at %L is not extensible",

-                    sym->ts.derived->name, sym->name, &sym->declared_at);
+                    sym->ts.u.derived->name, sym->name, &sym->declared_at);

          return FAILURE;
        }
 
          return FAILURE;
        }
 


@@ -8083,7 +8083,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
     {
       /* Make sure that character string variables with assumed length are
         dummy arguments.  */
     {
       /* Make sure that character string variables with assumed length are
         dummy arguments.  */

-      e = sym->ts.cl->length;
+      e = sym->ts.u.cl->length;

       if (e == NULL && !sym->attr.dummy && !sym->attr.result)
        {
          gfc_error ("Entity with assumed character length at %L must be a "
       if (e == NULL && !sym->attr.dummy && !sym->attr.result)
        {
          gfc_error ("Entity with assumed character length at %L must be a "


@@ -8189,7 +8189,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
 
   if (sym->ts.type == BT_CHARACTER)
     {
 
   if (sym->ts.type == BT_CHARACTER)
     {

-      gfc_charlen *cl = sym->ts.cl;
+      gfc_charlen *cl = sym->ts.u.cl;

 
       if (cl && cl->length && gfc_is_constant_expr (cl->length)
             && resolve_charlen (cl) == FAILURE)
 
       if (cl && cl->length && gfc_is_constant_expr (cl->length)
             && resolve_charlen (cl) == FAILURE)


@@ -8229,9 +8229,9 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
        {
          if (arg->sym
              && arg->sym->ts.type == BT_DERIVED
        {
          if (arg->sym
              && arg->sym->ts.type == BT_DERIVED

-             && !arg->sym->ts.derived->attr.use_assoc
-             && !gfc_check_access (arg->sym->ts.derived->attr.access,
-                                   arg->sym->ts.derived->ns->default_access)
+             && !arg->sym->ts.u.derived->attr.use_assoc
+             && !gfc_check_access (arg->sym->ts.u.derived->attr.access,
+                                   arg->sym->ts.u.derived->ns->default_access)

              && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' is of a "
                                 "PRIVATE type and cannot be a dummy argument"
                                 " of '%s', which is PUBLIC at %L",
              && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' is of a "
                                 "PRIVATE type and cannot be a dummy argument"
                                 " of '%s', which is PUBLIC at %L",


@@ -8239,7 +8239,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
                 == FAILURE)
            {
              /* Stop this message from recurring.  */
                 == FAILURE)
            {
              /* Stop this message from recurring.  */

-             arg->sym->ts.derived->attr.access = ACCESS_PUBLIC;
+             arg->sym->ts.u.derived->attr.access = ACCESS_PUBLIC;

              return FAILURE;
            }
        }
              return FAILURE;
            }
        }


@@ -8252,9 +8252,9 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
            {
              if (arg->sym
                  && arg->sym->ts.type == BT_DERIVED
            {
              if (arg->sym
                  && arg->sym->ts.type == BT_DERIVED

-                 && !arg->sym->ts.derived->attr.use_assoc
-                 && !gfc_check_access (arg->sym->ts.derived->attr.access,
-                                       arg->sym->ts.derived->ns->default_access)
+                 && !arg->sym->ts.u.derived->attr.use_assoc
+                 && !gfc_check_access (arg->sym->ts.u.derived->attr.access,
+                                       arg->sym->ts.u.derived->ns->default_access)

                  && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Procedure "
                                     "'%s' in PUBLIC interface '%s' at %L "
                                     "takes dummy arguments of '%s' which is "
                  && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Procedure "
                                     "'%s' in PUBLIC interface '%s' at %L "
                                     "takes dummy arguments of '%s' which is "


@@ -8263,7 +8263,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
                                     gfc_typename (&arg->sym->ts)) == FAILURE)
                {
                  /* Stop this message from recurring.  */
                                     gfc_typename (&arg->sym->ts)) == FAILURE)
                {
                  /* Stop this message from recurring.  */

-                 arg->sym->ts.derived->attr.access = ACCESS_PUBLIC;
+                 arg->sym->ts.u.derived->attr.access = ACCESS_PUBLIC;

                  return FAILURE;
                }
             }
                  return FAILURE;
                }
             }


@@ -8277,9 +8277,9 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
            {
              if (arg->sym
                  && arg->sym->ts.type == BT_DERIVED
            {
              if (arg->sym
                  && arg->sym->ts.type == BT_DERIVED

-                 && !arg->sym->ts.derived->attr.use_assoc
-                 && !gfc_check_access (arg->sym->ts.derived->attr.access,
-                                       arg->sym->ts.derived->ns->default_access)
+                 && !arg->sym->ts.u.derived->attr.use_assoc
+                 && !gfc_check_access (arg->sym->ts.u.derived->attr.access,
+                                       arg->sym->ts.u.derived->ns->default_access)

                  && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Procedure "
                                     "'%s' in PUBLIC interface '%s' at %L "
                                     "takes dummy arguments of '%s' which is "
                  && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Procedure "
                                     "'%s' in PUBLIC interface '%s' at %L "
                                     "takes dummy arguments of '%s' which is "


@@ -8288,7 +8288,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
                                     gfc_typename (&arg->sym->ts)) == FAILURE)
                {
                  /* Stop this message from recurring.  */
                                     gfc_typename (&arg->sym->ts)) == FAILURE)
                {
                  /* Stop this message from recurring.  */

-                 arg->sym->ts.derived->attr.access = ACCESS_PUBLIC;
+                 arg->sym->ts.u.derived->attr.access = ACCESS_PUBLIC;

                  return FAILURE;
                }
             }
                  return FAILURE;
                }
             }


@@ -8330,7 +8330,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
      function - but length must be declared in calling scoping unit.  */
   if (sym->attr.function
       && sym->ts.type == BT_CHARACTER
      function - but length must be declared in calling scoping unit.  */
   if (sym->attr.function
       && sym->ts.type == BT_CHARACTER

-      && sym->ts.cl && sym->ts.cl->length == NULL)
+      && sym->ts.u.cl && sym->ts.u.cl->length == NULL)

     {
       if ((sym->as && sym->as->rank) || (sym->attr.pointer)
          || (sym->attr.recursive) || (sym->attr.pure))
     {
       if ((sym->as && sym->as->rank) || (sym->attr.pointer)
          || (sym->attr.recursive) || (sym->attr.pure))


@@ -8499,7 +8499,7 @@ gfc_resolve_finalizers (gfc_symbol* derived)
       arg = list->proc_sym->formal->sym;
 
       /* This argument must be of our type.  */
       arg = list->proc_sym->formal->sym;
 
       /* This argument must be of our type.  */

-      if (arg->ts.type != BT_DERIVED || arg->ts.derived != derived)
+      if (arg->ts.type != BT_DERIVED || arg->ts.u.derived != derived)

        {
          gfc_error ("Argument of FINAL procedure at %L must be of type '%s'",
                     &arg->declared_at, derived->name);
        {
          gfc_error ("Argument of FINAL procedure at %L must be of type '%s'",
                     &arg->declared_at, derived->name);


@@ -9181,7 +9181,7 @@ resolve_typebound_procedure (gfc_symtree* stree)
       /* Now check that the argument-type matches.  */
       gcc_assert (me_arg);
       if (me_arg->ts.type != BT_DERIVED
       /* Now check that the argument-type matches.  */
       gcc_assert (me_arg);
       if (me_arg->ts.type != BT_DERIVED

-         || me_arg->ts.derived != resolve_bindings_derived)
+         || me_arg->ts.u.derived != resolve_bindings_derived)

        {
          gfc_error ("Argument '%s' of '%s' with PASS(%s) at %L must be of"
                     " the derived-type '%s'", me_arg->name, proc->name,
        {
          gfc_error ("Argument '%s' of '%s' with PASS(%s) at %L must be of"
                     " the derived-type '%s'", me_arg->name, proc->name,


@@ -9450,12 +9450,12 @@ resolve_fl_derived (gfc_symbol *sym)
                    }
                }
              /* Copy char length.  */
                    }
                }
              /* Copy char length.  */

-             if (ifc->ts.cl)
+             if (ifc->ts.type == BT_CHARACTER && ifc->ts.u.cl)

                {
                {

-                 c->ts.cl = gfc_new_charlen (sym->ns);
-                 c->ts.cl->resolved = ifc->ts.cl->resolved;
-                 c->ts.cl->length = gfc_copy_expr (ifc->ts.cl->length);
-                 /* TODO: gfc_expr_replace_symbols (c->ts.cl->length, c);*/
+                 c->ts.u.cl = gfc_new_charlen (sym->ns);
+                 c->ts.u.cl->resolved = ifc->ts.u.cl->resolved;
+                 c->ts.u.cl->length = gfc_copy_expr (ifc->ts.u.cl->length);
+                 /* TODO: gfc_expr_replace_symbols (c->ts.u.cl->length, c);*/

                }
            }
          else if (c->ts.interface->name[0] != '\0')
                }
            }
          else if (c->ts.interface->name[0] != '\0')


@@ -9524,7 +9524,7 @@ resolve_fl_derived (gfc_symbol *sym)
          /* Now check that the argument-type matches.  */
          gcc_assert (me_arg);
          if (me_arg->ts.type != BT_DERIVED
          /* Now check that the argument-type matches.  */
          gcc_assert (me_arg);
          if (me_arg->ts.type != BT_DERIVED

-             || me_arg->ts.derived != sym)
+             || me_arg->ts.u.derived != sym)

            {
              gfc_error ("Argument '%s' of '%s' with PASS(%s) at %L must be of"
                         " the derived type '%s'", me_arg->name, c->name,
            {
              gfc_error ("Argument '%s' of '%s' with PASS(%s) at %L must be of"
                         " the derived type '%s'", me_arg->name, c->name,


@@ -9585,14 +9585,14 @@ resolve_fl_derived (gfc_symbol *sym)
 
       if (c->ts.type == BT_CHARACTER)
        {
 
       if (c->ts.type == BT_CHARACTER)
        {

-        if (c->ts.cl->length == NULL
-            || (resolve_charlen (c->ts.cl) == FAILURE)
-            || !gfc_is_constant_expr (c->ts.cl->length))
+        if (c->ts.u.cl->length == NULL
+            || (resolve_charlen (c->ts.u.cl) == FAILURE)
+            || !gfc_is_constant_expr (c->ts.u.cl->length))

           {
             gfc_error ("Character length of component '%s' needs to "
                        "be a constant specification expression at %L",
                        c->name,
           {
             gfc_error ("Character length of component '%s' needs to "
                        "be a constant specification expression at %L",
                        c->name,

-                       c->ts.cl->length ? &c->ts.cl->length->where : &c->loc);
+                       c->ts.u.cl->length ? &c->ts.u.cl->length->where : &c->loc);

             return FAILURE;
           }
        }
             return FAILURE;
           }
        }


@@ -9600,10 +9600,10 @@ resolve_fl_derived (gfc_symbol *sym)
       if (c->ts.type == BT_DERIVED
          && sym->component_access != ACCESS_PRIVATE
          && gfc_check_access (sym->attr.access, sym->ns->default_access)
       if (c->ts.type == BT_DERIVED
          && sym->component_access != ACCESS_PRIVATE
          && gfc_check_access (sym->attr.access, sym->ns->default_access)

-         && !is_sym_host_assoc (c->ts.derived, sym->ns)
-         && !c->ts.derived->attr.use_assoc
-         && !gfc_check_access (c->ts.derived->attr.access,
-                               c->ts.derived->ns->default_access)
+         && !is_sym_host_assoc (c->ts.u.derived, sym->ns)
+         && !c->ts.u.derived->attr.use_assoc
+         && !gfc_check_access (c->ts.u.derived->attr.access,
+                               c->ts.u.derived->ns->default_access)

          && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: the component '%s' "
                             "is a PRIVATE type and cannot be a component of "
                             "'%s', which is PUBLIC at %L", c->name,
          && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: the component '%s' "
                             "is a PRIVATE type and cannot be a component of "
                             "'%s', which is PUBLIC at %L", c->name,


@@ -9612,18 +9612,18 @@ resolve_fl_derived (gfc_symbol *sym)
 
       if (sym->attr.sequence)
        {
 
       if (sym->attr.sequence)
        {

-         if (c->ts.type == BT_DERIVED && c->ts.derived->attr.sequence == 0)
+         if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.sequence == 0)

            {
              gfc_error ("Component %s of SEQUENCE type declared at %L does "
                         "not have the SEQUENCE attribute",
            {
              gfc_error ("Component %s of SEQUENCE type declared at %L does "
                         "not have the SEQUENCE attribute",

-                        c->ts.derived->name, &sym->declared_at);
+                        c->ts.u.derived->name, &sym->declared_at);

              return FAILURE;
            }
        }
 
       if (c->ts.type == BT_DERIVED && c->attr.pointer
              return FAILURE;
            }
        }
 
       if (c->ts.type == BT_DERIVED && c->attr.pointer

-         && c->ts.derived->components == NULL
-         && !c->ts.derived->attr.zero_comp)
+         && c->ts.u.derived->components == NULL
+         && !c->ts.u.derived->attr.zero_comp)

        {
          gfc_error ("The pointer component '%s' of '%s' at %L is a type "
                     "that has not been declared", c->name, sym->name,
        {
          gfc_error ("The pointer component '%s' of '%s' at %L is a type "
                     "that has not been declared", c->name, sym->name,


@@ -9644,11 +9644,11 @@ resolve_fl_derived (gfc_symbol *sym)
         derived type list; even in formal namespaces, where derived type
         pointer components might not have been declared.  */
       if (c->ts.type == BT_DERIVED
         derived type list; even in formal namespaces, where derived type
         pointer components might not have been declared.  */
       if (c->ts.type == BT_DERIVED

-           && c->ts.derived
-           && c->ts.derived->components
+           && c->ts.u.derived
+           && c->ts.u.derived->components

            && c->attr.pointer
            && c->attr.pointer

-           && sym != c->ts.derived)
-       add_dt_to_dt_list (c->ts.derived);
+           && sym != c->ts.u.derived)
+       add_dt_to_dt_list (c->ts.u.derived);

 
       if (c->attr.pointer || c->attr.proc_pointer || c->attr.allocatable
          || c->as == NULL)
 
       if (c->attr.pointer || c->attr.proc_pointer || c->attr.allocatable
          || c->as == NULL)


@@ -9716,7 +9716,7 @@ resolve_fl_namelist (gfc_symbol *sym)
 
          /* Types with private components that came here by USE-association.  */
          if (nl->sym->ts.type == BT_DERIVED
 
          /* Types with private components that came here by USE-association.  */
          if (nl->sym->ts.type == BT_DERIVED

-             && derived_inaccessible (nl->sym->ts.derived))
+             && derived_inaccessible (nl->sym->ts.u.derived))

            {
              gfc_error ("NAMELIST object '%s' has use-associated PRIVATE "
                         "components and cannot be member of namelist '%s' at %L",
            {
              gfc_error ("NAMELIST object '%s' has use-associated PRIVATE "
                         "components and cannot be member of namelist '%s' at %L",


@@ -9726,8 +9726,8 @@ resolve_fl_namelist (gfc_symbol *sym)
 
          /* Types with private components that are defined in the same module.  */
          if (nl->sym->ts.type == BT_DERIVED
 
          /* Types with private components that are defined in the same module.  */
          if (nl->sym->ts.type == BT_DERIVED

-             && !is_sym_host_assoc (nl->sym->ts.derived, sym->ns)
-             && !gfc_check_access (nl->sym->ts.derived->attr.private_comp
+             && !is_sym_host_assoc (nl->sym->ts.u.derived, sym->ns)
+             && !gfc_check_access (nl->sym->ts.u.derived->attr.private_comp

                                        ? ACCESS_PRIVATE : ACCESS_UNKNOWN,
                                        nl->sym->ns->default_access))
            {
                                        ? ACCESS_PRIVATE : ACCESS_UNKNOWN,
                                        nl->sym->ns->default_access))
            {


@@ -9762,7 +9762,7 @@ resolve_fl_namelist (gfc_symbol *sym)
       if (nl->sym->ts.type != BT_DERIVED)
        continue;
 
       if (nl->sym->ts.type != BT_DERIVED)
        continue;
 

-      if (nl->sym->ts.derived->attr.alloc_comp)
+      if (nl->sym->ts.u.derived->attr.alloc_comp)

        {
          gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot "
                     "have ALLOCATABLE components",
        {
          gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot "
                     "have ALLOCATABLE components",


@@ -9770,7 +9770,7 @@ resolve_fl_namelist (gfc_symbol *sym)
          return FAILURE;
        }
 
          return FAILURE;
        }
 

-      if (nl->sym->ts.derived->attr.pointer_comp)
+      if (nl->sym->ts.u.derived->attr.pointer_comp)

        {
          gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot "
                     "have POINTER components", 
        {
          gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot "
                     "have POINTER components", 


@@ -9954,12 +9954,12 @@ resolve_symbol (gfc_symbol *sym)
                }
            }
          /* Copy char length.  */
                }
            }
          /* Copy char length.  */

-         if (ifc->ts.cl)
+         if (ifc->ts.type == BT_CHARACTER && ifc->ts.u.cl)

            {
            {

-             sym->ts.cl = gfc_new_charlen (sym->ns);
-             sym->ts.cl->resolved = ifc->ts.cl->resolved;
-             sym->ts.cl->length = gfc_copy_expr (ifc->ts.cl->length);
-             gfc_expr_replace_symbols (sym->ts.cl->length, sym);
+             sym->ts.u.cl = gfc_new_charlen (sym->ns);
+             sym->ts.u.cl->resolved = ifc->ts.u.cl->resolved;
+             sym->ts.u.cl->length = gfc_copy_expr (ifc->ts.u.cl->length);
+             gfc_expr_replace_symbols (sym->ts.u.cl->length, sym);

            }
        }
       else if (sym->ts.interface->name[0] != '\0')
            }
        }
       else if (sym->ts.interface->name[0] != '\0')


@@ -10059,7 +10059,7 @@ resolve_symbol (gfc_symbol *sym)
 
   if (sym->attr.value && sym->ts.type == BT_CHARACTER)
     {
 
   if (sym->attr.value && sym->ts.type == BT_CHARACTER)
     {

-      gfc_charlen *cl = sym->ts.cl;
+      gfc_charlen *cl = sym->ts.u.cl;

       if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT)
        {
          gfc_error ("Character dummy variable '%s' at %L with VALUE "
       if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT)
        {
          gfc_error ("Character dummy variable '%s' at %L with VALUE "


@@ -10111,14 +10111,14 @@ resolve_symbol (gfc_symbol *sym)
          /* If type() declaration, we need to verify that the components
             of the given type are all C interoperable, etc.  */
          if (sym->ts.type == BT_DERIVED &&
          /* If type() declaration, we need to verify that the components
             of the given type are all C interoperable, etc.  */
          if (sym->ts.type == BT_DERIVED &&

-              sym->ts.derived->attr.is_c_interop != 1)
+              sym->ts.u.derived->attr.is_c_interop != 1)

             {
               /* Make sure the user marked the derived type as BIND(C).  If
                  not, call the verify routine.  This could print an error
                  for the derived type more than once if multiple variables
                  of that type are declared.  */
             {
               /* Make sure the user marked the derived type as BIND(C).  If
                  not, call the verify routine.  This could print an error
                  for the derived type more than once if multiple variables
                  of that type are declared.  */

-              if (sym->ts.derived->attr.is_bind_c != 1)
-                verify_bind_c_derived_type (sym->ts.derived);
+              if (sym->ts.u.derived->attr.is_bind_c != 1)
+                verify_bind_c_derived_type (sym->ts.u.derived);

               t = FAILURE;
             }
          
               t = FAILURE;
             }
          


@@ -10147,12 +10147,12 @@ resolve_symbol (gfc_symbol *sym)
      the type is not declared in the scope of the implicit
      statement. Change the type to BT_UNKNOWN, both because it is so
      and to prevent an ICE.  */
      the type is not declared in the scope of the implicit
      statement. Change the type to BT_UNKNOWN, both because it is so
      and to prevent an ICE.  */

-  if (sym->ts.type == BT_DERIVED && sym->ts.derived->components == NULL
-      && !sym->ts.derived->attr.zero_comp)
+  if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->components == NULL
+      && !sym->ts.u.derived->attr.zero_comp)

     {
       gfc_error ("The derived type '%s' at %L is of type '%s', "
                 "which has not been defined", sym->name,
     {
       gfc_error ("The derived type '%s' at %L is of type '%s', "
                 "which has not been defined", sym->name,

-                 &sym->declared_at, sym->ts.derived->name);
+                 &sym->declared_at, sym->ts.u.derived->name);

       sym->ts.type = BT_UNKNOWN;
       return;
     }
       sym->ts.type = BT_UNKNOWN;
       return;
     }


@@ -10161,23 +10161,23 @@ resolve_symbol (gfc_symbol *sym)
      derived type is visible in the symbol's namespace, if it is a
      module function and is not PRIVATE.  */
   if (sym->ts.type == BT_DERIVED
      derived type is visible in the symbol's namespace, if it is a
      module function and is not PRIVATE.  */
   if (sym->ts.type == BT_DERIVED

-       && sym->ts.derived->attr.use_assoc
+       && sym->ts.u.derived->attr.use_assoc

        && sym->ns->proc_name
        && sym->ns->proc_name->attr.flavor == FL_MODULE)
     {
       gfc_symbol *ds;
 
        && sym->ns->proc_name
        && sym->ns->proc_name->attr.flavor == FL_MODULE)
     {
       gfc_symbol *ds;
 

-      if (resolve_fl_derived (sym->ts.derived) == FAILURE)
+      if (resolve_fl_derived (sym->ts.u.derived) == FAILURE)

        return;
 
        return;
 

-      gfc_find_symbol (sym->ts.derived->name, sym->ns, 1, &ds);
+      gfc_find_symbol (sym->ts.u.derived->name, sym->ns, 1, &ds);

       if (!ds && sym->attr.function
            && gfc_check_access (sym->attr.access, sym->ns->default_access))
        {
          symtree = gfc_new_symtree (&sym->ns->sym_root,
       if (!ds && sym->attr.function
            && gfc_check_access (sym->attr.access, sym->ns->default_access))
        {
          symtree = gfc_new_symtree (&sym->ns->sym_root,

-                                    sym->ts.derived->name);
-         symtree->n.sym = sym->ts.derived;
-         sym->ts.derived->refs++;
+                                    sym->ts.u.derived->name);
+         symtree->n.sym = sym->ts.u.derived;
+         sym->ts.u.derived->refs++;

        }
     }
 
        }
     }
 


@@ -10187,15 +10187,15 @@ resolve_symbol (gfc_symbol *sym)
      161 in 95-006r3.  */
   if (sym->ts.type == BT_DERIVED
       && sym->ns->proc_name && sym->ns->proc_name->attr.flavor == FL_MODULE
      161 in 95-006r3.  */
   if (sym->ts.type == BT_DERIVED
       && sym->ns->proc_name && sym->ns->proc_name->attr.flavor == FL_MODULE

-      && !sym->ts.derived->attr.use_assoc
+      && !sym->ts.u.derived->attr.use_assoc

       && gfc_check_access (sym->attr.access, sym->ns->default_access)
       && gfc_check_access (sym->attr.access, sym->ns->default_access)

-      && !gfc_check_access (sym->ts.derived->attr.access,
-                           sym->ts.derived->ns->default_access)
+      && !gfc_check_access (sym->ts.u.derived->attr.access,
+                           sym->ts.u.derived->ns->default_access)

       && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PUBLIC %s '%s' at %L "
                         "of PRIVATE derived type '%s'",
                         (sym->attr.flavor == FL_PARAMETER) ? "parameter"
                         : "variable", sym->name, &sym->declared_at,
       && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PUBLIC %s '%s' at %L "
                         "of PRIVATE derived type '%s'",
                         (sym->attr.flavor == FL_PARAMETER) ? "parameter"
                         : "variable", sym->name, &sym->declared_at,

-                        sym->ts.derived->name) == FAILURE)
+                        sym->ts.u.derived->name) == FAILURE)

     return;
 
   /* An assumed-size array with INTENT(OUT) shall not be of a type for which
     return;
 
   /* An assumed-size array with INTENT(OUT) shall not be of a type for which


@@ -10206,7 +10206,7 @@ resolve_symbol (gfc_symbol *sym)
       && sym->as
       && sym->as->type == AS_ASSUMED_SIZE)
     {
       && sym->as
       && sym->as->type == AS_ASSUMED_SIZE)
     {

-      for (c = sym->ts.derived->components; c; c = c->next)
+      for (c = sym->ts.u.derived->components; c; c = c->next)

        {
          if (c->initializer)
            {
        {
          if (c->initializer)
            {


@@ -10810,11 +10810,11 @@ sequence_type (gfc_typespec ts)
   {
     case BT_DERIVED:
 
   {
     case BT_DERIVED:
 

-      if (ts.derived->components == NULL)
+      if (ts.u.derived->components == NULL)

        return SEQ_NONDEFAULT;
 
        return SEQ_NONDEFAULT;
 

-      result = sequence_type (ts.derived->components->ts);
-      for (c = ts.derived->components->next; c; c = c->next)
+      result = sequence_type (ts.u.derived->components->ts);
+      for (c = ts.u.derived->components->next; c; c = c->next)

        if (sequence_type (c->ts) != result)
          return SEQ_MIXED;
 
        if (sequence_type (c->ts) != result)
          return SEQ_MIXED;
 


@@ -10862,7 +10862,6 @@ sequence_type (gfc_typespec ts)
 static gfc_try
 resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e)
 {
 static gfc_try
 resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e)
 {

-  gfc_symbol *d;

   gfc_component *c = derived->components;
 
   if (!derived)
   gfc_component *c = derived->components;
 
   if (!derived)


@@ -10886,7 +10885,7 @@ resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e)
       return FAILURE;
     }
 
       return FAILURE;
     }
 

-  if (sym->attr.in_common && has_default_initializer (sym->ts.derived))
+  if (sym->attr.in_common && has_default_initializer (sym->ts.u.derived))

     {
       gfc_error ("Derived type variable '%s' at %L with default "
                 "initialization cannot be in EQUIVALENCE with a variable "
     {
       gfc_error ("Derived type variable '%s' at %L with default "
                 "initialization cannot be in EQUIVALENCE with a variable "


@@ -10896,9 +10895,8 @@ resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e)
 
   for (; c ; c = c->next)
     {
 
   for (; c ; c = c->next)
     {

-      d = c->ts.derived;
-      if (d
-         && (resolve_equivalence_derived (c->ts.derived, sym, e) == FAILURE))
+      if (c->ts.type == BT_DERIVED
+         && (resolve_equivalence_derived (c->ts.u.derived, sym, e) == FAILURE))

        return FAILURE;
 
       /* Shall not be an object of sequence derived type containing a pointer
        return FAILURE;
 
       /* Shall not be an object of sequence derived type containing a pointer


@@ -10932,7 +10930,6 @@ static void
 resolve_equivalence (gfc_equiv *eq)
 {
   gfc_symbol *sym;
 resolve_equivalence (gfc_equiv *eq)
 {
   gfc_symbol *sym;

-  gfc_symbol *derived;

   gfc_symbol *first_sym;
   gfc_expr *e;
   gfc_ref *r;
   gfc_symbol *first_sym;
   gfc_expr *e;
   gfc_ref *r;


@@ -10996,11 +10993,11 @@ resolve_equivalence (gfc_equiv *eq)
                  if (start == NULL)
                    start = gfc_int_expr (1);
                  ref->u.ss.start = start;
                  if (start == NULL)
                    start = gfc_int_expr (1);
                  ref->u.ss.start = start;

-                 if (end == NULL && e->ts.cl)
-                   end = gfc_copy_expr (e->ts.cl->length);
+                 if (end == NULL && e->ts.u.cl)
+                   end = gfc_copy_expr (e->ts.u.cl->length);

                  ref->u.ss.end = end;
                  ref->u.ss.end = end;

-                 ref->u.ss.length = e->ts.cl;
-                 e->ts.cl = NULL;
+                 ref->u.ss.length = e->ts.u.cl;
+                 e->ts.u.cl = NULL;

                }
              ref = ref->next;
              gfc_free (mem);
                }
              ref = ref->next;
              gfc_free (mem);


@@ -11051,8 +11048,8 @@ resolve_equivalence (gfc_equiv *eq)
          continue;
        }
 
          continue;
        }
 

-      derived = e->ts.derived;
-      if (derived && resolve_equivalence_derived (derived, sym, e) == FAILURE)
+      if (e->ts.type == BT_DERIVED
+         && resolve_equivalence_derived (e->ts.u.derived, sym, e) == FAILURE)

        continue;
 
       /* Check that the types correspond correctly:
        continue;
 
       /* Check that the types correspond correctly:


@@ -11185,15 +11182,15 @@ resolve_fntype (gfc_namespace *ns)
       sym->attr.untyped = 1;
     }
 
       sym->attr.untyped = 1;
     }
 

-  if (sym->ts.type == BT_DERIVED && !sym->ts.derived->attr.use_assoc
+  if (sym->ts.type == BT_DERIVED && !sym->ts.u.derived->attr.use_assoc

       && !sym->attr.contained
       && !sym->attr.contained

-      && !gfc_check_access (sym->ts.derived->attr.access,
-                           sym->ts.derived->ns->default_access)
+      && !gfc_check_access (sym->ts.u.derived->attr.access,
+                           sym->ts.u.derived->ns->default_access)

       && gfc_check_access (sym->attr.access, sym->ns->default_access))
     {
       gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PUBLIC function '%s' at "
                      "%L of PRIVATE type '%s'", sym->name,
       && gfc_check_access (sym->attr.access, sym->ns->default_access))
     {
       gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PUBLIC function '%s' at "
                      "%L of PRIVATE type '%s'", sym->name,

-                     &sym->declared_at, sym->ts.derived->name);
+                     &sym->declared_at, sym->ts.u.derived->name);

     }
 
     if (ns->entries)
     }
 
     if (ns->entries)


@@ -11227,9 +11224,9 @@ check_uop_procedure (gfc_symbol *sym, locus where)
     }
 
   if (sym->ts.type == BT_CHARACTER
     }
 
   if (sym->ts.type == BT_CHARACTER

-      && !(sym->ts.cl && sym->ts.cl->length)
-      && !(sym->result && sym->result->ts.cl
-          && sym->result->ts.cl->length))
+      && !(sym->ts.u.cl && sym->ts.u.cl->length)
+      && !(sym->result && sym->result->ts.u.cl
+          && sym->result->ts.u.cl->length))

     {
       gfc_error ("User operator procedure '%s' at %L cannot be assumed "
                 "character length", sym->name, &where);
     {
       gfc_error ("User operator procedure '%s' at %L cannot be assumed "
                 "character length", sym->name, &where);

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index fa8a32a..fbb88a4 100644 (file)
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -3217,12 +3217,12 @@ gfc_simplify_len (gfc_expr *e, gfc_expr *kind)
        }
     }
 
        }
     }
 

-  if (e->ts.cl != NULL && e->ts.cl->length != NULL
-      && e->ts.cl->length->expr_type == EXPR_CONSTANT
-      && e->ts.cl->length->ts.type == BT_INTEGER)
+  if (e->ts.u.cl != NULL && e->ts.u.cl->length != NULL
+      && e->ts.u.cl->length->expr_type == EXPR_CONSTANT
+      && e->ts.u.cl->length->ts.type == BT_INTEGER)

     {
       result = gfc_constant_result (BT_INTEGER, k, &e->where);
     {
       result = gfc_constant_result (BT_INTEGER, k, &e->where);

-      mpz_set (result->value.integer, e->ts.cl->length->value.integer);
+      mpz_set (result->value.integer, e->ts.u.cl->length->value.integer);

       if (gfc_range_check (result) == ARITH_OK)
        return result;
       else
       if (gfc_range_check (result) == ARITH_OK)
        return result;
       else


@@ -4102,7 +4102,7 @@ gfc_simplify_pack (gfc_expr *array, gfc_expr *mask, gfc_expr *vector)
   gfc_array_size (result, &result->shape[0]);
 
   if (array->ts.type == BT_CHARACTER)
   gfc_array_size (result, &result->shape[0]);
 
   if (array->ts.type == BT_CHARACTER)

-    result->ts.cl = array->ts.cl;
+    result->ts.u.cl = array->ts.u.cl;

 
   return result;
 }
 
   return result;
 }


@@ -4300,14 +4300,14 @@ gfc_simplify_repeat (gfc_expr *e, gfc_expr *n)
     }
 
   /* If we don't know the character length, we can do no more.  */
     }
 
   /* If we don't know the character length, we can do no more.  */

-  if (e->ts.cl && e->ts.cl->length
-       && e->ts.cl->length->expr_type == EXPR_CONSTANT)
+  if (e->ts.u.cl && e->ts.u.cl->length
+       && e->ts.u.cl->length->expr_type == EXPR_CONSTANT)

     {
     {

-      len = mpz_get_si (e->ts.cl->length->value.integer);
+      len = mpz_get_si (e->ts.u.cl->length->value.integer);

       have_length = true;
     }
   else if (e->expr_type == EXPR_CONSTANT
       have_length = true;
     }
   else if (e->expr_type == EXPR_CONSTANT

-            && (e->ts.cl == NULL || e->ts.cl->length == NULL))
+            && (e->ts.u.cl == NULL || e->ts.u.cl->length == NULL))

     {
       len = e->value.character.length;
     }
     {
       len = e->value.character.length;
     }


@@ -4335,7 +4335,7 @@ gfc_simplify_repeat (gfc_expr *e, gfc_expr *n)
       if (have_length)
        {
          mpz_tdiv_q (max, gfc_integer_kinds[i].huge,
       if (have_length)
        {
          mpz_tdiv_q (max, gfc_integer_kinds[i].huge,

-                     e->ts.cl->length->value.integer);
+                     e->ts.u.cl->length->value.integer);

        }
       else
        {
        }
       else
        {


@@ -4364,8 +4364,8 @@ gfc_simplify_repeat (gfc_expr *e, gfc_expr *n)
     return NULL;
 
   if (len || 
     return NULL;
 
   if (len || 

-      (e->ts.cl->length && 
-       mpz_sgn (e->ts.cl->length->value.integer)) != 0)
+      (e->ts.u.cl->length && 
+       mpz_sgn (e->ts.u.cl->length->value.integer)) != 0)

     {
       const char *res = gfc_extract_int (n, &ncop);
       gcc_assert (res == NULL);
     {
       const char *res = gfc_extract_int (n, &ncop);
       gcc_assert (res == NULL);


@@ -5267,7 +5267,7 @@ gfc_simplify_spread (gfc_expr *source, gfc_expr *dim_expr, gfc_expr *ncopies_exp
     return NULL;
 
   if (source->ts.type == BT_CHARACTER)
     return NULL;
 
   if (source->ts.type == BT_CHARACTER)

-    result->ts.cl = source->ts.cl;
+    result->ts.u.cl = source->ts.u.cl;

 
   return result;
 }
 
   return result;
 }


@@ -5623,7 +5623,7 @@ gfc_simplify_transpose (gfc_expr *matrix)
   mpz_set (result->shape[1], matrix->shape[0]);
 
   if (matrix->ts.type == BT_CHARACTER)
   mpz_set (result->shape[1], matrix->shape[0]);
 
   if (matrix->ts.type == BT_CHARACTER)

-    result->ts.cl = matrix->ts.cl;
+    result->ts.u.cl = matrix->ts.u.cl;

 
   matrix_rows = mpz_get_si (matrix->shape[0]);
   matrix_ctor = matrix->value.constructor;
 
   matrix_rows = mpz_get_si (matrix->shape[0]);
   matrix_ctor = matrix->value.constructor;


@@ -5706,7 +5706,7 @@ gfc_simplify_unpack (gfc_expr *vector, gfc_expr *mask, gfc_expr *field)
   result->shape = gfc_copy_shape (mask->shape, mask->rank);
 
   if (vector->ts.type == BT_CHARACTER)
   result->shape = gfc_copy_shape (mask->shape, mask->rank);
 
   if (vector->ts.type == BT_CHARACTER)

-    result->ts.cl = vector->ts.cl;
+    result->ts.u.cl = vector->ts.u.cl;

 
   vector_ctor = vector->value.constructor;
   mask_ctor = mask->value.constructor;
 
   vector_ctor = vector->value.constructor;
   mask_ctor = mask->value.constructor;


@@ -6087,7 +6087,7 @@ gfc_convert_char_constant (gfc_expr *e, bt type ATTRIBUTE_UNUSED, int kind)
       result->shape = gfc_copy_shape (e->shape, e->rank);
       result->where = e->where;
       result->rank = e->rank;
       result->shape = gfc_copy_shape (e->shape, e->rank);
       result->where = e->where;
       result->rank = e->rank;

-      result->ts.cl = e->ts.cl;
+      result->ts.u.cl = e->ts.u.cl;

 
       return result;
     }
 
       return result;
     }

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 27f378c..dc10bc6 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -269,10 +269,10 @@ gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns)
   sym->ts = *ts;
   sym->attr.implicit_type = 1;
 
   sym->ts = *ts;
   sym->attr.implicit_type = 1;
 

-  if (ts->cl)
+  if (ts->type == BT_CHARACTER && ts->u.cl)

     {
     {

-      sym->ts.cl = gfc_get_charlen ();
-      *sym->ts.cl = *ts->cl;
+      sym->ts.u.cl = gfc_get_charlen ();
+      *sym->ts.u.cl = *ts->u.cl;

     }
 
   if (sym->attr.is_bind_c == 1)
     }
 
   if (sym->attr.is_bind_c == 1)


@@ -1774,10 +1774,10 @@ gfc_add_component (gfc_symbol *sym, const char *name,
     }
 
   if (sym->attr.extension
     }
 
   if (sym->attr.extension

-       && gfc_find_component (sym->components->ts.derived, name, true, true))
+       && gfc_find_component (sym->components->ts.u.derived, name, true, true))

     {
       gfc_error ("Component '%s' at %C already in the parent type "
     {
       gfc_error ("Component '%s' at %C already in the parent type "

-                "at %L", name, &sym->components->ts.derived->declared_at);
+                "at %L", name, &sym->components->ts.u.derived->declared_at);

       return FAILURE;
     }
 
       return FAILURE;
     }
 


@@ -1810,8 +1810,8 @@ switch_types (gfc_symtree *st, gfc_symbol *from, gfc_symbol *to)
     return;
 
   sym = st->n.sym;
     return;
 
   sym = st->n.sym;

-  if (sym->ts.type == BT_DERIVED && sym->ts.derived == from)
-    sym->ts.derived = to;
+  if (sym->ts.type == BT_DERIVED && sym->ts.u.derived == from)
+    sym->ts.u.derived = to;

 
   switch_types (st->left, from, to);
   switch_types (st->right, from, to);
 
   switch_types (st->left, from, to);
   switch_types (st->right, from, to);


@@ -1863,8 +1863,8 @@ gfc_use_derived (gfc_symbol *sym)
   for (i = 0; i < GFC_LETTERS; i++)
     {
       t = &sym->ns->default_type[i];
   for (i = 0; i < GFC_LETTERS; i++)
     {
       t = &sym->ns->default_type[i];

-      if (t->derived == sym)
-       t->derived = s;
+      if (t->u.derived == sym)
+       t->u.derived = s;

     }
 
   st = gfc_find_symtree (sym->ns->sym_root, sym->name);
     }
 
   st = gfc_find_symtree (sym->ns->sym_root, sym->name);


@@ -1917,7 +1917,7 @@ gfc_find_component (gfc_symbol *sym, const char *name,
        && sym->attr.extension
        && sym->components->ts.type == BT_DERIVED)
     {
        && sym->attr.extension
        && sym->components->ts.type == BT_DERIVED)
     {

-      p = gfc_find_component (sym->components->ts.derived, name,
+      p = gfc_find_component (sym->components->ts.u.derived, name,

                              noaccess, silent);
       /* Do not overwrite the error.  */
       if (p == NULL)
                              noaccess, silent);
       /* Do not overwrite the error.  */
       if (p == NULL)


@@ -3263,8 +3263,8 @@ gfc_is_var_automatic (gfc_symbol *sym)
     return true;
   /* Check for non-constant length character variables.  */
   if (sym->ts.type == BT_CHARACTER
     return true;
   /* Check for non-constant length character variables.  */
   if (sym->ts.type == BT_CHARACTER

-      && sym->ts.cl
-      && !gfc_is_constant_expr (sym->ts.cl->length))
+      && sym->ts.u.cl
+      && !gfc_is_constant_expr (sym->ts.u.cl->length))

     return true;
   return false;
 }
     return true;
   return false;
 }


@@ -3481,14 +3481,14 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym)
       
       /* BIND(C) derived types must have interoperable components.  */
       if (curr_comp->ts.type == BT_DERIVED
       
       /* BIND(C) derived types must have interoperable components.  */
       if (curr_comp->ts.type == BT_DERIVED

-         && curr_comp->ts.derived->ts.is_iso_c != 1 
-          && curr_comp->ts.derived != derived_sym)
+         && curr_comp->ts.u.derived->ts.is_iso_c != 1 
+          && curr_comp->ts.u.derived != derived_sym)

         {
           /* This should be allowed; the draft says a derived-type can not
              have type parameters if it is has the BIND attribute.  Type
              parameters seem to be for making parameterized derived types.
              There's no need to verify the type if it is c_ptr/c_funptr.  */
         {
           /* This should be allowed; the draft says a derived-type can not
              have type parameters if it is has the BIND attribute.  Type
              parameters seem to be for making parameterized derived types.
              There's no need to verify the type if it is c_ptr/c_funptr.  */

-          retval = verify_bind_c_derived_type (curr_comp->ts.derived);
+          retval = verify_bind_c_derived_type (curr_comp->ts.u.derived);

        }
       else
        {
        }
       else
        {


@@ -3587,10 +3587,10 @@ gen_special_c_interop_ptr (int ptr_id, const char *ptr_name,
   /* The c_ptr and c_funptr derived types will provide the
      definition for c_null_ptr and c_null_funptr, respectively.  */
   if (ptr_id == ISOCBINDING_NULL_PTR)
   /* The c_ptr and c_funptr derived types will provide the
      definition for c_null_ptr and c_null_funptr, respectively.  */
   if (ptr_id == ISOCBINDING_NULL_PTR)

-    tmp_sym->ts.derived = get_iso_c_binding_dt (ISOCBINDING_PTR);
+    tmp_sym->ts.u.derived = get_iso_c_binding_dt (ISOCBINDING_PTR);

   else
   else

-    tmp_sym->ts.derived = get_iso_c_binding_dt (ISOCBINDING_FUNPTR);
-  if (tmp_sym->ts.derived == NULL)
+    tmp_sym->ts.u.derived = get_iso_c_binding_dt (ISOCBINDING_FUNPTR);
+  if (tmp_sym->ts.u.derived == NULL)

     {
       /* This can occur if the user forgot to declare c_ptr or
          c_funptr and they're trying to use one of the procedures
     {
       /* This can occur if the user forgot to declare c_ptr or
          c_funptr and they're trying to use one of the procedures


@@ -3603,7 +3603,7 @@ gen_special_c_interop_ptr (int ptr_id, const char *ptr_name,
                                   ? "_gfortran_iso_c_binding_c_ptr"
                                   : "_gfortran_iso_c_binding_c_funptr"));
 
                                   ? "_gfortran_iso_c_binding_c_ptr"
                                   : "_gfortran_iso_c_binding_c_funptr"));
 

-      tmp_sym->ts.derived =
+      tmp_sym->ts.u.derived =

         get_iso_c_binding_dt (ptr_id == ISOCBINDING_NULL_PTR
                               ? ISOCBINDING_PTR : ISOCBINDING_FUNPTR);
     }
         get_iso_c_binding_dt (ptr_id == ISOCBINDING_NULL_PTR
                               ? ISOCBINDING_PTR : ISOCBINDING_FUNPTR);
     }


@@ -3624,7 +3624,7 @@ gen_special_c_interop_ptr (int ptr_id, const char *ptr_name,
   tmp_sym->value = gfc_get_expr ();
   tmp_sym->value->expr_type = EXPR_STRUCTURE;
   tmp_sym->value->ts.type = BT_DERIVED;
   tmp_sym->value = gfc_get_expr ();
   tmp_sym->value->expr_type = EXPR_STRUCTURE;
   tmp_sym->value->ts.type = BT_DERIVED;

-  tmp_sym->value->ts.derived = tmp_sym->ts.derived;
+  tmp_sym->value->ts.u.derived = tmp_sym->ts.u.derived;

   /* Create a constructor with no expr, that way we can recognize if the user
      tries to call the structure constructor for one of the iso_c_binding
      derived types during resolution (resolve_structure_cons).  */
   /* Create a constructor with no expr, that way we can recognize if the user
      tries to call the structure constructor for one of the iso_c_binding
      derived types during resolution (resolve_structure_cons).  */


@@ -3728,7 +3728,7 @@ gen_cptr_param (gfc_formal_arglist **head,
       gfc_get_ha_symbol (c_ptr_type, &(c_ptr_sym));
     }
 
       gfc_get_ha_symbol (c_ptr_type, &(c_ptr_sym));
     }
 

-  param_sym->ts.derived = c_ptr_sym;
+  param_sym->ts.u.derived = c_ptr_sym;

   param_sym->module = gfc_get_string (module_name);
 
   /* Make new formal arg.  */
   param_sym->module = gfc_get_string (module_name);
 
   /* Make new formal arg.  */


@@ -3956,7 +3956,7 @@ gfc_copy_formal_args_intr (gfc_symbol *dest, gfc_intrinsic_sym *src)
       formal_arg->sym->attr.dummy = 1;
 
       if (formal_arg->sym->ts.type == BT_CHARACTER)
       formal_arg->sym->attr.dummy = 1;
 
       if (formal_arg->sym->ts.type == BT_CHARACTER)

-       formal_arg->sym->ts.cl = gfc_new_charlen (gfc_current_ns);
+       formal_arg->sym->ts.u.cl = gfc_new_charlen (gfc_current_ns);

 
       /* If this isn't the first arg, set up the next ptr.  For the
         last arg built, the formal_arg->next will never get set to
 
       /* If this isn't the first arg, set up the next ptr.  For the
         last arg built, the formal_arg->next will never get set to


@@ -4219,8 +4219,8 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
        tmp_sym->value->value.character.string[0]
          = (gfc_char_t) c_interop_kinds_table[s].value;
        tmp_sym->value->value.character.string[1] = '\0';
        tmp_sym->value->value.character.string[0]
          = (gfc_char_t) c_interop_kinds_table[s].value;
        tmp_sym->value->value.character.string[1] = '\0';

-       tmp_sym->ts.cl = gfc_get_charlen ();
-       tmp_sym->ts.cl->length = gfc_int_expr (1);
+       tmp_sym->ts.u.cl = gfc_get_charlen ();
+       tmp_sym->ts.u.cl->length = gfc_int_expr (1);

 
        /* May not need this in both attr and ts, but do need in
           attr for writing module file.  */
 
        /* May not need this in both attr and ts, but do need in
           attr for writing module file.  */


@@ -4264,7 +4264,7 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
 
        tmp_sym->attr.referenced = 1;
 
 
        tmp_sym->attr.referenced = 1;
 

-       tmp_sym->ts.derived = tmp_sym;
+       tmp_sym->ts.u.derived = tmp_sym;

 
         /* Add the symbol created for the derived type to the current ns.  */
         dt_list_ptr = &(gfc_derived_types);
 
         /* Add the symbol created for the derived type to the current ns.  */
         dt_list_ptr = &(gfc_derived_types);


@@ -4349,13 +4349,13 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
                   C address of.  */
                tmp_sym->ts.type = BT_DERIVED;
                 if (s == ISOCBINDING_LOC)
                   C address of.  */
                tmp_sym->ts.type = BT_DERIVED;
                 if (s == ISOCBINDING_LOC)

-                  tmp_sym->ts.derived =
+                  tmp_sym->ts.u.derived =

                     get_iso_c_binding_dt (ISOCBINDING_PTR);
                 else
                     get_iso_c_binding_dt (ISOCBINDING_PTR);
                 else

-                  tmp_sym->ts.derived =
+                  tmp_sym->ts.u.derived =

                     get_iso_c_binding_dt (ISOCBINDING_FUNPTR);
 
                     get_iso_c_binding_dt (ISOCBINDING_FUNPTR);
 

-                if (tmp_sym->ts.derived == NULL)
+                if (tmp_sym->ts.u.derived == NULL)

                   {
                     /* Create the necessary derived type so we can continue
                        processing the file.  */
                   {
                     /* Create the necessary derived type so we can continue
                        processing the file.  */


@@ -4365,7 +4365,7 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
                       (const char *)(s == ISOCBINDING_FUNLOC
                                 ? "_gfortran_iso_c_binding_c_funptr"
                                : "_gfortran_iso_c_binding_c_ptr"));
                       (const char *)(s == ISOCBINDING_FUNLOC
                                 ? "_gfortran_iso_c_binding_c_funptr"
                                : "_gfortran_iso_c_binding_c_ptr"));

-                    tmp_sym->ts.derived =
+                    tmp_sym->ts.u.derived =

                       get_iso_c_binding_dt (s == ISOCBINDING_FUNLOC
                                             ? ISOCBINDING_FUNPTR
                                             : ISOCBINDING_PTR);
                       get_iso_c_binding_dt (s == ISOCBINDING_FUNLOC
                                             ? ISOCBINDING_FUNPTR
                                             : ISOCBINDING_PTR);


@@ -4517,9 +4517,9 @@ gfc_get_derived_super_type (gfc_symbol* derived)
 
   gcc_assert (derived->components);
   gcc_assert (derived->components->ts.type == BT_DERIVED);
 
   gcc_assert (derived->components);
   gcc_assert (derived->components->ts.type == BT_DERIVED);

-  gcc_assert (derived->components->ts.derived);
+  gcc_assert (derived->components->ts.u.derived);

 
 

-  return derived->components->ts.derived;
+  return derived->components->ts.u.derived;

 }
 
 
 }
 
 

diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c
index 4fe41d5..e19a7d3 100644 (file)
--- a/gcc/fortran/target-memory.c
+++ b/gcc/fortran/target-memory.c
@@ -229,7 +229,7 @@ encode_derived (gfc_expr *source, unsigned char *buffer, size_t buffer_size)
   type = gfc_typenode_for_spec (&source->ts);
 
   ctr = source->value.constructor;
   type = gfc_typenode_for_spec (&source->ts);
 
   ctr = source->value.constructor;

-  cmp = source->ts.derived->components;
+  cmp = source->ts.u.derived->components;

   for (;ctr; ctr = ctr->next, cmp = cmp->next)
     {
       gcc_assert (cmp);
   for (;ctr; ctr = ctr->next, cmp = cmp->next)
     {
       gcc_assert (cmp);


@@ -435,9 +435,9 @@ gfc_interpret_character (unsigned char *buffer, size_t buffer_size,
 {
   int i;
 
 {
   int i;
 

-  if (result->ts.cl && result->ts.cl->length)
+  if (result->ts.u.cl && result->ts.u.cl->length)

     result->value.character.length =
     result->value.character.length =

-      (int) mpz_get_ui (result->ts.cl->length->value.integer);
+      (int) mpz_get_ui (result->ts.u.cl->length->value.integer);

 
   gcc_assert (buffer_size >= size_character (result->value.character.length,
                                             result->ts.kind));
 
   gcc_assert (buffer_size >= size_character (result->value.character.length,
                                             result->ts.kind));


@@ -484,7 +484,7 @@ gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *resu
   result->expr_type = EXPR_STRUCTURE;
 
   type = gfc_typenode_for_spec (&result->ts);
   result->expr_type = EXPR_STRUCTURE;
 
   type = gfc_typenode_for_spec (&result->ts);

-  cmp = result->ts.derived->components;
+  cmp = result->ts.u.derived->components;

 
   /* Run through the derived type components.  */
   for (;cmp; cmp = cmp->next)
 
   /* Run through the derived type components.  */
   for (;cmp; cmp = cmp->next)


@@ -633,7 +633,7 @@ expr_to_char (gfc_expr *e, unsigned char *data, unsigned char *chk, size_t len)
   if (e->ts.type == BT_DERIVED)
     {
       ctr = e->value.constructor;
   if (e->ts.type == BT_DERIVED)
     {
       ctr = e->value.constructor;

-      cmp = e->ts.derived->components;
+      cmp = e->ts.u.derived->components;

       for (;ctr; ctr = ctr->next, cmp = cmp->next)
        {
          gcc_assert (cmp && cmp->backend_decl);
       for (;ctr; ctr = ctr->next, cmp = cmp->next)
        {
          gcc_assert (cmp && cmp->backend_decl);

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index c625bc4..529a6b1 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1533,7 +1533,7 @@ get_array_ctor_var_strlen (gfc_expr * expr, tree * len)
        }
     }
 
        }
     }
 

-  *len = ts->cl->backend_decl;
+  *len = ts->u.cl->backend_decl;

 }
 
 
 }
 
 


@@ -1549,12 +1549,12 @@ get_array_ctor_all_strlen (stmtblock_t *block, gfc_expr *e, tree *len)
   if (*len && INTEGER_CST_P (*len))
     return;
 
   if (*len && INTEGER_CST_P (*len))
     return;
 

-  if (!e->ref && e->ts.cl && e->ts.cl->length
-       && e->ts.cl->length->expr_type == EXPR_CONSTANT)
+  if (!e->ref && e->ts.u.cl && e->ts.u.cl->length
+       && e->ts.u.cl->length->expr_type == EXPR_CONSTANT)

     {
       /* This is easy.  */
     {
       /* This is easy.  */

-      gfc_conv_const_charlen (e->ts.cl);
-      *len = e->ts.cl->backend_decl;
+      gfc_conv_const_charlen (e->ts.u.cl);
+      *len = e->ts.u.cl->backend_decl;

     }
   else
     {
     }
   else
     {


@@ -1575,7 +1575,7 @@ get_array_ctor_all_strlen (stmtblock_t *block, gfc_expr *e, tree *len)
       gfc_add_block_to_block (block, &se.pre);
       gfc_add_block_to_block (block, &se.post);
 
       gfc_add_block_to_block (block, &se.pre);
       gfc_add_block_to_block (block, &se.post);
 

-      e->ts.cl->backend_decl = *len;
+      e->ts.u.cl->backend_decl = *len;

     }
 }
 
     }
 }
 


@@ -1825,8 +1825,8 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
 
   /* Do bounds-checking here and in gfc_trans_array_ctor_element only if no
      typespec was given for the array constructor.  */
 
   /* Do bounds-checking here and in gfc_trans_array_ctor_element only if no
      typespec was given for the array constructor.  */

-  typespec_chararray_ctor = (ss->expr->ts.cl
-                            && ss->expr->ts.cl->length_from_typespec);
+  typespec_chararray_ctor = (ss->expr->ts.u.cl
+                            && ss->expr->ts.u.cl->length_from_typespec);

 
   if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
       && ss->expr->ts.type == BT_CHARACTER && !typespec_chararray_ctor)
 
   if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
       && ss->expr->ts.type == BT_CHARACTER && !typespec_chararray_ctor)


@@ -1845,14 +1845,14 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
       /* get_array_ctor_strlen walks the elements of the constructor, if a
         typespec was given, we already know the string length and want the one
         specified there.  */
       /* get_array_ctor_strlen walks the elements of the constructor, if a
         typespec was given, we already know the string length and want the one
         specified there.  */

-      if (typespec_chararray_ctor && ss->expr->ts.cl->length
-         && ss->expr->ts.cl->length->expr_type != EXPR_CONSTANT)
+      if (typespec_chararray_ctor && ss->expr->ts.u.cl->length
+         && ss->expr->ts.u.cl->length->expr_type != EXPR_CONSTANT)

        {
          gfc_se length_se;
 
          const_string = false;
          gfc_init_se (&length_se, NULL);
        {
          gfc_se length_se;
 
          const_string = false;
          gfc_init_se (&length_se, NULL);

-         gfc_conv_expr_type (&length_se, ss->expr->ts.cl->length,
+         gfc_conv_expr_type (&length_se, ss->expr->ts.u.cl->length,

                              gfc_charlen_type_node);
          ss->string_length = length_se.expr;
          gfc_add_block_to_block (&loop->pre, &length_se.pre);
                              gfc_charlen_type_node);
          ss->string_length = length_se.expr;
          gfc_add_block_to_block (&loop->pre, &length_se.pre);


@@ -1866,7 +1866,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
         and not end up here.  */
       gcc_assert (ss->string_length);
 
         and not end up here.  */
       gcc_assert (ss->string_length);
 

-      ss->expr->ts.cl->backend_decl = ss->string_length;
+      ss->expr->ts.u.cl->backend_decl = ss->string_length;

 
       type = gfc_get_character_type_len (ss->expr->ts.kind, ss->string_length);
       if (const_string)
 
       type = gfc_get_character_type_len (ss->expr->ts.kind, ss->string_length);
       if (const_string)


@@ -2096,11 +2096,11 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
        case GFC_SS_CONSTRUCTOR:
          if (ss->expr->ts.type == BT_CHARACTER
                && ss->string_length == NULL
        case GFC_SS_CONSTRUCTOR:
          if (ss->expr->ts.type == BT_CHARACTER
                && ss->string_length == NULL

-               && ss->expr->ts.cl
-               && ss->expr->ts.cl->length)
+               && ss->expr->ts.u.cl
+               && ss->expr->ts.u.cl->length)

            {
              gfc_init_se (&se, NULL);
            {
              gfc_init_se (&se, NULL);

-             gfc_conv_expr_type (&se, ss->expr->ts.cl->length,
+             gfc_conv_expr_type (&se, ss->expr->ts.u.cl->length,

                                  gfc_charlen_type_node);
              ss->string_length = se.expr;
              gfc_add_block_to_block (&loop->pre, &se.pre);
                                  gfc_charlen_type_node);
              ss->string_length = se.expr;
              gfc_add_block_to_block (&loop->pre, &se.pre);


@@ -4002,9 +4002,9 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat)
   gfc_conv_descriptor_offset_set (&se->pre, se->expr, offset);
 
   if (expr->ts.type == BT_DERIVED
   gfc_conv_descriptor_offset_set (&se->pre, se->expr, offset);
 
   if (expr->ts.type == BT_DERIVED

-       && expr->ts.derived->attr.alloc_comp)
+       && expr->ts.u.derived->attr.alloc_comp)

     {
     {

-      tmp = gfc_nullify_alloc_comp (expr->ts.derived, se->expr,
+      tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, se->expr,

                                    ref->u.ar.as->rank);
       gfc_add_expr_to_block (&se->pre, tmp);
     }
                                    ref->u.ar.as->rank);
       gfc_add_expr_to_block (&se->pre, tmp);
     }


@@ -4290,9 +4290,9 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, tree fnbody)
 
   /* Evaluate character string length.  */
   if (sym->ts.type == BT_CHARACTER
 
   /* Evaluate character string length.  */
   if (sym->ts.type == BT_CHARACTER

-      && onstack && !INTEGER_CST_P (sym->ts.cl->backend_decl))
+      && onstack && !INTEGER_CST_P (sym->ts.u.cl->backend_decl))

     {
     {

-      gfc_conv_string_length (sym->ts.cl, NULL, &block);
+      gfc_conv_string_length (sym->ts.u.cl, NULL, &block);

 
       gfc_trans_vla_type_sizes (sym, &block);
 
 
       gfc_trans_vla_type_sizes (sym, &block);
 


@@ -4315,8 +4315,8 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, tree fnbody)
   gcc_assert (!sym->module);
 
   if (sym->ts.type == BT_CHARACTER
   gcc_assert (!sym->module);
 
   if (sym->ts.type == BT_CHARACTER

-      && !INTEGER_CST_P (sym->ts.cl->backend_decl))
-    gfc_conv_string_length (sym->ts.cl, NULL, &block);
+      && !INTEGER_CST_P (sym->ts.u.cl->backend_decl))
+    gfc_conv_string_length (sym->ts.u.cl, NULL, &block);

 
   size = gfc_trans_array_bounds (type, sym, &offset, &block);
 
 
   size = gfc_trans_array_bounds (type, sym, &offset, &block);
 


@@ -4381,8 +4381,8 @@ gfc_trans_g77_array (gfc_symbol * sym, tree body)
   gfc_start_block (&block);
 
   if (sym->ts.type == BT_CHARACTER
   gfc_start_block (&block);
 
   if (sym->ts.type == BT_CHARACTER

-      && TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL)
-    gfc_conv_string_length (sym->ts.cl, NULL, &block);
+      && TREE_CODE (sym->ts.u.cl->backend_decl) == VAR_DECL)
+    gfc_conv_string_length (sym->ts.u.cl, NULL, &block);

 
   /* Evaluate the bounds of the array.  */
   gfc_trans_array_bounds (type, sym, &offset, &block);
 
   /* Evaluate the bounds of the array.  */
   gfc_trans_array_bounds (type, sym, &offset, &block);


@@ -4474,8 +4474,8 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
   gfc_start_block (&block);
 
   if (sym->ts.type == BT_CHARACTER
   gfc_start_block (&block);
 
   if (sym->ts.type == BT_CHARACTER

-      && TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL)
-    gfc_conv_string_length (sym->ts.cl, NULL, &block);
+      && TREE_CODE (sym->ts.u.cl->backend_decl) == VAR_DECL)
+    gfc_conv_string_length (sym->ts.u.cl, NULL, &block);

 
   checkparm = (sym->as->type == AS_EXPLICIT
               && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS));
 
   checkparm = (sym->as->type == AS_EXPLICIT
               && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS));


@@ -4867,11 +4867,11 @@ get_array_charlen (gfc_expr *expr, gfc_se *se)
   gfc_actual_arglist *arg;
   gfc_se tse;
 
   gfc_actual_arglist *arg;
   gfc_se tse;
 

-  if (expr->ts.cl->length
-       && gfc_is_constant_expr (expr->ts.cl->length))
+  if (expr->ts.u.cl->length
+       && gfc_is_constant_expr (expr->ts.u.cl->length))

     {
     {

-      if (!expr->ts.cl->backend_decl)
-       gfc_conv_string_length (expr->ts.cl, expr, &se->pre);
+      if (!expr->ts.u.cl->backend_decl)
+       gfc_conv_string_length (expr->ts.u.cl, expr, &se->pre);

       return;
     }
 
       return;
     }
 


@@ -4880,11 +4880,11 @@ get_array_charlen (gfc_expr *expr, gfc_se *se)
     case EXPR_OP:
       get_array_charlen (expr->value.op.op1, se);
 
     case EXPR_OP:
       get_array_charlen (expr->value.op.op1, se);
 

-      /* For parentheses the expression ts.cl is identical.  */
+      /* For parentheses the expression ts.u.cl is identical.  */

       if (expr->value.op.op == INTRINSIC_PARENTHESES)
        return;
 
       if (expr->value.op.op == INTRINSIC_PARENTHESES)
        return;
 

-     expr->ts.cl->backend_decl =
+     expr->ts.u.cl->backend_decl =

                gfc_create_var (gfc_charlen_type_node, "sln");
 
       if (expr->value.op.op2)
                gfc_create_var (gfc_charlen_type_node, "sln");
 
       if (expr->value.op.op2)


@@ -4895,21 +4895,21 @@ get_array_charlen (gfc_expr *expr, gfc_se *se)
 
          /* Add the string lengths and assign them to the expression
             string length backend declaration.  */
 
          /* Add the string lengths and assign them to the expression
             string length backend declaration.  */

-         gfc_add_modify (&se->pre, expr->ts.cl->backend_decl,
+         gfc_add_modify (&se->pre, expr->ts.u.cl->backend_decl,

                          fold_build2 (PLUS_EXPR, gfc_charlen_type_node,
                          fold_build2 (PLUS_EXPR, gfc_charlen_type_node,

-                               expr->value.op.op1->ts.cl->backend_decl,
-                               expr->value.op.op2->ts.cl->backend_decl));
+                               expr->value.op.op1->ts.u.cl->backend_decl,
+                               expr->value.op.op2->ts.u.cl->backend_decl));

        }
       else
        }
       else

-       gfc_add_modify (&se->pre, expr->ts.cl->backend_decl,
-                       expr->value.op.op1->ts.cl->backend_decl);
+       gfc_add_modify (&se->pre, expr->ts.u.cl->backend_decl,
+                       expr->value.op.op1->ts.u.cl->backend_decl);

       break;
 
     case EXPR_FUNCTION:
       if (expr->value.function.esym == NULL
       break;
 
     case EXPR_FUNCTION:
       if (expr->value.function.esym == NULL

-           || expr->ts.cl->length->expr_type == EXPR_CONSTANT)
+           || expr->ts.u.cl->length->expr_type == EXPR_CONSTANT)

        {
        {

-         gfc_conv_string_length (expr->ts.cl, expr, &se->pre);
+         gfc_conv_string_length (expr->ts.u.cl, expr, &se->pre);

          break;
        }
 
          break;
        }
 


@@ -4932,19 +4932,19 @@ get_array_charlen (gfc_expr *expr, gfc_se *se)
       gfc_init_se (&tse, NULL);
 
       /* Build the expression for the character length and convert it.  */
       gfc_init_se (&tse, NULL);
 
       /* Build the expression for the character length and convert it.  */

-      gfc_apply_interface_mapping (&mapping, &tse, expr->ts.cl->length);
+      gfc_apply_interface_mapping (&mapping, &tse, expr->ts.u.cl->length);

 
       gfc_add_block_to_block (&se->pre, &tse.pre);
       gfc_add_block_to_block (&se->post, &tse.post);
       tse.expr = fold_convert (gfc_charlen_type_node, tse.expr);
       tse.expr = fold_build2 (MAX_EXPR, gfc_charlen_type_node, tse.expr,
                              build_int_cst (gfc_charlen_type_node, 0));
 
       gfc_add_block_to_block (&se->pre, &tse.pre);
       gfc_add_block_to_block (&se->post, &tse.post);
       tse.expr = fold_convert (gfc_charlen_type_node, tse.expr);
       tse.expr = fold_build2 (MAX_EXPR, gfc_charlen_type_node, tse.expr,
                              build_int_cst (gfc_charlen_type_node, 0));

-      expr->ts.cl->backend_decl = tse.expr;
+      expr->ts.u.cl->backend_decl = tse.expr;

       gfc_free_interface_mapping (&mapping);
       break;
 
     default:
       gfc_free_interface_mapping (&mapping);
       break;
 
     default:

-      gfc_conv_string_length (expr->ts.cl, expr, &se->pre);
+      gfc_conv_string_length (expr->ts.u.cl, expr, &se->pre);

       break;
     }
 }
       break;
     }
 }


@@ -5085,7 +5085,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
          /* Elemental function.  */
          need_tmp = 1;
          if (expr->ts.type == BT_CHARACTER
          /* Elemental function.  */
          need_tmp = 1;
          if (expr->ts.type == BT_CHARACTER

-               && expr->ts.cl->length->expr_type != EXPR_CONSTANT)
+               && expr->ts.u.cl->length->expr_type != EXPR_CONSTANT)

            get_array_charlen (expr, se);
 
          info = NULL;
            get_array_charlen (expr, se);
 
          info = NULL;


@@ -5147,13 +5147,13 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
       loop.temp_ss->next = gfc_ss_terminator;
 
       if (expr->ts.type == BT_CHARACTER
       loop.temp_ss->next = gfc_ss_terminator;
 
       if (expr->ts.type == BT_CHARACTER

-           && !expr->ts.cl->backend_decl)
+           && !expr->ts.u.cl->backend_decl)

        get_array_charlen (expr, se);
 
       loop.temp_ss->data.temp.type = gfc_typenode_for_spec (&expr->ts);
 
       if (expr->ts.type == BT_CHARACTER)
        get_array_charlen (expr, se);
 
       loop.temp_ss->data.temp.type = gfc_typenode_for_spec (&expr->ts);
 
       if (expr->ts.type == BT_CHARACTER)

-       loop.temp_ss->string_length = expr->ts.cl->backend_decl;
+       loop.temp_ss->string_length = expr->ts.u.cl->backend_decl;

       else
        loop.temp_ss->string_length = NULL;
 
       else
        loop.temp_ss->string_length = NULL;
 


@@ -5469,7 +5469,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77,
   if (expr->expr_type == EXPR_ARRAY && expr->ts.type == BT_CHARACTER)
     {
       get_array_ctor_strlen (&se->pre, expr->value.constructor, &tmp);
   if (expr->expr_type == EXPR_ARRAY && expr->ts.type == BT_CHARACTER)
     {
       get_array_ctor_strlen (&se->pre, expr->value.constructor, &tmp);

-      expr->ts.cl->backend_decl = tmp;
+      expr->ts.u.cl->backend_decl = tmp;

       se->string_length = tmp;
     }
 
       se->string_length = tmp;
     }
 


@@ -5486,7 +5486,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77,
       tmp = gfc_get_symbol_decl (sym);
 
       if (sym->ts.type == BT_CHARACTER)
       tmp = gfc_get_symbol_decl (sym);
 
       if (sym->ts.type == BT_CHARACTER)

-       se->string_length = sym->ts.cl->backend_decl;
+       se->string_length = sym->ts.u.cl->backend_decl;

       if (!sym->attr.pointer && sym->as->type != AS_ASSUMED_SHAPE 
           && !sym->attr.allocatable)
         {
       if (!sym->attr.pointer && sym->as->type != AS_ASSUMED_SHAPE 
           && !sym->attr.allocatable)
         {


@@ -5543,12 +5543,12 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77,
   /* Deallocate the allocatable components of structures that are
      not variable.  */
   if (expr->ts.type == BT_DERIVED
   /* Deallocate the allocatable components of structures that are
      not variable.  */
   if (expr->ts.type == BT_DERIVED

-       && expr->ts.derived->attr.alloc_comp
+       && expr->ts.u.derived->attr.alloc_comp

        && expr->expr_type != EXPR_VARIABLE)
     {
       tmp = build_fold_indirect_ref_loc (input_location,
                                     se->expr);
        && expr->expr_type != EXPR_VARIABLE)
     {
       tmp = build_fold_indirect_ref_loc (input_location,
                                     se->expr);

-      tmp = gfc_deallocate_alloc_comp (expr->ts.derived, tmp, expr->rank);
+      tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, tmp, expr->rank);

       gfc_add_expr_to_block (&se->post, tmp);
     }
 
       gfc_add_expr_to_block (&se->post, tmp);
     }
 


@@ -5854,7 +5854,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
   for (c = der_type->components; c; c = c->next)
     {
       bool cmp_has_alloc_comps = (c->ts.type == BT_DERIVED)
   for (c = der_type->components; c; c = c->next)
     {
       bool cmp_has_alloc_comps = (c->ts.type == BT_DERIVED)

-                                   && c->ts.derived->attr.alloc_comp;
+                                   && c->ts.u.derived->attr.alloc_comp;

       cdecl = c->backend_decl;
       ctype = TREE_TYPE (cdecl);
 
       cdecl = c->backend_decl;
       ctype = TREE_TYPE (cdecl);
 


@@ -5868,7 +5868,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
              comp = fold_build3 (COMPONENT_REF, ctype,
                                  decl, cdecl, NULL_TREE);
              rank = c->as ? c->as->rank : 0;
              comp = fold_build3 (COMPONENT_REF, ctype,
                                  decl, cdecl, NULL_TREE);
              rank = c->as ? c->as->rank : 0;

-             tmp = structure_alloc_comps (c->ts.derived, comp, NULL_TREE,
+             tmp = structure_alloc_comps (c->ts.u.derived, comp, NULL_TREE,

                                           rank, purpose);
              gfc_add_expr_to_block (&fnblock, tmp);
            }
                                           rank, purpose);
              gfc_add_expr_to_block (&fnblock, tmp);
            }


@@ -5896,7 +5896,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
              comp = fold_build3 (COMPONENT_REF, ctype,
                                  decl, cdecl, NULL_TREE);
              rank = c->as ? c->as->rank : 0;
              comp = fold_build3 (COMPONENT_REF, ctype,
                                  decl, cdecl, NULL_TREE);
              rank = c->as ? c->as->rank : 0;

-             tmp = structure_alloc_comps (c->ts.derived, comp, NULL_TREE,
+             tmp = structure_alloc_comps (c->ts.u.derived, comp, NULL_TREE,

                                           rank, purpose);
              gfc_add_expr_to_block (&fnblock, tmp);
            }
                                           rank, purpose);
              gfc_add_expr_to_block (&fnblock, tmp);
            }


@@ -5922,7 +5922,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
              rank = c->as ? c->as->rank : 0;
              tmp = fold_convert (TREE_TYPE (dcmp), comp);
              gfc_add_modify (&fnblock, dcmp, tmp);
              rank = c->as ? c->as->rank : 0;
              tmp = fold_convert (TREE_TYPE (dcmp), comp);
              gfc_add_modify (&fnblock, dcmp, tmp);

-             tmp = structure_alloc_comps (c->ts.derived, comp, dcmp,
+             tmp = structure_alloc_comps (c->ts.u.derived, comp, dcmp,

                                           rank, purpose);
              gfc_add_expr_to_block (&fnblock, tmp);
            }
                                           rank, purpose);
              gfc_add_expr_to_block (&fnblock, tmp);
            }


@@ -5985,7 +5985,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
   bool sym_has_alloc_comp;
 
   sym_has_alloc_comp = (sym->ts.type == BT_DERIVED)
   bool sym_has_alloc_comp;
 
   sym_has_alloc_comp = (sym->ts.type == BT_DERIVED)

-                         && sym->ts.derived->attr.alloc_comp;
+                         && sym->ts.u.derived->attr.alloc_comp;

 
   /* Make sure the frontend gets these right.  */
   if (!(sym->attr.pointer || sym->attr.allocatable || sym_has_alloc_comp))
 
   /* Make sure the frontend gets these right.  */
   if (!(sym->attr.pointer || sym->attr.allocatable || sym_has_alloc_comp))


@@ -5999,9 +5999,9 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
                || TREE_CODE (sym->backend_decl) == PARM_DECL);
 
   if (sym->ts.type == BT_CHARACTER
                || TREE_CODE (sym->backend_decl) == PARM_DECL);
 
   if (sym->ts.type == BT_CHARACTER

-      && !INTEGER_CST_P (sym->ts.cl->backend_decl))
+      && !INTEGER_CST_P (sym->ts.u.cl->backend_decl))

     {
     {

-      gfc_conv_string_length (sym->ts.cl, NULL, &fnblock);
+      gfc_conv_string_length (sym->ts.u.cl, NULL, &fnblock);

       gfc_trans_vla_type_sizes (sym, &fnblock);
     }
 
       gfc_trans_vla_type_sizes (sym, &fnblock);
     }
 


@@ -6035,7 +6035,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
       if (!sym->attr.save)
        {
          rank = sym->as ? sym->as->rank : 0;
       if (!sym->attr.save)
        {
          rank = sym->as ? sym->as->rank : 0;

-         tmp = gfc_nullify_alloc_comp (sym->ts.derived, descriptor, rank);
+         tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, descriptor, rank);

          gfc_add_expr_to_block (&fnblock, tmp);
          if (sym->value)
            {
          gfc_add_expr_to_block (&fnblock, tmp);
          if (sym->value)
            {


@@ -6068,7 +6068,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
     {
       int rank;
       rank = sym->as ? sym->as->rank : 0;
     {
       int rank;
       rank = sym->as ? sym->as->rank : 0;

-      tmp = gfc_deallocate_alloc_comp (sym->ts.derived, descriptor, rank);
+      tmp = gfc_deallocate_alloc_comp (sym->ts.u.derived, descriptor, rank);

       gfc_add_expr_to_block (&fnblock, tmp);
     }
 
       gfc_add_expr_to_block (&fnblock, tmp);
     }
 

diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index ca94567..5b1952a 100644 (file)
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -132,7 +132,7 @@ get_segment_info (gfc_symbol * sym, HOST_WIDE_INT offset)
 
   /* Make sure we've got the character length.  */
   if (sym->ts.type == BT_CHARACTER)
 
   /* Make sure we've got the character length.  */
   if (sym->ts.type == BT_CHARACTER)

-    gfc_conv_const_charlen (sym->ts.cl);
+    gfc_conv_const_charlen (sym->ts.u.cl);

 
   /* Create the segment_info and fill it in.  */
   s = (segment_info *) gfc_getmem (sizeof (segment_info));
 
   /* Create the segment_info and fill it in.  */
   s = (segment_info *) gfc_getmem (sizeof (segment_info));


@@ -830,7 +830,7 @@ calculate_offset (gfc_expr *e)
           case AR_ELEMENT:
            n = element_number (&reference->u.ar);
            if (element_type->type == BT_CHARACTER)
           case AR_ELEMENT:
            n = element_number (&reference->u.ar);
            if (element_type->type == BT_CHARACTER)

-             gfc_conv_const_charlen (element_type->cl);
+             gfc_conv_const_charlen (element_type->u.cl);

            element_size =
               int_size_in_bytes (gfc_typenode_for_spec (element_type));
            offset += n * element_size;
            element_size =
               int_size_in_bytes (gfc_typenode_for_spec (element_type));
            offset += n * element_size;

diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c
index 4b7b2c0..035f40b 100644 (file)
--- a/gcc/fortran/trans-const.c
+++ b/gcc/fortran/trans-const.c
@@ -342,8 +342,8 @@ gfc_conv_constant (gfc_se * se, gfc_expr * expr)
   /* We may be receiving an expression for C_NULL_PTR or C_NULL_FUNPTR.  If
      so, they expr_type will not yet be an EXPR_CONSTANT.  We need to make
      it so here.  */
   /* We may be receiving an expression for C_NULL_PTR or C_NULL_FUNPTR.  If
      so, they expr_type will not yet be an EXPR_CONSTANT.  We need to make
      it so here.  */

-  if (expr->ts.type == BT_DERIVED && expr->ts.derived
-      && expr->ts.derived->attr.is_iso_c)
+  if (expr->ts.type == BT_DERIVED && expr->ts.u.derived
+      && expr->ts.u.derived->attr.is_iso_c)

     {
       if (expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_PTR 
           || expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_FUNPTR)
     {
       if (expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_PTR 
           || expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_FUNPTR)

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 70b78ed..ceabbbe 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -796,7 +796,7 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
 
   /* Do we know the element size?  */
   known_size = sym->ts.type != BT_CHARACTER
 
   /* Do we know the element size?  */
   known_size = sym->ts.type != BT_CHARACTER

-         || INTEGER_CST_P (sym->ts.cl->backend_decl);
+         || INTEGER_CST_P (sym->ts.u.cl->backend_decl);

   
   if (known_size && !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type)))
     {
   
   if (known_size && !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type)))
     {


@@ -928,10 +928,10 @@ gfc_nonlocal_dummy_array_decl (gfc_symbol *sym)
 static tree
 gfc_create_string_length (gfc_symbol * sym)
 {
 static tree
 gfc_create_string_length (gfc_symbol * sym)
 {

-  gcc_assert (sym->ts.cl);
-  gfc_conv_const_charlen (sym->ts.cl);
+  gcc_assert (sym->ts.u.cl);
+  gfc_conv_const_charlen (sym->ts.u.cl);

 
 

-  if (sym->ts.cl->backend_decl == NULL_TREE)
+  if (sym->ts.u.cl->backend_decl == NULL_TREE)

     {
       tree length;
       char name[GFC_MAX_MANGLED_SYMBOL_LEN + 2];
     {
       tree length;
       char name[GFC_MAX_MANGLED_SYMBOL_LEN + 2];


@@ -947,11 +947,11 @@ gfc_create_string_length (gfc_symbol * sym)
       if (sym->ns->proc_name->tlink != NULL)
        gfc_defer_symbol_init (sym);
 
       if (sym->ns->proc_name->tlink != NULL)
        gfc_defer_symbol_init (sym);
 

-      sym->ts.cl->backend_decl = length;
+      sym->ts.u.cl->backend_decl = length;

     }
 
     }
 

-  gcc_assert (sym->ts.cl->backend_decl != NULL_TREE);
-  return sym->ts.cl->backend_decl;
+  gcc_assert (sym->ts.u.cl->backend_decl != NULL_TREE);
+  return sym->ts.u.cl->backend_decl;

 }
 
 /* If a variable is assigned a label, we add another two auxiliary
 }
 
 /* If a variable is assigned a label, we add another two auxiliary


@@ -1050,10 +1050,10 @@ gfc_get_symbol_decl (gfc_symbol * sym)
       /* Create a character length variable.  */
       if (sym->ts.type == BT_CHARACTER)
        {
       /* Create a character length variable.  */
       if (sym->ts.type == BT_CHARACTER)
        {

-         if (sym->ts.cl->backend_decl == NULL_TREE)
+         if (sym->ts.u.cl->backend_decl == NULL_TREE)

            length = gfc_create_string_length (sym);
          else
            length = gfc_create_string_length (sym);
          else

-           length = sym->ts.cl->backend_decl;
+           length = sym->ts.u.cl->backend_decl;

          if (TREE_CODE (length) == VAR_DECL
              && DECL_CONTEXT (length) == NULL_TREE)
            {
          if (TREE_CODE (length) == VAR_DECL
              && DECL_CONTEXT (length) == NULL_TREE)
            {


@@ -1118,7 +1118,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
          if (s && s->backend_decl)
            {
              if (sym->ts.type == BT_CHARACTER)
          if (s && s->backend_decl)
            {
              if (sym->ts.type == BT_CHARACTER)

-               sym->ts.cl->backend_decl = s->ts.cl->backend_decl;
+               sym->ts.u.cl->backend_decl = s->ts.u.cl->backend_decl;

              return s->backend_decl;
            }
        }
              return s->backend_decl;
            }
        }


@@ -1171,7 +1171,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
        GFC_DECL_PACKED_ARRAY (decl) = 1;
     }
 
        GFC_DECL_PACKED_ARRAY (decl) = 1;
     }
 

-  if (sym->ts.type == BT_DERIVED && sym->ts.derived->attr.alloc_comp)
+  if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.alloc_comp)

     gfc_defer_symbol_init (sym);
   /* This applies a derived type default initializer.  */
   else if (sym->ts.type == BT_DERIVED
     gfc_defer_symbol_init (sym);
   /* This applies a derived type default initializer.  */
   else if (sym->ts.type == BT_DERIVED


@@ -1696,9 +1696,9 @@ create_function_arglist (gfc_symbol * sym)
                               PARM_DECL,
                               get_identifier (".__result"),
                               len_type);
                               PARM_DECL,
                               get_identifier (".__result"),
                               len_type);

-         if (!sym->ts.cl->length)
+         if (!sym->ts.u.cl->length)

            {
            {

-             sym->ts.cl->backend_decl = length;
+             sym->ts.u.cl->backend_decl = length;

              TREE_USED (length) = 1;
            }
          gcc_assert (TREE_CODE (length) == PARM_DECL);
              TREE_USED (length) = 1;
            }
          gcc_assert (TREE_CODE (length) == PARM_DECL);


@@ -1707,13 +1707,13 @@ create_function_arglist (gfc_symbol * sym)
          TREE_READONLY (length) = 1;
          DECL_ARTIFICIAL (length) = 1;
          gfc_finish_decl (length);
          TREE_READONLY (length) = 1;
          DECL_ARTIFICIAL (length) = 1;
          gfc_finish_decl (length);

-         if (sym->ts.cl->backend_decl == NULL
-             || sym->ts.cl->backend_decl == length)
+         if (sym->ts.u.cl->backend_decl == NULL
+             || sym->ts.u.cl->backend_decl == length)

            {
              gfc_symbol *arg;
              tree backend_decl;
 
            {
              gfc_symbol *arg;
              tree backend_decl;
 

-             if (sym->ts.cl->backend_decl == NULL)
+             if (sym->ts.u.cl->backend_decl == NULL)

                {
                  tree len = build_decl (input_location,
                                         VAR_DECL,
                {
                  tree len = build_decl (input_location,
                                         VAR_DECL,


@@ -1721,7 +1721,7 @@ create_function_arglist (gfc_symbol * sym)
                                         gfc_charlen_type_node);
                  DECL_ARTIFICIAL (len) = 1;
                  TREE_USED (len) = 1;
                                         gfc_charlen_type_node);
                  DECL_ARTIFICIAL (len) = 1;
                  TREE_USED (len) = 1;

-                 sym->ts.cl->backend_decl = len;
+                 sym->ts.u.cl->backend_decl = len;

                }
 
              /* Make sure PARM_DECL type doesn't point to incomplete type.  */
                }
 
              /* Make sure PARM_DECL type doesn't point to incomplete type.  */


@@ -1791,38 +1791,38 @@ create_function_arglist (gfc_symbol * sym)
          gfc_finish_decl (length);
 
          /* Remember the passed value.  */
          gfc_finish_decl (length);
 
          /* Remember the passed value.  */

-          if (f->sym->ts.cl->passed_length != NULL)
+          if (f->sym->ts.u.cl->passed_length != NULL)

             {
              /* This can happen if the same type is used for multiple
                 arguments. We need to copy cl as otherwise
                 cl->passed_length gets overwritten.  */
              gfc_charlen *cl, *cl2;
             {
              /* This can happen if the same type is used for multiple
                 arguments. We need to copy cl as otherwise
                 cl->passed_length gets overwritten.  */
              gfc_charlen *cl, *cl2;

-             cl = f->sym->ts.cl;
-             f->sym->ts.cl = gfc_get_charlen();
-             f->sym->ts.cl->length = cl->length;
-             f->sym->ts.cl->backend_decl = cl->backend_decl;
-             f->sym->ts.cl->length_from_typespec = cl->length_from_typespec;
-             f->sym->ts.cl->resolved = cl->resolved;
-             cl2 = f->sym->ts.cl->next;
-             f->sym->ts.cl->next = cl;
+             cl = f->sym->ts.u.cl;
+             f->sym->ts.u.cl = gfc_get_charlen();
+             f->sym->ts.u.cl->length = cl->length;
+             f->sym->ts.u.cl->backend_decl = cl->backend_decl;
+             f->sym->ts.u.cl->length_from_typespec = cl->length_from_typespec;
+             f->sym->ts.u.cl->resolved = cl->resolved;
+             cl2 = f->sym->ts.u.cl->next;
+             f->sym->ts.u.cl->next = cl;

               cl->next = cl2;
             }
               cl->next = cl2;
             }

-         f->sym->ts.cl->passed_length = length;
+         f->sym->ts.u.cl->passed_length = length;

 
          /* Use the passed value for assumed length variables.  */
 
          /* Use the passed value for assumed length variables.  */

-         if (!f->sym->ts.cl->length)
+         if (!f->sym->ts.u.cl->length)

            {
              TREE_USED (length) = 1;
            {
              TREE_USED (length) = 1;

-             gcc_assert (!f->sym->ts.cl->backend_decl);
-             f->sym->ts.cl->backend_decl = length;
+             gcc_assert (!f->sym->ts.u.cl->backend_decl);
+             f->sym->ts.u.cl->backend_decl = length;

            }
 
          hidden_typelist = TREE_CHAIN (hidden_typelist);
 
            }
 
          hidden_typelist = TREE_CHAIN (hidden_typelist);
 

-         if (f->sym->ts.cl->backend_decl == NULL
-             || f->sym->ts.cl->backend_decl == length)
+         if (f->sym->ts.u.cl->backend_decl == NULL
+             || f->sym->ts.u.cl->backend_decl == length)

            {
            {

-             if (f->sym->ts.cl->backend_decl == NULL)
+             if (f->sym->ts.u.cl->backend_decl == NULL)

                gfc_create_string_length (f->sym);
 
              /* Make sure PARM_DECL type doesn't point to incomplete type.  */
                gfc_create_string_length (f->sym);
 
              /* Make sure PARM_DECL type doesn't point to incomplete type.  */


@@ -1993,7 +1993,7 @@ build_entry_thunks (gfc_namespace * ns)
                                args);
              if (formal->sym->ts.type == BT_CHARACTER)
                {
                                args);
              if (formal->sym->ts.type == BT_CHARACTER)
                {

-                 tmp = thunk_formal->sym->ts.cl->backend_decl;
+                 tmp = thunk_formal->sym->ts.u.cl->backend_decl;

                  string_args = tree_cons (NULL_TREE, tmp, string_args);
                }
            }
                  string_args = tree_cons (NULL_TREE, tmp, string_args);
                }
            }


@@ -2090,15 +2090,15 @@ build_entry_thunks (gfc_namespace * ns)
          {
            formal->sym->backend_decl = NULL_TREE;
            if (formal->sym->ts.type == BT_CHARACTER)
          {
            formal->sym->backend_decl = NULL_TREE;
            if (formal->sym->ts.type == BT_CHARACTER)

-             formal->sym->ts.cl->backend_decl = NULL_TREE;
+             formal->sym->ts.u.cl->backend_decl = NULL_TREE;

          }
 
       if (thunk_sym->attr.function)
        {
          if (thunk_sym->ts.type == BT_CHARACTER)
          }
 
       if (thunk_sym->attr.function)
        {
          if (thunk_sym->ts.type == BT_CHARACTER)

-           thunk_sym->ts.cl->backend_decl = NULL_TREE;
+           thunk_sym->ts.u.cl->backend_decl = NULL_TREE;

          if (thunk_sym->result->ts.type == BT_CHARACTER)
          if (thunk_sym->result->ts.type == BT_CHARACTER)

-           thunk_sym->result->ts.cl->backend_decl = NULL_TREE;
+           thunk_sym->result->ts.u.cl->backend_decl = NULL_TREE;

        }
     }
 
        }
     }
 


@@ -2207,10 +2207,10 @@ gfc_get_fake_result_decl (gfc_symbol * sym, int parent_flag)
 
   if (sym->ts.type == BT_CHARACTER)
     {
 
   if (sym->ts.type == BT_CHARACTER)
     {

-      if (sym->ts.cl->backend_decl == NULL_TREE)
+      if (sym->ts.u.cl->backend_decl == NULL_TREE)

        length = gfc_create_string_length (sym);
       else
        length = gfc_create_string_length (sym);
       else

-       length = sym->ts.cl->backend_decl;
+       length = sym->ts.u.cl->backend_decl;

       if (TREE_CODE (length) == VAR_DECL
          && DECL_CONTEXT (length) == NULL_TREE)
        gfc_add_decl_to_function (length);
       if (TREE_CODE (length) == VAR_DECL
          && DECL_CONTEXT (length) == NULL_TREE)
        gfc_add_decl_to_function (length);


@@ -2816,12 +2816,12 @@ gfc_trans_auto_character_variable (gfc_symbol * sym, tree fnbody)
   tree tmp;
 
   gcc_assert (sym->backend_decl);
   tree tmp;
 
   gcc_assert (sym->backend_decl);

-  gcc_assert (sym->ts.cl && sym->ts.cl->length);
+  gcc_assert (sym->ts.u.cl && sym->ts.u.cl->length);

 
   gfc_start_block (&body);
 
   /* Evaluate the string length expression.  */
 
   gfc_start_block (&body);
 
   /* Evaluate the string length expression.  */

-  gfc_conv_string_length (sym->ts.cl, NULL, &body);
+  gfc_conv_string_length (sym->ts.u.cl, NULL, &body);

 
   gfc_trans_vla_type_sizes (sym, &body);
 
 
   gfc_trans_vla_type_sizes (sym, &body);
 


@@ -3009,9 +3009,9 @@ init_intent_out_dt (gfc_symbol * proc_sym, tree body)
        && !f->sym->attr.pointer
        && f->sym->ts.type == BT_DERIVED)
       {
        && !f->sym->attr.pointer
        && f->sym->ts.type == BT_DERIVED)
       {

-       if (f->sym->ts.derived->attr.alloc_comp)
+       if (f->sym->ts.u.derived->attr.alloc_comp)

          {
          {

-           tmp = gfc_deallocate_alloc_comp (f->sym->ts.derived,
+           tmp = gfc_deallocate_alloc_comp (f->sym->ts.u.derived,

                                             f->sym->backend_decl,
                                             f->sym->as ? f->sym->as->rank : 0);
 
                                             f->sym->backend_decl,
                                             f->sym->as ? f->sym->as->rank : 0);
 


@@ -3022,7 +3022,7 @@ init_intent_out_dt (gfc_symbol * proc_sym, tree body)
            gfc_add_expr_to_block (&fnblock, tmp);
          }
 
            gfc_add_expr_to_block (&fnblock, tmp);
          }
 

-       if (!f->sym->ts.derived->attr.alloc_comp
+       if (!f->sym->ts.u.derived->attr.alloc_comp

              && f->sym->value)
          body = gfc_init_default_dt (f->sym, body);
       }
              && f->sym->value)
          body = gfc_init_default_dt (f->sym, body);
       }


@@ -3073,14 +3073,14 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
 
          /* An automatic character length, pointer array result.  */
          if (proc_sym->ts.type == BT_CHARACTER
 
          /* An automatic character length, pointer array result.  */
          if (proc_sym->ts.type == BT_CHARACTER

-               && TREE_CODE (proc_sym->ts.cl->backend_decl) == VAR_DECL)
-           fnbody = gfc_trans_dummy_character (proc_sym, proc_sym->ts.cl,
+               && TREE_CODE (proc_sym->ts.u.cl->backend_decl) == VAR_DECL)
+           fnbody = gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl,

                                                fnbody);
        }
       else if (proc_sym->ts.type == BT_CHARACTER)
        {
                                                fnbody);
        }
       else if (proc_sym->ts.type == BT_CHARACTER)
        {

-         if (TREE_CODE (proc_sym->ts.cl->backend_decl) == VAR_DECL)
-           fnbody = gfc_trans_dummy_character (proc_sym, proc_sym->ts.cl,
+         if (TREE_CODE (proc_sym->ts.u.cl->backend_decl) == VAR_DECL)
+           fnbody = gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl,

                                                fnbody);
        }
       else
                                                fnbody);
        }
       else


@@ -3096,7 +3096,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
   for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink)
     {
       bool sym_has_alloc_comp = (sym->ts.type == BT_DERIVED)
   for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink)
     {
       bool sym_has_alloc_comp = (sym->ts.type == BT_DERIVED)

-                                  && sym->ts.derived->attr.alloc_comp;
+                                  && sym->ts.u.derived->attr.alloc_comp;

       if (sym->attr.dimension)
        {
          switch (sym->as->type)
       if (sym->attr.dimension)
        {
          switch (sym->as->type)


@@ -3170,7 +3170,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
          gfc_get_backend_locus (&loc);
          gfc_set_backend_locus (&sym->declared_at);
          if (sym->attr.dummy || sym->attr.result)
          gfc_get_backend_locus (&loc);
          gfc_set_backend_locus (&sym->declared_at);
          if (sym->attr.dummy || sym->attr.result)

-           fnbody = gfc_trans_dummy_character (sym, sym->ts.cl, fnbody);
+           fnbody = gfc_trans_dummy_character (sym, sym->ts.u.cl, fnbody);

          else
            fnbody = gfc_trans_auto_character_variable (sym, fnbody);
          gfc_set_backend_locus (&loc);
          else
            fnbody = gfc_trans_auto_character_variable (sym, fnbody);
          gfc_set_backend_locus (&loc);


@@ -3197,8 +3197,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
     {
       if (f->sym && f->sym->tlink == NULL && f->sym->ts.type == BT_CHARACTER)
        {
     {
       if (f->sym && f->sym->tlink == NULL && f->sym->ts.type == BT_CHARACTER)
        {

-         gcc_assert (f->sym->ts.cl->backend_decl != NULL);
-         if (TREE_CODE (f->sym->ts.cl->backend_decl) == PARM_DECL)
+         gcc_assert (f->sym->ts.u.cl->backend_decl != NULL);
+         if (TREE_CODE (f->sym->ts.u.cl->backend_decl) == PARM_DECL)

            gfc_trans_vla_type_sizes (f->sym, &body);
        }
     }
            gfc_trans_vla_type_sizes (f->sym, &body);
        }
     }


@@ -3206,8 +3206,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
   if (gfc_return_by_reference (proc_sym) && proc_sym->ts.type == BT_CHARACTER
       && current_fake_result_decl != NULL)
     {
   if (gfc_return_by_reference (proc_sym) && proc_sym->ts.type == BT_CHARACTER
       && current_fake_result_decl != NULL)
     {

-      gcc_assert (proc_sym->ts.cl->backend_decl != NULL);
-      if (TREE_CODE (proc_sym->ts.cl->backend_decl) == PARM_DECL)
+      gcc_assert (proc_sym->ts.u.cl->backend_decl != NULL);
+      if (TREE_CODE (proc_sym->ts.u.cl->backend_decl) == PARM_DECL)

        gfc_trans_vla_type_sizes (proc_sym, &body);
     }
 
        gfc_trans_vla_type_sizes (proc_sym, &body);
     }
 


@@ -3381,7 +3381,7 @@ gfc_create_module_variable (gfc_symbol * sym)
     {
       tree length;
 
     {
       tree length;
 

-      length = sym->ts.cl->backend_decl;
+      length = sym->ts.u.cl->backend_decl;

       if (!INTEGER_CST_P (length))
         {
           pushdecl (length);
       if (!INTEGER_CST_P (length))
         {
           pushdecl (length);


@@ -3511,7 +3511,7 @@ check_constant_initializer (gfc_expr *expr, gfc_typespec *ts, bool array,
     case BT_DERIVED:
       if (expr->expr_type != EXPR_STRUCTURE)
        return false;
     case BT_DERIVED:
       if (expr->expr_type != EXPR_STRUCTURE)
        return false;

-      cm = expr->ts.derived->components;
+      cm = expr->ts.u.derived->components;

       for (c = expr->value.constructor; c; c = c->next, cm = cm->next)
        {
          if (!c->expr || cm->attr.allocatable)
       for (c = expr->value.constructor; c; c = c->next, cm = cm->next)
        {
          if (!c->expr || cm->attr.allocatable)


@@ -3557,12 +3557,12 @@ gfc_emit_parameter_debug_info (gfc_symbol *sym)
 
   if (sym->ts.type == BT_CHARACTER)
     {
 
   if (sym->ts.type == BT_CHARACTER)
     {

-      gfc_conv_const_charlen (sym->ts.cl);
-      if (sym->ts.cl->backend_decl == NULL
-         || TREE_CODE (sym->ts.cl->backend_decl) != INTEGER_CST)
+      gfc_conv_const_charlen (sym->ts.u.cl);
+      if (sym->ts.u.cl->backend_decl == NULL
+         || TREE_CODE (sym->ts.u.cl->backend_decl) != INTEGER_CST)

        return;
     }
        return;
     }

-  else if (sym->ts.type == BT_DERIVED && sym->ts.derived->attr.alloc_comp)
+  else if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.alloc_comp)

     return;
 
   if (sym->as)
     return;
 
   if (sym->as)


@@ -3690,10 +3690,10 @@ generate_dependency_declarations (gfc_symbol *sym)
   int i;
 
   if (sym->ts.type == BT_CHARACTER
   int i;
 
   if (sym->ts.type == BT_CHARACTER

-      && sym->ts.cl
-      && sym->ts.cl->length
-      && sym->ts.cl->length->expr_type != EXPR_CONSTANT)
-    generate_expr_decls (sym, sym->ts.cl->length);
+      && sym->ts.u.cl
+      && sym->ts.u.cl->length
+      && sym->ts.u.cl->length->expr_type != EXPR_CONSTANT)
+    generate_expr_decls (sym, sym->ts.u.cl->length);

 
   if (sym->as && sym->as->rank)
     {
 
   if (sym->as && sym->as->rank)
     {


@@ -3744,8 +3744,8 @@ generate_local_decl (gfc_symbol * sym)
         warning if requested.  */
       if (sym->attr.dummy && !sym->attr.referenced
            && sym->ts.type == BT_CHARACTER
         warning if requested.  */
       if (sym->attr.dummy && !sym->attr.referenced
            && sym->ts.type == BT_CHARACTER

-           && sym->ts.cl->backend_decl != NULL
-           && TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL)
+           && sym->ts.u.cl->backend_decl != NULL
+           && TREE_CODE (sym->ts.u.cl->backend_decl) == VAR_DECL)

        {
          sym->attr.referenced = 1;
          gfc_get_symbol_decl (sym);
        {
          sym->attr.referenced = 1;
          gfc_get_symbol_decl (sym);


@@ -3756,7 +3756,7 @@ generate_local_decl (gfc_symbol * sym)
         generate the code for nullification and automatic lengths.  */
       if (!sym->attr.referenced
            && sym->ts.type == BT_DERIVED
         generate the code for nullification and automatic lengths.  */
       if (!sym->attr.referenced
            && sym->ts.type == BT_DERIVED

-           && sym->ts.derived->attr.alloc_comp
+           && sym->ts.u.derived->attr.alloc_comp

            && !sym->attr.pointer
            && ((sym->attr.dummy && sym->attr.intent == INTENT_OUT)
                  ||
            && !sym->attr.pointer
            && ((sym->attr.dummy && sym->attr.intent == INTENT_OUT)
                  ||


@@ -3887,7 +3887,7 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym)
        const char *message;
 
        fsym = formal->sym;
        const char *message;
 
        fsym = formal->sym;

-       cl = fsym->ts.cl;
+       cl = fsym->ts.u.cl;

 
        gcc_assert (cl);
        gcc_assert (cl->passed_length != NULL_TREE);
 
        gcc_assert (cl);
        gcc_assert (cl->passed_length != NULL_TREE);


@@ -4224,10 +4224,10 @@ gfc_generate_function_code (gfc_namespace * ns)
       gfc_entry_list *el;
       tree backend_decl;
 
       gfc_entry_list *el;
       tree backend_decl;
 

-      gfc_conv_const_charlen (ns->proc_name->ts.cl);
-      backend_decl = ns->proc_name->result->ts.cl->backend_decl;
+      gfc_conv_const_charlen (ns->proc_name->ts.u.cl);
+      backend_decl = ns->proc_name->result->ts.u.cl->backend_decl;

       for (el = ns->entries; el; el = el->next)
       for (el = ns->entries; el; el = el->next)

-       el->sym->result->ts.cl->backend_decl = backend_decl;
+       el->sym->result->ts.u.cl->backend_decl = backend_decl;

     }
 
   /* Translate COMMON blocks.  */
     }
 
   /* Translate COMMON blocks.  */


@@ -4328,11 +4328,11 @@ gfc_generate_function_code (gfc_namespace * ns)
 
       if (result != NULL_TREE && sym->attr.function
            && sym->ts.type == BT_DERIVED
 
       if (result != NULL_TREE && sym->attr.function
            && sym->ts.type == BT_DERIVED

-           && sym->ts.derived->attr.alloc_comp
+           && sym->ts.u.derived->attr.alloc_comp

            && !sym->attr.pointer)
        {
          rank = sym->as ? sym->as->rank : 0;
            && !sym->attr.pointer)
        {
          rank = sym->as ? sym->as->rank : 0;

-         tmp2 = gfc_nullify_alloc_comp (sym->ts.derived, result, rank);
+         tmp2 = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank);

          gfc_add_expr_to_block (&block, tmp2);
        }
 
          gfc_add_expr_to_block (&block, tmp2);
        }
 

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index a6e129b..51593e7 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -201,12 +201,12 @@ gfc_get_expr_charlen (gfc_expr *e)
   
   length = NULL; /* To silence compiler warning.  */
 
   
   length = NULL; /* To silence compiler warning.  */
 

-  if (is_subref_array (e) && e->ts.cl->length)
+  if (is_subref_array (e) && e->ts.u.cl->length)

     {
       gfc_se tmpse;
       gfc_init_se (&tmpse, NULL);
     {
       gfc_se tmpse;
       gfc_init_se (&tmpse, NULL);

-      gfc_conv_expr_type (&tmpse, e->ts.cl->length, gfc_charlen_type_node);
-      e->ts.cl->backend_decl = tmpse.expr;
+      gfc_conv_expr_type (&tmpse, e->ts.u.cl->length, gfc_charlen_type_node);
+      e->ts.u.cl->backend_decl = tmpse.expr;

       return tmpse.expr;
     }
 
       return tmpse.expr;
     }
 


@@ -214,7 +214,7 @@ gfc_get_expr_charlen (gfc_expr *e)
      expression's length could be the length of the character
      variable.  */
   if (e->symtree->n.sym->ts.type == BT_CHARACTER)
      expression's length could be the length of the character
      variable.  */
   if (e->symtree->n.sym->ts.type == BT_CHARACTER)

-    length = e->symtree->n.sym->ts.cl->backend_decl;
+    length = e->symtree->n.sym->ts.u.cl->backend_decl;

 
   /* Look through the reference chain for component references.  */
   for (r = e->ref; r; r = r->next)
 
   /* Look through the reference chain for component references.  */
   for (r = e->ref; r; r = r->next)


@@ -223,7 +223,7 @@ gfc_get_expr_charlen (gfc_expr *e)
        {
        case REF_COMPONENT:
          if (r->u.c.component->ts.type == BT_CHARACTER)
        {
        case REF_COMPONENT:
          if (r->u.c.component->ts.type == BT_CHARACTER)

-           length = r->u.c.component->ts.cl->backend_decl;
+           length = r->u.c.component->ts.u.cl->backend_decl;

          break;
 
        case REF_ARRAY:
          break;
 
        case REF_ARRAY:


@@ -243,7 +243,7 @@ gfc_get_expr_charlen (gfc_expr *e)
 }
 
 
 }
 
 

-/* For each character array constructor subexpression without a ts.cl->length,
+/* For each character array constructor subexpression without a ts.u.cl->length,

    replace it by its first element (if there aren't any elements, the length
    should already be set to zero).  */
 
    replace it by its first element (if there aren't any elements, the length
    should already be set to zero).  */
 


@@ -276,7 +276,7 @@ flatten_array_ctors_without_strlen (gfc_expr* e)
     case EXPR_ARRAY:
 
       /* We've found what we're looking for.  */
     case EXPR_ARRAY:
 
       /* We've found what we're looking for.  */

-      if (e->ts.type == BT_CHARACTER && !e->ts.cl->length)
+      if (e->ts.type == BT_CHARACTER && !e->ts.u.cl->length)

        {
          gfc_expr* new_expr;
          gcc_assert (e->value.constructor);
        {
          gfc_expr* new_expr;
          gcc_assert (e->value.constructor);


@@ -472,7 +472,7 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref)
 
   if (c->ts.type == BT_CHARACTER)
     {
 
   if (c->ts.type == BT_CHARACTER)
     {

-      tmp = c->ts.cl->backend_decl;
+      tmp = c->ts.u.cl->backend_decl;

       /* Components must always be constant length.  */
       gcc_assert (tmp && INTEGER_CST_P (tmp));
       se->string_length = tmp;
       /* Components must always be constant length.  */
       gcc_assert (tmp && INTEGER_CST_P (tmp));
       se->string_length = tmp;


@@ -513,7 +513,7 @@ conv_parent_component_references (gfc_se * se, gfc_ref * ref)
        
       /* Otherwise build the reference and call self.  */
       gfc_conv_component_ref (se, &parent);
        
       /* Otherwise build the reference and call self.  */
       gfc_conv_component_ref (se, &parent);

-      parent.u.c.sym = dt->components->ts.derived;
+      parent.u.c.sym = dt->components->ts.u.derived;

       parent.u.c.component = c;
       conv_parent_component_references (se, &parent);
     }
       parent.u.c.component = c;
       conv_parent_component_references (se, &parent);
     }


@@ -662,10 +662,10 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
     {
       /* If the character length of an entry isn't set, get the length from
          the master function instead.  */
     {
       /* If the character length of an entry isn't set, get the length from
          the master function instead.  */

-      if (sym->attr.entry && !sym->ts.cl->backend_decl)
-        se->string_length = sym->ns->proc_name->ts.cl->backend_decl;
+      if (sym->attr.entry && !sym->ts.u.cl->backend_decl)
+        se->string_length = sym->ns->proc_name->ts.u.cl->backend_decl;

       else
       else

-        se->string_length = sym->ts.cl->backend_decl;
+        se->string_length = sym->ts.u.cl->backend_decl;

       gcc_assert (se->string_length);
     }
 
       gcc_assert (se->string_length);
     }
 


@@ -1159,7 +1159,7 @@ gfc_conv_concat_op (gfc_se * se, gfc_expr * expr)
   gfc_add_block_to_block (&se->pre, &lse.pre);
   gfc_add_block_to_block (&se->pre, &rse.pre);
 
   gfc_add_block_to_block (&se->pre, &lse.pre);
   gfc_add_block_to_block (&se->pre, &rse.pre);
 

-  type = gfc_get_character_type (expr->ts.kind, expr->ts.cl);
+  type = gfc_get_character_type (expr->ts.kind, expr->ts.u.cl);

   len = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
   if (len == NULL_TREE)
     {
   len = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
   if (len == NULL_TREE)
     {


@@ -1723,16 +1723,16 @@ gfc_add_interface_mapping (gfc_interface_mapping * mapping,
   if (sym->ts.type == BT_CHARACTER)
     {
       /* Create a copy of the dummy argument's length.  */
   if (sym->ts.type == BT_CHARACTER)
     {
       /* Create a copy of the dummy argument's length.  */

-      new_sym->ts.cl = gfc_get_interface_mapping_charlen (mapping, sym->ts.cl);
-      sm->expr->ts.cl = new_sym->ts.cl;
+      new_sym->ts.u.cl = gfc_get_interface_mapping_charlen (mapping, sym->ts.u.cl);
+      sm->expr->ts.u.cl = new_sym->ts.u.cl;

 
       /* If the length is specified as "*", record the length that
         the caller is passing.  We should use the callee's length
         in all other cases.  */
 
       /* If the length is specified as "*", record the length that
         the caller is passing.  We should use the callee's length
         in all other cases.  */

-      if (!new_sym->ts.cl->length && se)
+      if (!new_sym->ts.u.cl->length && se)

        {
          se->string_length = gfc_evaluate_now (se->string_length, &se->pre);
        {
          se->string_length = gfc_evaluate_now (se->string_length, &se->pre);

-         new_sym->ts.cl->backend_decl = se->string_length;
+         new_sym->ts.u.cl->backend_decl = se->string_length;

        }
     }
 
        }
     }
 


@@ -1764,7 +1764,7 @@ gfc_add_interface_mapping (gfc_interface_mapping * mapping,
                                     se->expr);
   
   /* For character(*), use the actual argument's descriptor.  */  
                                     se->expr);
   
   /* For character(*), use the actual argument's descriptor.  */  

-  else if (sym->ts.type == BT_CHARACTER && !new_sym->ts.cl->length)
+  else if (sym->ts.type == BT_CHARACTER && !new_sym->ts.u.cl->length)

     value = build_fold_indirect_ref_loc (input_location,
                                     se->expr);
 
     value = build_fold_indirect_ref_loc (input_location,
                                     se->expr);
 


@@ -1809,9 +1809,9 @@ gfc_finish_interface_mapping (gfc_interface_mapping * mapping,
 
   for (sym = mapping->syms; sym; sym = sym->next)
     if (sym->new_sym->n.sym->ts.type == BT_CHARACTER
 
   for (sym = mapping->syms; sym; sym = sym->next)
     if (sym->new_sym->n.sym->ts.type == BT_CHARACTER

-       && !sym->new_sym->n.sym->ts.cl->backend_decl)
+       && !sym->new_sym->n.sym->ts.u.cl->backend_decl)

       {
       {

-       expr = sym->new_sym->n.sym->ts.cl->length;
+       expr = sym->new_sym->n.sym->ts.u.cl->length;

        gfc_apply_interface_mapping_to_expr (mapping, expr);
        gfc_init_se (&se, NULL);
        gfc_conv_expr (&se, expr);
        gfc_apply_interface_mapping_to_expr (mapping, expr);
        gfc_init_se (&se, NULL);
        gfc_conv_expr (&se, expr);


@@ -1820,7 +1820,7 @@ gfc_finish_interface_mapping (gfc_interface_mapping * mapping,
        gfc_add_block_to_block (pre, &se.pre);
        gfc_add_block_to_block (post, &se.post);
 
        gfc_add_block_to_block (pre, &se.pre);
        gfc_add_block_to_block (post, &se.post);
 

-       sym->new_sym->n.sym->ts.cl->backend_decl = se.expr;
+       sym->new_sym->n.sym->ts.u.cl->backend_decl = se.expr;

       }
 }
 
       }
 }
 


@@ -1907,12 +1907,12 @@ gfc_map_intrinsic_function (gfc_expr *expr, gfc_interface_mapping *mapping)
     case GFC_ISYM_LEN:
       /* TODO figure out why this condition is necessary.  */
       if (sym->attr.function
     case GFC_ISYM_LEN:
       /* TODO figure out why this condition is necessary.  */
       if (sym->attr.function

-         && (arg1->ts.cl->length == NULL
-             || (arg1->ts.cl->length->expr_type != EXPR_CONSTANT
-                 && arg1->ts.cl->length->expr_type != EXPR_VARIABLE)))
+         && (arg1->ts.u.cl->length == NULL
+             || (arg1->ts.u.cl->length->expr_type != EXPR_CONSTANT
+                 && arg1->ts.u.cl->length->expr_type != EXPR_VARIABLE)))

        return false;
 
        return false;
 

-      new_expr = gfc_copy_expr (arg1->ts.cl->length);
+      new_expr = gfc_copy_expr (arg1->ts.u.cl->length);

       break;
 
     case GFC_ISYM_SIZE:
       break;
 
     case GFC_ISYM_SIZE:


@@ -2025,11 +2025,11 @@ gfc_map_fcn_formal_to_actual (gfc_expr *expr, gfc_expr *map_expr,
 
   if (map_expr->symtree->n.sym->ts.type == BT_CHARACTER)
     {
 
   if (map_expr->symtree->n.sym->ts.type == BT_CHARACTER)
     {

-      expr->value.function.esym->ts.cl->length
-       = gfc_copy_expr (map_expr->symtree->n.sym->ts.cl->length);
+      expr->value.function.esym->ts.u.cl->length
+       = gfc_copy_expr (map_expr->symtree->n.sym->ts.u.cl->length);

 
       gfc_apply_interface_mapping_to_expr (mapping,
 
       gfc_apply_interface_mapping_to_expr (mapping,

-                       expr->value.function.esym->ts.cl->length);
+                       expr->value.function.esym->ts.u.cl->length);

     }
 }
 
     }
 }
 


@@ -2050,10 +2050,10 @@ gfc_apply_interface_mapping_to_expr (gfc_interface_mapping * mapping,
     return;
 
   /* Copying an expression does not copy its length, so do that here.  */
     return;
 
   /* Copying an expression does not copy its length, so do that here.  */

-  if (expr->ts.type == BT_CHARACTER && expr->ts.cl)
+  if (expr->ts.type == BT_CHARACTER && expr->ts.u.cl)

     {
     {

-      expr->ts.cl = gfc_get_interface_mapping_charlen (mapping, expr->ts.cl);
-      gfc_apply_interface_mapping_to_expr (mapping, expr->ts.cl->length);
+      expr->ts.u.cl = gfc_get_interface_mapping_charlen (mapping, expr->ts.u.cl);
+      gfc_apply_interface_mapping_to_expr (mapping, expr->ts.u.cl->length);

     }
 
   /* Apply the mapping to any references.  */
     }
 
   /* Apply the mapping to any references.  */


@@ -2173,8 +2173,8 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr,
   gfc_conv_ss_startstride (&loop);
 
   /* Build an ss for the temporary.  */
   gfc_conv_ss_startstride (&loop);
 
   /* Build an ss for the temporary.  */

-  if (expr->ts.type == BT_CHARACTER && !expr->ts.cl->backend_decl)
-    gfc_conv_string_length (expr->ts.cl, expr, &parmse->pre);
+  if (expr->ts.type == BT_CHARACTER && !expr->ts.u.cl->backend_decl)
+    gfc_conv_string_length (expr->ts.u.cl, expr, &parmse->pre);

 
   base_type = gfc_typenode_for_spec (&expr->ts);
   if (GFC_ARRAY_TYPE_P (base_type)
 
   base_type = gfc_typenode_for_spec (&expr->ts);
   if (GFC_ARRAY_TYPE_P (base_type)


@@ -2186,7 +2186,7 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr,
   loop.temp_ss->data.temp.type = base_type;
 
   if (expr->ts.type == BT_CHARACTER)
   loop.temp_ss->data.temp.type = base_type;
 
   if (expr->ts.type == BT_CHARACTER)

-    loop.temp_ss->string_length = expr->ts.cl->backend_decl;
+    loop.temp_ss->string_length = expr->ts.u.cl->backend_decl;

   else
     loop.temp_ss->string_length = NULL;
 
   else
     loop.temp_ss->string_length = NULL;
 


@@ -2315,7 +2315,7 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr,
   rse.expr = gfc_build_array_ref (tmp, tmp_index, NULL);
 
   if (expr->ts.type == BT_CHARACTER)
   rse.expr = gfc_build_array_ref (tmp, tmp_index, NULL);
 
   if (expr->ts.type == BT_CHARACTER)

-    rse.string_length = expr->ts.cl->backend_decl;
+    rse.string_length = expr->ts.u.cl->backend_decl;

 
   gfc_conv_expr (&lse, expr);
 
 
   gfc_conv_expr (&lse, expr);
 


@@ -2343,7 +2343,7 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr,
 
   /* Pass the string length to the argument expression.  */
   if (expr->ts.type == BT_CHARACTER)
 
   /* Pass the string length to the argument expression.  */
   if (expr->ts.type == BT_CHARACTER)

-    parmse->string_length = expr->ts.cl->backend_decl;
+    parmse->string_length = expr->ts.u.cl->backend_decl;

 
   /* We want either the address for the data or the address of the descriptor,
      depending on the mode of passing array arguments.  */
 
   /* We want either the address for the data or the address of the descriptor,
      depending on the mode of passing array arguments.  */


@@ -2457,9 +2457,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
        }
       else if (sym->intmod_sym_id == ISOCBINDING_FUNLOC)
        {
        }
       else if (sym->intmod_sym_id == ISOCBINDING_FUNLOC)
        {

-         arg->expr->ts.type = sym->ts.derived->ts.type;
-         arg->expr->ts.f90_type = sym->ts.derived->ts.f90_type;
-         arg->expr->ts.kind = sym->ts.derived->ts.kind;
+         arg->expr->ts.type = sym->ts.u.derived->ts.type;
+         arg->expr->ts.f90_type = sym->ts.u.derived->ts.f90_type;
+         arg->expr->ts.kind = sym->ts.u.derived->ts.kind;

          gfc_conv_expr_reference (se, arg->expr);
       
          return 0;
          gfc_conv_expr_reference (se, arg->expr);
       
          return 0;


@@ -2572,8 +2572,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
   gfc_init_block (&post);
   gfc_init_interface_mapping (&mapping);
   need_interface_mapping = ((sym->ts.type == BT_CHARACTER
   gfc_init_block (&post);
   gfc_init_interface_mapping (&mapping);
   need_interface_mapping = ((sym->ts.type == BT_CHARACTER

-                                 && sym->ts.cl->length
-                                 && sym->ts.cl->length->expr_type
+                                 && sym->ts.u.cl->length
+                                 && sym->ts.u.cl->length->expr_type

                                                != EXPR_CONSTANT)
                              || (comp && comp->attr.dimension)
                              || (!comp && sym->attr.dimension));
                                                != EXPR_CONSTANT)
                              || (comp && comp->attr.dimension)
                              || (!comp && sym->attr.dimension));


@@ -2753,11 +2753,11 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
              && parmse.string_length == NULL_TREE
              && e->ts.type == BT_PROCEDURE
              && e->symtree->n.sym->ts.type == BT_CHARACTER
              && parmse.string_length == NULL_TREE
              && e->ts.type == BT_PROCEDURE
              && e->symtree->n.sym->ts.type == BT_CHARACTER

-             && e->symtree->n.sym->ts.cl->length != NULL
-             && e->symtree->n.sym->ts.cl->length->expr_type == EXPR_CONSTANT)
+             && e->symtree->n.sym->ts.u.cl->length != NULL
+             && e->symtree->n.sym->ts.u.cl->length->expr_type == EXPR_CONSTANT)

            {
            {

-             gfc_conv_const_charlen (e->symtree->n.sym->ts.cl);
-             parmse.string_length = e->symtree->n.sym->ts.cl->backend_decl;
+             gfc_conv_const_charlen (e->symtree->n.sym->ts.u.cl);
+             parmse.string_length = e->symtree->n.sym->ts.u.cl->backend_decl;

            }
        }
 
            }
        }
 


@@ -2771,7 +2771,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
         deallocated for non-variable scalars.  Non-variable arrays are
         dealt with in trans-array.c(gfc_conv_array_parameter).  */
       if (e && e->ts.type == BT_DERIVED
         deallocated for non-variable scalars.  Non-variable arrays are
         dealt with in trans-array.c(gfc_conv_array_parameter).  */
       if (e && e->ts.type == BT_DERIVED

-           && e->ts.derived->attr.alloc_comp
+           && e->ts.u.derived->attr.alloc_comp

            && !(e->symtree && e->symtree->n.sym->attr.pointer)
            && (e->expr_type != EXPR_VARIABLE && !e->rank))
         {
            && !(e->symtree && e->symtree->n.sym->attr.pointer)
            && (e->expr_type != EXPR_VARIABLE && !e->rank))
         {


@@ -2798,11 +2798,11 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
            {
              tree local_tmp;
              local_tmp = gfc_evaluate_now (tmp, &se->pre);
            {
              tree local_tmp;
              local_tmp = gfc_evaluate_now (tmp, &se->pre);

-             local_tmp = gfc_copy_alloc_comp (e->ts.derived, local_tmp, tmp, parm_rank);
+             local_tmp = gfc_copy_alloc_comp (e->ts.u.derived, local_tmp, tmp, parm_rank);

              gfc_add_expr_to_block (&se->post, local_tmp);
            }
 
              gfc_add_expr_to_block (&se->post, local_tmp);
            }
 

-         tmp = gfc_deallocate_alloc_comp (e->ts.derived, tmp, parm_rank);
+         tmp = gfc_deallocate_alloc_comp (e->ts.u.derived, tmp, parm_rank);

 
          gfc_add_expr_to_block (&se->post, tmp);
         }
 
          gfc_add_expr_to_block (&se->post, tmp);
         }


@@ -2912,7 +2912,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
     se->string_length = build_int_cst (gfc_charlen_type_node, 1);
   else if (ts.type == BT_CHARACTER)
     {
     se->string_length = build_int_cst (gfc_charlen_type_node, 1);
   else if (ts.type == BT_CHARACTER)
     {

-      if (sym->ts.cl->length == NULL)
+      if (sym->ts.u.cl->length == NULL)

        {
          /* Assumed character length results are not allowed by 5.1.1.5 of the
             standard and are trapped in resolve.c; except in the case of SPREAD
        {
          /* Assumed character length results are not allowed by 5.1.1.5 of the
             standard and are trapped in resolve.c; except in the case of SPREAD


@@ -2927,7 +2927,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
              formal = sym->ns->proc_name->formal;
              for (; formal; formal = formal->next)
                if (strcmp (formal->sym->name, sym->name) == 0)
              formal = sym->ns->proc_name->formal;
              for (; formal; formal = formal->next)
                if (strcmp (formal->sym->name, sym->name) == 0)

-                 cl.backend_decl = formal->sym->ts.cl->backend_decl;
+                 cl.backend_decl = formal->sym->ts.u.cl->backend_decl;

            }
         }
         else
            }
         }
         else


@@ -2937,9 +2937,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
          /* Calculate the length of the returned string.  */
          gfc_init_se (&parmse, NULL);
          if (need_interface_mapping)
          /* Calculate the length of the returned string.  */
          gfc_init_se (&parmse, NULL);
          if (need_interface_mapping)

-           gfc_apply_interface_mapping (&mapping, &parmse, sym->ts.cl->length);
+           gfc_apply_interface_mapping (&mapping, &parmse, sym->ts.u.cl->length);

          else
          else

-           gfc_conv_expr (&parmse, sym->ts.cl->length);
+           gfc_conv_expr (&parmse, sym->ts.u.cl->length);

          gfc_add_block_to_block (&se->pre, &parmse.pre);
          gfc_add_block_to_block (&se->post, &parmse.post);
          
          gfc_add_block_to_block (&se->pre, &parmse.pre);
          gfc_add_block_to_block (&se->post, &parmse.post);
          


@@ -2952,7 +2952,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
       /* Set up a charlen structure for it.  */
       cl.next = NULL;
       cl.length = NULL;
       /* Set up a charlen structure for it.  */
       cl.next = NULL;
       cl.length = NULL;

-      ts.cl = &cl;
+      ts.u.cl = &cl;

 
       len = cl.backend_decl;
     }
 
       len = cl.backend_decl;
     }


@@ -3025,7 +3025,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
       else if (ts.type == BT_CHARACTER)
        {
          /* Pass the string length.  */
       else if (ts.type == BT_CHARACTER)
        {
          /* Pass the string length.  */

-         type = gfc_get_character_type (ts.kind, ts.cl);
+         type = gfc_get_character_type (ts.kind, ts.u.cl);

          type = build_pointer_type (type);
 
          /* Return an address to a char[0:len-1]* temporary for
          type = build_pointer_type (type);
 
          /* Return an address to a char[0:len-1]* temporary for


@@ -3419,8 +3419,8 @@ gfc_conv_statement_function (gfc_se * se, gfc_expr * expr)
          /* Copy string arguments.  */
           tree arglen;
 
          /* Copy string arguments.  */
           tree arglen;
 

-          gcc_assert (fsym->ts.cl && fsym->ts.cl->length
-                     && fsym->ts.cl->length->expr_type == EXPR_CONSTANT);
+          gcc_assert (fsym->ts.u.cl && fsym->ts.u.cl->length
+                     && fsym->ts.u.cl->length->expr_type == EXPR_CONSTANT);

 
           arglen = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
           tmp = gfc_build_addr_expr (build_pointer_type (type),
 
           arglen = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
           tmp = gfc_build_addr_expr (build_pointer_type (type),


@@ -3457,22 +3457,22 @@ gfc_conv_statement_function (gfc_se * se, gfc_expr * expr)
 
   if (sym->ts.type == BT_CHARACTER)
     {
 
   if (sym->ts.type == BT_CHARACTER)
     {

-      gfc_conv_const_charlen (sym->ts.cl);
+      gfc_conv_const_charlen (sym->ts.u.cl);

 
       /* Force the expression to the correct length.  */
       if (!INTEGER_CST_P (se->string_length)
          || tree_int_cst_lt (se->string_length,
 
       /* Force the expression to the correct length.  */
       if (!INTEGER_CST_P (se->string_length)
          || tree_int_cst_lt (se->string_length,

-                             sym->ts.cl->backend_decl))
+                             sym->ts.u.cl->backend_decl))

        {
        {

-         type = gfc_get_character_type (sym->ts.kind, sym->ts.cl);
+         type = gfc_get_character_type (sym->ts.kind, sym->ts.u.cl);

          tmp = gfc_create_var (type, sym->name);
          tmp = gfc_build_addr_expr (build_pointer_type (type), tmp);
          tmp = gfc_create_var (type, sym->name);
          tmp = gfc_build_addr_expr (build_pointer_type (type), tmp);

-         gfc_trans_string_copy (&se->pre, sym->ts.cl->backend_decl, tmp,
+         gfc_trans_string_copy (&se->pre, sym->ts.u.cl->backend_decl, tmp,

                                 sym->ts.kind, se->string_length, se->expr,
                                 sym->ts.kind);
          se->expr = tmp;
        }
                                 sym->ts.kind, se->string_length, se->expr,
                                 sym->ts.kind);
          se->expr = tmp;
        }

-      se->string_length = sym->ts.cl->backend_decl;
+      se->string_length = sym->ts.u.cl->backend_decl;

     }
 
   /* Restore the original variables.  */
     }
 
   /* Restore the original variables.  */


@@ -3559,9 +3559,9 @@ gfc_conv_initializer (gfc_expr * expr, gfc_typespec * ts, tree type,
      used as initialization expressions).  If so, we need to modify
      the 'expr' to be that for a (void *).  */
   if (expr != NULL && expr->ts.type == BT_DERIVED
      used as initialization expressions).  If so, we need to modify
      the 'expr' to be that for a (void *).  */
   if (expr != NULL && expr->ts.type == BT_DERIVED

-      && expr->ts.is_iso_c && expr->ts.derived)
+      && expr->ts.is_iso_c && expr->ts.u.derived)

     {
     {

-      gfc_symbol *derived = expr->ts.derived;
+      gfc_symbol *derived = expr->ts.u.derived;

 
       expr = gfc_int_expr (0);
 
 
       expr = gfc_int_expr (0);
 


@@ -3591,7 +3591,7 @@ gfc_conv_initializer (gfc_expr * expr, gfc_typespec * ts, tree type,
          return se.expr;
 
        case BT_CHARACTER:
          return se.expr;
 
        case BT_CHARACTER:

-         return gfc_conv_string_init (ts->cl->backend_decl,expr);
+         return gfc_conv_string_init (ts->u.cl->backend_decl,expr);

 
        default:
          gfc_init_se (&se, NULL);
 
        default:
          gfc_init_se (&se, NULL);


@@ -3679,7 +3679,7 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr)
 
   gfc_conv_tmp_array_ref (&lse);
   if (cm->ts.type == BT_CHARACTER)
 
   gfc_conv_tmp_array_ref (&lse);
   if (cm->ts.type == BT_CHARACTER)

-    lse.string_length = cm->ts.cl->backend_decl;
+    lse.string_length = cm->ts.u.cl->backend_decl;

 
   gfc_conv_expr (&rse, expr);
 
 
   gfc_conv_expr (&rse, expr);
 


@@ -3766,8 +3766,8 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr)
          gfc_add_block_to_block (&block, &se.pre);
          gfc_add_modify (&block, dest, se.expr);
 
          gfc_add_block_to_block (&block, &se.pre);
          gfc_add_modify (&block, dest, se.expr);
 

-         if (cm->ts.type == BT_DERIVED && cm->ts.derived->attr.alloc_comp)
-           tmp = gfc_copy_alloc_comp (cm->ts.derived, se.expr, dest,
+         if (cm->ts.type == BT_DERIVED && cm->ts.u.derived->attr.alloc_comp)
+           tmp = gfc_copy_alloc_comp (cm->ts.u.derived, se.expr, dest,

                                       cm->as->rank);
          else
            tmp = gfc_duplicate_allocatable (dest, se.expr,
                                       cm->as->rank);
          else
            tmp = gfc_duplicate_allocatable (dest, se.expr,


@@ -3872,7 +3872,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr)
 
       gfc_conv_expr (&se, expr);
       if (cm->ts.type == BT_CHARACTER)
 
       gfc_conv_expr (&se, expr);
       if (cm->ts.type == BT_CHARACTER)

-       lse.string_length = cm->ts.cl->backend_decl;
+       lse.string_length = cm->ts.u.cl->backend_decl;

       lse.expr = dest;
       tmp = gfc_trans_scalar_assign (&lse, &se, cm->ts, true, false);
       gfc_add_expr_to_block (&block, tmp);
       lse.expr = dest;
       tmp = gfc_trans_scalar_assign (&lse, &se, cm->ts, true, false);
       gfc_add_expr_to_block (&block, tmp);


@@ -3892,7 +3892,7 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr)
   tree tmp;
 
   gfc_start_block (&block);
   tree tmp;
 
   gfc_start_block (&block);

-  cm = expr->ts.derived->components;
+  cm = expr->ts.u.derived->components;

   for (c = expr->value.constructor; c; c = c->next, cm = cm->next)
     {
       /* Skip absent members in default initializers.  */
   for (c = expr->value.constructor; c; c = c->next, cm = cm->next)
     {
       /* Skip absent members in default initializers.  */


@@ -3928,13 +3928,13 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init)
   if (!init)
     {
       /* Create a temporary variable and fill it in.  */
   if (!init)
     {
       /* Create a temporary variable and fill it in.  */

-      se->expr = gfc_create_var (type, expr->ts.derived->name);
+      se->expr = gfc_create_var (type, expr->ts.u.derived->name);

       tmp = gfc_trans_structure_assign (se->expr, expr);
       gfc_add_expr_to_block (&se->pre, tmp);
       return;
     }
 
       tmp = gfc_trans_structure_assign (se->expr, expr);
       gfc_add_expr_to_block (&se->pre, tmp);
       return;
     }
 

-  cm = expr->ts.derived->components;
+  cm = expr->ts.u.derived->components;

 
   for (c = expr->value.constructor; c; c = c->next, cm = cm->next)
     {
 
   for (c = expr->value.constructor; c; c = c->next, cm = cm->next)
     {


@@ -4004,8 +4004,8 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr)
      null_pointer_node.  C_PTR and C_FUNPTR are converted to match the
      typespec for the C_PTR and C_FUNPTR symbols, which has already been
      updated to be an integer with a kind equal to the size of a (void *).  */
      null_pointer_node.  C_PTR and C_FUNPTR are converted to match the
      typespec for the C_PTR and C_FUNPTR symbols, which has already been
      updated to be an integer with a kind equal to the size of a (void *).  */

-  if (expr->ts.type == BT_DERIVED && expr->ts.derived
-      && expr->ts.derived->attr.is_iso_c)
+  if (expr->ts.type == BT_DERIVED && expr->ts.u.derived
+      && expr->ts.u.derived->attr.is_iso_c)

     {
       if (expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_PTR
           || expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_FUNPTR)
     {
       if (expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_PTR
           || expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_FUNPTR)


@@ -4018,9 +4018,9 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr)
         {
           /* Update the type/kind of the expression to be what the new
              type/kind are for the updated symbols of C_PTR/C_FUNPTR.  */
         {
           /* Update the type/kind of the expression to be what the new
              type/kind are for the updated symbols of C_PTR/C_FUNPTR.  */

-          expr->ts.type = expr->ts.derived->ts.type;
-          expr->ts.f90_type = expr->ts.derived->ts.f90_type;
-          expr->ts.kind = expr->ts.derived->ts.kind;
+          expr->ts.type = expr->ts.u.derived->ts.type;
+          expr->ts.f90_type = expr->ts.u.derived->ts.f90_type;
+          expr->ts.kind = expr->ts.u.derived->ts.kind;

         }
     }
   
         }
     }
   


@@ -4389,7 +4389,7 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
       gfc_trans_string_copy (&block, llen, lse->expr, ts.kind, rlen,
                             rse->expr, ts.kind);
     }
       gfc_trans_string_copy (&block, llen, lse->expr, ts.kind, rlen,
                             rse->expr, ts.kind);
     }

-  else if (ts.type == BT_DERIVED && ts.derived->attr.alloc_comp)
+  else if (ts.type == BT_DERIVED && ts.u.derived->attr.alloc_comp)

     {
       cond = NULL_TREE;
        
     {
       cond = NULL_TREE;
        


@@ -4409,7 +4409,7 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
       if (!l_is_temp)
        {
          tmp = gfc_evaluate_now (lse->expr, &lse->pre);
       if (!l_is_temp)
        {
          tmp = gfc_evaluate_now (lse->expr, &lse->pre);

-         tmp = gfc_deallocate_alloc_comp (ts.derived, tmp, 0);
+         tmp = gfc_deallocate_alloc_comp (ts.u.derived, tmp, 0);

          if (r_is_var)
            tmp = build3_v (COND_EXPR, cond, build_empty_stmt (input_location),
                            tmp);
          if (r_is_var)
            tmp = build3_v (COND_EXPR, cond, build_empty_stmt (input_location),
                            tmp);


@@ -4426,7 +4426,7 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
         same as the lhs.  */
       if (r_is_var)
        {
         same as the lhs.  */
       if (r_is_var)
        {

-         tmp = gfc_copy_alloc_comp (ts.derived, rse->expr, lse->expr, 0);
+         tmp = gfc_copy_alloc_comp (ts.u.derived, rse->expr, lse->expr, 0);

          tmp = build3_v (COND_EXPR, cond, build_empty_stmt (input_location),
                          tmp);
          gfc_add_expr_to_block (&block, tmp);
          tmp = build3_v (COND_EXPR, cond, build_empty_stmt (input_location),
                          tmp);
          gfc_add_expr_to_block (&block, tmp);


@@ -4504,16 +4504,16 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
      character lengths are the same.  */
   if (expr2->ts.type == BT_CHARACTER && expr2->rank > 0)
     {
      character lengths are the same.  */
   if (expr2->ts.type == BT_CHARACTER && expr2->rank > 0)
     {

-      if (expr1->ts.cl->length == NULL
-           || expr1->ts.cl->length->expr_type != EXPR_CONSTANT)
+      if (expr1->ts.u.cl->length == NULL
+           || expr1->ts.u.cl->length->expr_type != EXPR_CONSTANT)

        return NULL;
 
        return NULL;
 

-      if (expr2->ts.cl->length == NULL
-           || expr2->ts.cl->length->expr_type != EXPR_CONSTANT)
+      if (expr2->ts.u.cl->length == NULL
+           || expr2->ts.u.cl->length->expr_type != EXPR_CONSTANT)

        return NULL;
 
        return NULL;
 

-      if (mpz_cmp (expr1->ts.cl->length->value.integer,
-                    expr2->ts.cl->length->value.integer) != 0)
+      if (mpz_cmp (expr1->ts.u.cl->length->value.integer,
+                    expr2->ts.u.cl->length->value.integer) != 0)

        return NULL;
     }
 
        return NULL;
     }
 


@@ -4887,13 +4887,13 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag)
      to arrays must be done with a deep copy and the rhs temporary
      must have its components deallocated afterwards.  */
   scalar_to_array = (expr2->ts.type == BT_DERIVED
      to arrays must be done with a deep copy and the rhs temporary
      must have its components deallocated afterwards.  */
   scalar_to_array = (expr2->ts.type == BT_DERIVED

-                      && expr2->ts.derived->attr.alloc_comp
+                      && expr2->ts.u.derived->attr.alloc_comp

                       && expr2->expr_type != EXPR_VARIABLE
                       && !gfc_is_constant_expr (expr2)
                       && expr1->rank && !expr2->rank);
   if (scalar_to_array)
     {
                       && expr2->expr_type != EXPR_VARIABLE
                       && !gfc_is_constant_expr (expr2)
                       && expr1->rank && !expr2->rank);
   if (scalar_to_array)
     {

-      tmp = gfc_deallocate_alloc_comp (expr2->ts.derived, rse.expr, 0);
+      tmp = gfc_deallocate_alloc_comp (expr2->ts.u.derived, rse.expr, 0);

       gfc_add_expr_to_block (&loop.post, tmp);
     }
 
       gfc_add_expr_to_block (&loop.post, tmp);
     }
 


@@ -4983,7 +4983,7 @@ copyable_array_p (gfc_expr * expr)
       return false;
 
     case BT_DERIVED:
       return false;
 
     case BT_DERIVED:

-      return !expr->ts.derived->attr.alloc_comp;
+      return !expr->ts.u.derived->attr.alloc_comp;

 
     default:
       break;
 
     default:
       break;

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 7793432..3b2cbd1 100644 (file)
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -3479,7 +3479,7 @@ gfc_conv_intrinsic_len (gfc_se * se, gfc_expr * expr)
                && (sym->result == sym))
            decl = gfc_get_fake_result_decl (sym, 0);
 
                && (sym->result == sym))
            decl = gfc_get_fake_result_decl (sym, 0);
 

-         len = sym->ts.cl->backend_decl;
+         len = sym->ts.u.cl->backend_decl;

          gcc_assert (len);
          break;
        }
          gcc_assert (len);
          break;
        }


@@ -4629,7 +4629,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
       nonzero_charlen = NULL_TREE;
       if (arg1->expr->ts.type == BT_CHARACTER)
        nonzero_charlen = fold_build2 (NE_EXPR, boolean_type_node,
       nonzero_charlen = NULL_TREE;
       if (arg1->expr->ts.type == BT_CHARACTER)
        nonzero_charlen = fold_build2 (NE_EXPR, boolean_type_node,

-                                      arg1->expr->ts.cl->backend_decl,
+                                      arg1->expr->ts.u.cl->backend_decl,

                                       integer_zero_node);
 
       if (ss1 == gfc_ss_terminator)
                                       integer_zero_node);
 
       if (ss1 == gfc_ss_terminator)


@@ -4883,7 +4883,7 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr)
   dlen = fold_build2 (MULT_EXPR, gfc_charlen_type_node,
                      fold_convert (gfc_charlen_type_node, slen),
                      fold_convert (gfc_charlen_type_node, ncopies));
   dlen = fold_build2 (MULT_EXPR, gfc_charlen_type_node,
                      fold_convert (gfc_charlen_type_node, slen),
                      fold_convert (gfc_charlen_type_node, ncopies));

-  type = gfc_get_character_type (expr->ts.kind, expr->ts.cl);
+  type = gfc_get_character_type (expr->ts.kind, expr->ts.u.cl);

   dest = gfc_conv_string_tmp (se, build_pointer_type (type), dlen);
 
   /* Generate the code to do the repeat operation:
   dest = gfc_conv_string_tmp (se, build_pointer_type (type), dlen);
 
   /* Generate the code to do the repeat operation:

diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 35f87bc..0f6e0a5 100644 (file)
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -1591,7 +1591,7 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
   dt_parm_addr = gfc_build_addr_expr (NULL_TREE, dt_parm);
 
   if (ts->type == BT_CHARACTER)
   dt_parm_addr = gfc_build_addr_expr (NULL_TREE, dt_parm);
 
   if (ts->type == BT_CHARACTER)

-    tmp = ts->cl->backend_decl;
+    tmp = ts->u.cl->backend_decl;

   else
     tmp = build_int_cst (gfc_charlen_type_node, 0);
   tmp = build_call_expr_loc (input_location,
   else
     tmp = build_int_cst (gfc_charlen_type_node, 0);
   tmp = build_call_expr_loc (input_location,


@@ -1624,7 +1624,7 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
       tree expr = build_fold_indirect_ref_loc (input_location,
                                           addr_expr);
 
       tree expr = build_fold_indirect_ref_loc (input_location,
                                           addr_expr);
 

-      for (cmp = ts->derived->components; cmp; cmp = cmp->next)
+      for (cmp = ts->u.derived->components; cmp; cmp = cmp->next)

        {
          char *full_name = nml_full_name (var_name, cmp->name);
          transfer_namelist_element (block,
        {
          char *full_name = nml_full_name (var_name, cmp->name);
          transfer_namelist_element (block,


@@ -2005,8 +2005,9 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
      C_NULL_PTR or C_NULL_FUNPTR.  We could also get a user variable of
      type C_PTR or C_FUNPTR, in which case the ts->type may no longer be
      BT_DERIVED (could have been changed by gfc_conv_expr).  */
      C_NULL_PTR or C_NULL_FUNPTR.  We could also get a user variable of
      type C_PTR or C_FUNPTR, in which case the ts->type may no longer be
      BT_DERIVED (could have been changed by gfc_conv_expr).  */

-  if ((ts->type == BT_DERIVED && ts->is_iso_c == 1 && ts->derived != NULL)
-      || (ts->derived != NULL && ts->derived->ts.is_iso_c == 1))
+  if ((ts->type == BT_DERIVED || ts->type == BT_INTEGER)
+      && ts->u.derived != NULL
+      && (ts->is_iso_c == 1 || ts->u.derived->ts.is_iso_c == 1))

     {
       /* C_PTR and C_FUNPTR have private components which means they can not
          be printed.  However, if -std=gnu and not -pedantic, allow
     {
       /* C_PTR and C_FUNPTR have private components which means they can not
          be printed.  However, if -std=gnu and not -pedantic, allow


@@ -2014,14 +2015,14 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
       if (gfc_notification_std (GFC_STD_GNU) != SILENT)
        {
          gfc_error_now ("Derived type '%s' at %L has PRIVATE components",
       if (gfc_notification_std (GFC_STD_GNU) != SILENT)
        {
          gfc_error_now ("Derived type '%s' at %L has PRIVATE components",

-                        ts->derived->name, code != NULL ? &(code->loc) : 
+                        ts->u.derived->name, code != NULL ? &(code->loc) : 

                         &gfc_current_locus);
          return;
        }
 
                         &gfc_current_locus);
          return;
        }
 

-      ts->type = ts->derived->ts.type;
-      ts->kind = ts->derived->ts.kind;
-      ts->f90_type = ts->derived->ts.f90_type;
+      ts->type = ts->u.derived->ts.type;
+      ts->kind = ts->u.derived->ts.kind;
+      ts->f90_type = ts->u.derived->ts.f90_type;

     }
   
   kind = ts->kind;
     }
   
   kind = ts->kind;


@@ -2093,7 +2094,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
       expr = build_fold_indirect_ref_loc (input_location,
                                      expr);
 
       expr = build_fold_indirect_ref_loc (input_location,
                                      expr);
 

-      for (c = ts->derived->components; c; c = c->next)
+      for (c = ts->u.derived->components; c; c = c->next)

        {
          field = c->backend_decl;
          gcc_assert (field && TREE_CODE (field) == FIELD_DECL);
        {
          field = c->backend_decl;
          gcc_assert (field && TREE_CODE (field) == FIELD_DECL);

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 6a1fb01..9359437 100644 (file)
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1830,7 +1830,7 @@ check_forall_dependencies (gfc_code *c, stmtblock_t *pre, stmtblock_t *post)
      pointer components.  We therefore leave these to their
      own devices.  */
   if (lsym->ts.type == BT_DERIVED
      pointer components.  We therefore leave these to their
      own devices.  */
   if (lsym->ts.type == BT_DERIVED

-       && lsym->ts.derived->attr.pointer_comp)
+       && lsym->ts.u.derived->attr.pointer_comp)

     return need_temp;
 
   new_symtree = NULL;
     return need_temp;
 
   new_symtree = NULL;


@@ -2539,17 +2539,17 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
                                        &lss, &rss);
 
   /* The type of LHS. Used in function allocate_temp_for_forall_nest */
                                        &lss, &rss);
 
   /* The type of LHS. Used in function allocate_temp_for_forall_nest */

-  if (expr1->ts.type == BT_CHARACTER && expr1->ts.cl->length)
+  if (expr1->ts.type == BT_CHARACTER && expr1->ts.u.cl->length)

     {
     {

-      if (!expr1->ts.cl->backend_decl)
+      if (!expr1->ts.u.cl->backend_decl)

        {
          gfc_se tse;
          gfc_init_se (&tse, NULL);
        {
          gfc_se tse;
          gfc_init_se (&tse, NULL);

-         gfc_conv_expr (&tse, expr1->ts.cl->length);
-         expr1->ts.cl->backend_decl = tse.expr;
+         gfc_conv_expr (&tse, expr1->ts.u.cl->length);
+         expr1->ts.u.cl->backend_decl = tse.expr;

        }
       type = gfc_get_character_type_len (gfc_default_character_kind,
        }
       type = gfc_get_character_type_len (gfc_default_character_kind,

-                                        expr1->ts.cl->backend_decl);
+                                        expr1->ts.u.cl->backend_decl);

     }
   else
     type = gfc_typenode_for_spec (&expr1->ts);
     }
   else
     type = gfc_typenode_for_spec (&expr1->ts);


@@ -4024,10 +4024,10 @@ gfc_trans_allocate (gfc_code * code)
              gfc_add_expr_to_block (&se.pre, tmp);
            }
 
              gfc_add_expr_to_block (&se.pre, tmp);
            }
 

-         if (expr->ts.type == BT_DERIVED && expr->ts.derived->attr.alloc_comp)
+         if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp)

            {
              tmp = build_fold_indirect_ref_loc (input_location, se.expr);
            {
              tmp = build_fold_indirect_ref_loc (input_location, se.expr);

-             tmp = gfc_nullify_alloc_comp (expr->ts.derived, tmp, 0);
+             tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, tmp, 0);

              gfc_add_expr_to_block (&se.pre, tmp);
            }
 
              gfc_add_expr_to_block (&se.pre, tmp);
            }
 


@@ -4130,7 +4130,7 @@ gfc_trans_deallocate (gfc_code *code)
       se.descriptor_only = 1;
       gfc_conv_expr (&se, expr);
 
       se.descriptor_only = 1;
       gfc_conv_expr (&se, expr);
 

-      if (expr->ts.type == BT_DERIVED && expr->ts.derived->attr.alloc_comp)
+      if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp)

         {
          gfc_ref *ref;
          gfc_ref *last = NULL;
         {
          gfc_ref *ref;
          gfc_ref *last = NULL;


@@ -4143,7 +4143,7 @@ gfc_trans_deallocate (gfc_code *code)
          if (!(last && last->u.c.component->attr.pointer)
                && !(!last && expr->symtree->n.sym->attr.pointer))
            {
          if (!(last && last->u.c.component->attr.pointer)
                && !(!last && expr->symtree->n.sym->attr.pointer))
            {

-             tmp = gfc_deallocate_alloc_comp (expr->ts.derived, se.expr,
+             tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, se.expr,

                                               expr->rank);
              gfc_add_expr_to_block (&se.pre, tmp);
            }
                                               expr->rank);
              gfc_add_expr_to_block (&se.pre, tmp);
            }

diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 4b19871..8cc63c2 100644 (file)
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1000,8 +1000,8 @@ gfc_typenode_for_spec (gfc_typespec * spec)
          C_FUNPTR to simple variables that get translated to (void *).  */
       if (spec->f90_type == BT_VOID)
        {
          C_FUNPTR to simple variables that get translated to (void *).  */
       if (spec->f90_type == BT_VOID)
        {

-         if (spec->derived
-             && spec->derived->intmod_sym_id == ISOCBINDING_PTR)
+         if (spec->u.derived
+             && spec->u.derived->intmod_sym_id == ISOCBINDING_PTR)

            basetype = ptr_type_node;
          else
            basetype = pfunc_type_node;
            basetype = ptr_type_node;
          else
            basetype = pfunc_type_node;


@@ -1023,21 +1023,21 @@ gfc_typenode_for_spec (gfc_typespec * spec)
       break;
 
     case BT_CHARACTER:
       break;
 
     case BT_CHARACTER:

-      basetype = gfc_get_character_type (spec->kind, spec->cl);
+      basetype = gfc_get_character_type (spec->kind, spec->u.cl);

       break;
 
     case BT_DERIVED:
       break;
 
     case BT_DERIVED:

-      basetype = gfc_get_derived_type (spec->derived);
+      basetype = gfc_get_derived_type (spec->u.derived);

 
       /* If we're dealing with either C_PTR or C_FUNPTR, we modified the
          type and kind to fit a (void *) and the basetype returned was a
          ptr_type_node.  We need to pass up this new information to the
          symbol that was declared of type C_PTR or C_FUNPTR.  */
 
       /* If we're dealing with either C_PTR or C_FUNPTR, we modified the
          type and kind to fit a (void *) and the basetype returned was a
          ptr_type_node.  We need to pass up this new information to the
          symbol that was declared of type C_PTR or C_FUNPTR.  */

-      if (spec->derived->attr.is_iso_c)
+      if (spec->u.derived->attr.is_iso_c)

         {
         {

-          spec->type = spec->derived->ts.type;
-          spec->kind = spec->derived->ts.kind;
-          spec->f90_type = spec->derived->ts.f90_type;
+          spec->type = spec->u.derived->ts.type;
+          spec->kind = spec->u.derived->ts.kind;
+          spec->f90_type = spec->u.derived->ts.f90_type;

         }
       break;
     case BT_VOID:
         }
       break;
     case BT_VOID:


@@ -1046,8 +1046,8 @@ gfc_typenode_for_spec (gfc_typespec * spec)
       basetype = ptr_type_node;
       if (spec->f90_type == BT_VOID)
        {
       basetype = ptr_type_node;
       if (spec->f90_type == BT_VOID)
        {

-         if (spec->derived
-             && spec->derived->intmod_sym_id == ISOCBINDING_PTR)
+         if (spec->u.derived
+             && spec->u.derived->intmod_sym_id == ISOCBINDING_PTR)

            basetype = ptr_type_node;
          else
            basetype = pfunc_type_node;
            basetype = ptr_type_node;
          else
            basetype = pfunc_type_node;


@@ -1765,7 +1765,7 @@ gfc_sym_type (gfc_symbol * sym)
             base type.  */
          if (sym->ts.type != BT_CHARACTER
              || !(sym->attr.dummy || sym->attr.function)
             base type.  */
          if (sym->ts.type != BT_CHARACTER
              || !(sym->attr.dummy || sym->attr.function)

-             || sym->ts.cl->backend_decl)
+             || sym->ts.u.cl->backend_decl)

            {
              type = gfc_get_nodesc_array_type (type, sym->as,
                                                byref ? PACKED_FULL
            {
              type = gfc_get_nodesc_array_type (type, sym->as,
                                                byref ? PACKED_FULL


@@ -1879,10 +1879,10 @@ copy_dt_decls_ifequal (gfc_symbol *from, gfc_symbol *to,
       to_cm->backend_decl = from_cm->backend_decl;
       if ((!from_cm->attr.pointer || from_gsym)
              && from_cm->ts.type == BT_DERIVED)
       to_cm->backend_decl = from_cm->backend_decl;
       if ((!from_cm->attr.pointer || from_gsym)
              && from_cm->ts.type == BT_DERIVED)

-       gfc_get_derived_type (to_cm->ts.derived);
+       gfc_get_derived_type (to_cm->ts.u.derived);

 
       else if (from_cm->ts.type == BT_CHARACTER)
 
       else if (from_cm->ts.type == BT_CHARACTER)

-       to_cm->ts.cl->backend_decl = from_cm->ts.cl->backend_decl;
+       to_cm->ts.u.cl->backend_decl = from_cm->ts.u.cl->backend_decl;

     }
 
   return 1;
     }
 
   return 1;


@@ -1898,7 +1898,7 @@ gfc_get_ppc_type (gfc_component* c)
   if (c->attr.function && !c->attr.dimension)
     {
       if (c->ts.type == BT_DERIVED)
   if (c->attr.function && !c->attr.dimension)
     {
       if (c->ts.type == BT_DERIVED)

-       t = c->ts.derived->backend_decl;
+       t = c->ts.u.derived->backend_decl;

       else
        t = gfc_typenode_for_spec (&c->ts);
     }
       else
        t = gfc_typenode_for_spec (&c->ts);
     }


@@ -2038,17 +2038,17 @@ gfc_get_derived_type (gfc_symbol * derived)
        continue;
 
       if ((!c->attr.pointer && !c->attr.proc_pointer)
        continue;
 
       if ((!c->attr.pointer && !c->attr.proc_pointer)

-         || c->ts.derived->backend_decl == NULL)
-       c->ts.derived->backend_decl = gfc_get_derived_type (c->ts.derived);
+         || c->ts.u.derived->backend_decl == NULL)
+       c->ts.u.derived->backend_decl = gfc_get_derived_type (c->ts.u.derived);

 
 

-      if (c->ts.derived && c->ts.derived->attr.is_iso_c)
+      if (c->ts.u.derived && c->ts.u.derived->attr.is_iso_c)

         {
           /* Need to copy the modified ts from the derived type.  The
              typespec was modified because C_PTR/C_FUNPTR are translated
              into (void *) from derived types.  */
         {
           /* Need to copy the modified ts from the derived type.  The
              typespec was modified because C_PTR/C_FUNPTR are translated
              into (void *) from derived types.  */

-          c->ts.type = c->ts.derived->ts.type;
-          c->ts.kind = c->ts.derived->ts.kind;
-          c->ts.f90_type = c->ts.derived->ts.f90_type;
+          c->ts.type = c->ts.u.derived->ts.type;
+          c->ts.kind = c->ts.u.derived->ts.kind;
+          c->ts.f90_type = c->ts.u.derived->ts.f90_type;

          if (c->initializer)
            {
              c->initializer->ts.type = c->ts.type;
          if (c->initializer)
            {
              c->initializer->ts.type = c->ts.type;


@@ -2070,14 +2070,14 @@ gfc_get_derived_type (gfc_symbol * derived)
       if (c->attr.proc_pointer)
        field_type = gfc_get_ppc_type (c);
       else if (c->ts.type == BT_DERIVED)
       if (c->attr.proc_pointer)
        field_type = gfc_get_ppc_type (c);
       else if (c->ts.type == BT_DERIVED)

-        field_type = c->ts.derived->backend_decl;
+        field_type = c->ts.u.derived->backend_decl;

       else
        {
          if (c->ts.type == BT_CHARACTER)
            {
              /* Evaluate the string length.  */
       else
        {
          if (c->ts.type == BT_CHARACTER)
            {
              /* Evaluate the string length.  */

-             gfc_conv_const_charlen (c->ts.cl);
-             gcc_assert (c->ts.cl->backend_decl);
+             gfc_conv_const_charlen (c->ts.u.cl);
+             gcc_assert (c->ts.u.cl->backend_decl);

            }
 
          field_type = gfc_typenode_for_spec (&c->ts);
            }
 
          field_type = gfc_typenode_for_spec (&c->ts);


@@ -2261,7 +2261,7 @@ gfc_get_function_type (gfc_symbol * sym)
     arg = sym;
 
   if (arg->ts.type == BT_CHARACTER)
     arg = sym;
 
   if (arg->ts.type == BT_CHARACTER)

-    gfc_conv_const_charlen (arg->ts.cl);
+    gfc_conv_const_charlen (arg->ts.u.cl);

 
   /* Some functions we use an extra parameter for the return value.  */
   if (gfc_return_by_reference (sym))
 
   /* Some functions we use an extra parameter for the return value.  */
   if (gfc_return_by_reference (sym))


@@ -2286,7 +2286,7 @@ gfc_get_function_type (gfc_symbol * sym)
          /* Evaluate constant character lengths here so that they can be
             included in the type.  */
          if (arg->ts.type == BT_CHARACTER)
          /* Evaluate constant character lengths here so that they can be
             included in the type.  */
          if (arg->ts.type == BT_CHARACTER)

-           gfc_conv_const_charlen (arg->ts.cl);
+           gfc_conv_const_charlen (arg->ts.u.cl);

 
          if (arg->attr.flavor == FL_PROCEDURE)
            {
 
          if (arg->attr.flavor == FL_PROCEDURE)
            {