re PR fortran/69834 ([OOP] Collision in derived type hashes)

2016-10-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/69834
	* class.c (gfc_find_derived_vtab): Obtain the gsymbol for the
	derived type's module. If the gsymbol is present and the top
	level namespace corresponds to a module, use the gsymbol name
	space. In the search to see if the vtable exists, try the gsym
	namespace first.
	* dump-parse-tree (show_code_node): Modify select case dump to
	show select type construct.
	* resolve.c (build_loc_call): New function.
	(resolve_select_type): Add check for repeated type is cases.
	Retain selector expression and use it later instead of expr1.
	Exclude deferred length TYPE IS cases and emit error message.
	Store the address for the vtable in the 'low' expression and
	the hash value in the 'high' expression, for each case. Do not
	call resolve_select.
	* trans.c(trans_code) : Call gfc_trans_select_type.
	* trans-stmt.c (gfc_trans_select_type_cases): New function.
	(gfc_trans_select_type): New function.
	* trans-stmt.h : Add prototype for gfc_trans_select_type.

2016-10-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/69834
	* gfortran.dg/select_type_1.f03: Change error for overlapping
	TYPE IS cases.
	* gfortran.dg/select_type_36.f03: New test.

From-SVN: r241450

1 files changed, 11 insertions, 7 deletions

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 8c240742150..33a28424244 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -227,7 +227,7 @@ show_array_ref (gfc_array_ref * ar)
 	     print the start expression which contains the vector, in
 	     the latter case we have to print any of lower and upper
 	     bound and the stride, if they're present.  */
-  
+
 	  if (ar->start[i] != NULL)
 	    show_expr (ar->start[i]);
 
@@ -429,7 +429,7 @@ show_expr (gfc_expr *p)
 	  break;
 
 	case BT_CHARACTER:
-	  show_char_const (p->value.character.string, 
+	  show_char_const (p->value.character.string,
 			   p->value.character.length);
 	  break;
 
@@ -982,7 +982,7 @@ show_common (gfc_symtree *st)
 	fputs (", ", dumpfile);
     }
   fputc ('\n', dumpfile);
-}    
+}
 
 
 /* Worker function to display the symbol tree.  */
@@ -1238,7 +1238,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
       for (list = omp_clauses->tile_list; list; list = list->next)
 	{
 	  show_expr (list->expr);
-	  if (list->next) 
+	  if (list->next)
 	    fputs (", ", dumpfile);
 	}
       fputc (')', dumpfile);
@@ -1250,7 +1250,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
       for (list = omp_clauses->wait_list; list; list = list->next)
 	{
 	  show_expr (list->expr);
-	  if (list->next) 
+	  if (list->next)
 	    fputs (", ", dumpfile);
 	}
       fputc (')', dumpfile);
@@ -1815,8 +1815,12 @@ show_code_node (int level, gfc_code *c)
       break;
 
     case EXEC_SELECT:
+    case EXEC_SELECT_TYPE:
       d = c->block;
-      fputs ("SELECT CASE ", dumpfile);
+      if (c->op == EXEC_SELECT_TYPE)
+	fputs ("SELECT TYPE", dumpfile);
+      else
+	fputs ("SELECT CASE ", dumpfile);
       show_expr (c->expr1);
       fputc ('\n', dumpfile);
 
@@ -2628,7 +2632,7 @@ show_namespace (gfc_namespace *ns)
       fputs ("User operators:\n", dumpfile);
       gfc_traverse_user_op (ns, show_uop);
     }
-  
+
   for (eq = ns->equiv; eq; eq = eq->next)
     show_equiv (eq);