expr.c (gfc_check_pointer_assign): Do the correct type checking when CLASS variables are involved.

2009-10-07  Janus Weil  <janus@gcc.gnu.org>

	* expr.c (gfc_check_pointer_assign): Do the correct type checking when
	CLASS variables are involved.
	* match.c (gfc_match_select_type): Parse associate-name in SELECT TYPE
	statements, and set up a local namespace for the SELECT TYPE block.
	* parse.h (gfc_build_block_ns): New prototype.
	* parse.c (parse_select_type_block): Return from local namespace to its
	parent after SELECT TYPE block.
	(gfc_build_block_ns): New function for setting up the local namespace
	for a BLOCK construct.
	(parse_block_construct): Use gfc_build_block_ns.
	* resolve.c (resolve_select_type): Insert assignment for the selector
	variable, in case an associate-name is given, and put the SELECT TYPE
	statement inside a BLOCK.
	(resolve_code): Call resolve_class_assign after checking the assignment.
	* symbol.c (gfc_find_sym_tree): Moved some code here from
	gfc_get_ha_sym_tree.
	(gfc_get_ha_sym_tree): Moved some code to gfc_find_sym_tree.


2009-10-07  Janus Weil  <janus@gcc.gnu.org>

	* gfortran.dg/same_type_as_2.f03: Modified (was illegal).
	* gfortran.dg/select_type_1.f03: Modified error message.
	* gfortran.dg/select_type_5.f03: New test.

From-SVN: r152526

1 files changed, 24 insertions, 15 deletions

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 13199c9..770c7ef 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -2909,12 +2909,8 @@ parse_select_type_block (void)
       if (st == ST_NONE)
 	unexpected_eof ();
       if (st == ST_END_SELECT)
-	{
-	  /* Empty SELECT CASE is OK.  */
-	  accept_statement (st);
-	  pop_state ();
-	  return;
-	}
+	/* Empty SELECT CASE is OK.  */
+	goto done;
       if (st == ST_TYPE_IS || st == ST_CLASS_IS)
 	break;
 
@@ -2959,8 +2955,10 @@ parse_select_type_block (void)
     }
   while (st != ST_END_SELECT);
 
+done:
   pop_state ();
   accept_statement (st);
+  gfc_current_ns = gfc_current_ns->parent;
 }
 
 
@@ -3033,18 +3031,13 @@ check_do_closure (void)
 static void parse_progunit (gfc_statement);
 
 
-/* Parse a BLOCK construct.  */
+/* Set up the local namespace for a BLOCK construct.  */
 
-static void
-parse_block_construct (void)
+gfc_namespace*
+gfc_build_block_ns (gfc_namespace *parent_ns)
 {
-  gfc_namespace* parent_ns;
   gfc_namespace* my_ns;
-  gfc_state_data s;
 
-  gfc_notify_std (GFC_STD_F2008, "Fortran 2008: BLOCK construct at %C");
-
-  parent_ns = gfc_current_ns;
   my_ns = gfc_get_namespace (parent_ns, 1);
   my_ns->construct_entities = 1;
 
@@ -3066,6 +3059,22 @@ parse_block_construct (void)
     }
   my_ns->proc_name->attr.recursive = parent_ns->proc_name->attr.recursive;
 
+  return my_ns;
+}
+
+
+/* Parse a BLOCK construct.  */
+
+static void
+parse_block_construct (void)
+{
+  gfc_namespace* my_ns;
+  gfc_state_data s;
+
+  gfc_notify_std (GFC_STD_F2008, "Fortran 2008: BLOCK construct at %C");
+
+  my_ns = gfc_build_block_ns (gfc_current_ns);
+
   new_st.op = EXEC_BLOCK;
   new_st.ext.ns = my_ns;
   accept_statement (ST_BLOCK);
@@ -3075,7 +3084,7 @@ parse_block_construct (void)
 
   parse_progunit (ST_NONE);
 
-  gfc_current_ns = parent_ns;
+  gfc_current_ns = gfc_current_ns->parent;
   pop_state ();
 }