re PR fortran/38936 ([F03] ASSOCIATE construct / improved SELECT TYPE (a=>expr))

2010-06-10  Daniel Kraft  <d@domob.eu>

	PR fortran/38936
	* gfortran.h (enum gfc_statement): Add ST_ASSOCIATE, ST_END_ASSOCIATE.
	(struct gfc_symbol): New field `assoc'.
	(struct gfc_association_list): New struct.
	(struct gfc_code): New struct `block' in union, move `ns' there
	and add association list.
	(gfc_free_association_list): New method.
	(gfc_has_vector_subscript): Made public;
	* match.h (gfc_match_associate): New method.
	* parse.h (enum gfc_compile_state): Add COMP_ASSOCIATE.
	* decl.c (gfc_match_end): Handle ST_END_ASSOCIATE.
	* interface.c (gfc_has_vector_subscript): Made public.
	(compare_actual_formal): Rename `has_vector_subscript' accordingly.
	* match.c (gfc_match_associate): New method.
	(gfc_match_select_type): Change reference to gfc_code's `ns' field.
	* primary.c (match_variable): Don't allow names associated to expr here.
	* parse.c (decode_statement): Try matching ASSOCIATE statement.
	(case_exec_markers, case_end): Add ASSOCIATE statement.
	(gfc_ascii_statement): Hande ST_ASSOCIATE and ST_END_ASSOCIATE.
	(parse_associate): New method.
	(parse_executable): Handle ST_ASSOCIATE.
	(parse_block_construct): Change reference to gfc_code's `ns' field.
	* resolve.c (resolve_select_type): Ditto.
	(resolve_code): Ditto.
	(resolve_block_construct): Ditto and add comment.
	(resolve_select_type): Set association list in generated BLOCK to NULL.
	(resolve_symbol): Resolve associate names.
	* st.c (gfc_free_statement): Change reference to gfc_code's `ns' field
	and free association list.
	(gfc_free_association_list): New method.
	* symbol.c (gfc_new_symbol): NULL new field `assoc'.
	* trans-stmt.c (gfc_trans_block_construct): Change reference to
	gfc_code's `ns' field.

2010-06-10  Daniel Kraft  <d@domob.eu>

	PR fortran/38936
	* gfortran.dg/associate_1.f03: New test.
	* gfortran.dg/associate_2.f95: New test.
	* gfortran.dg/associate_3.f03: New test.
	* gfortran.dg/associate_4.f08: New test.

From-SVN: r160550

1 files changed, 20 insertions, 7 deletions

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 8fabf4e..5f920c9 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7158,7 +7158,7 @@ resolve_select_type (gfc_code *code)
   gfc_namespace *ns;
   int error = 0;
 
-  ns = code->ext.ns;
+  ns = code->ext.block.ns;
   gfc_resolve (ns);
 
   /* Check for F03:C813.  */
@@ -7245,6 +7245,7 @@ resolve_select_type (gfc_code *code)
   else
     ns->code->next = new_st;
   code->op = EXEC_BLOCK;
+  code->ext.block.assoc = NULL;
   code->expr1 = code->expr2 =  NULL;
   code->block = NULL;
 
@@ -7988,10 +7989,11 @@ gfc_resolve_forall (gfc_code *code, gfc_namespace *ns, int forall_save)
 static void
 resolve_block_construct (gfc_code* code)
 {
-  /* Eventually, we may want to do some checks here or handle special stuff.
-     But so far the only thing we can do is resolving the local namespace.  */
+  /* For an ASSOCIATE block, the associations (and their targets) are already
+     resolved during gfc_resolve_symbol.  */
 
-  gfc_resolve (code->ext.ns);
+  /* Resolve the BLOCK's namespace.  */
+  gfc_resolve (code->ext.block.ns);
 }
 
 
@@ -8312,7 +8314,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
 	      gfc_resolve_omp_do_blocks (code, ns);
 	      break;
 	    case EXEC_SELECT_TYPE:
-	      gfc_current_ns = code->ext.ns;
+	      gfc_current_ns = code->ext.block.ns;
 	      gfc_resolve_blocks (code->block, gfc_current_ns);
 	      gfc_current_ns = ns;
 	      break;
@@ -8476,7 +8478,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
 	  break;
 
 	case EXEC_BLOCK:
-	  gfc_resolve (code->ext.ns);
+	  gfc_resolve (code->ext.block.ns);
 	  break;
 
 	case EXEC_DO:
@@ -11341,7 +11343,6 @@ resolve_symbol (gfc_symbol *sym)
      can.  */
   mp_flag = (sym->result != NULL && sym->result != sym);
 
-
   /* Make sure that the intrinsic is consistent with its internal 
      representation. This needs to be done before assigning a default 
      type to avoid spurious warnings.  */
@@ -11349,6 +11350,18 @@ resolve_symbol (gfc_symbol *sym)
       && resolve_intrinsic (sym, &sym->declared_at) == FAILURE)
     return;
 
+  /* For associate names, resolve corresponding expression and make sure
+     they get their type-spec set this way.  */
+  if (sym->assoc)
+    {
+      gcc_assert (sym->attr.flavor == FL_VARIABLE);
+      if (gfc_resolve_expr (sym->assoc->target) != SUCCESS)
+	return;
+
+      sym->ts = sym->assoc->target->ts;
+      gcc_assert (sym->ts.type != BT_UNKNOWN);
+    }
+
   /* Assign default type to symbols that need one and don't have one.  */
   if (sym->ts.type == BT_UNKNOWN)
     {