re PR fortran/40941 (gfc_typespec: put derived and cl into union)

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.

From-SVN: r150725

1 files changed, 27 insertions, 27 deletions

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index daa46d8..60096e2 100644
--- 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!  */
-      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;
 
-      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;
 
-      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;
@@ -454,10 +454,10 @@ gfc_compare_types (gfc_typespec *ts1, gfc_typespec *ts2)
     return (ts1->kind == ts2->kind);
 
   /* Compare derived types.  */
-  if (ts1->derived == ts2->derived)
+  if (ts1->u.derived == ts2->u.derived)
     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
-      && 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.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)
@@ -1551,9 +1551,9 @@ get_sym_storage_size (gfc_symbol *sym)
 
   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;
     }
@@ -1599,11 +1599,11 @@ get_expr_storage_size (gfc_expr *e)
   
   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
-	       && (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;
@@ -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
-	   && 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))
-	   && (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",
-			  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",
-			  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;
 	 }