re PR fortran/78026 (ICE in gfc_resolve_omp_declare_simd, at fortran/openmp.c:5190)

	PR fortran/78026
	* parse.c (decode_statement): Don't create namespace for possible
	select type here and destroy it afterwards.
	(parse_select_type_block): Set gfc_current_ns to new_st.ext.block.ns.
	(parse_executable, gfc_parse_file): Formatting fixes.
	* match.c (gfc_match_select_type): Create namespace for select type
	here, only after matching select type.  Formatting fixes.  Free that
	namespace if not returning MATCH_YES, after gfc_undo_symbols,
	otherwise remember it in new_st.ext.block.ns and switch to parent
	namespace anyway.

	* gfortran.dg/gomp/pr78026.f03: New test.
	* gfortran.dg/select_type_38.f03: New test.

From-SVN: r241630

6 files changed, 70 insertions, 39 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 085fd0d..625189f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,4 +1,17 @@
-2016-10-27  Fritz Reese <fritzoreese@gmail.com>
+2016-10-27  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/78026
+	* parse.c (decode_statement): Don't create namespace for possible
+	select type here and destroy it afterwards.
+	(parse_select_type_block): Set gfc_current_ns to new_st.ext.block.ns.
+	(parse_executable, gfc_parse_file): Formatting fixes.
+	* match.c (gfc_match_select_type): Create namespace for select type
+	here, only after matching select type.  Formatting fixes.  Free that
+	namespace if not returning MATCH_YES, after gfc_undo_symbols,
+	otherwise remember it in new_st.ext.block.ns and switch to parent
+	namespace anyway.
+
+2016-10-27  Fritz Reese  <fritzoreese@gmail.com>
 
 	* expr.c (generate_union_initializer, get_union_initializer): New.
 	* expr.c (component_initializer): Consider BT_UNION specially.
@@ -21,7 +34,7 @@
 	suppress the error and return if the same procedure symbol
 	is added more than once to the interface.
 
-2016-10-26  Fritz Reese <fritzoreese@gmail.com>
+2016-10-26  Fritz Reese  <fritzoreese@gmail.com>
 
 	* frontend-passes.c (gfc_code_walker): Add SHARE and CARRIAGECONTROL.
 	* io.c (gfc_free_open, gfc_resolve_open, gfc_match_open): Ditto.
@@ -32,7 +45,7 @@
 	* io.c (match_dec_etag, match_dec_ftag): New functions.
 	* gfortran.texi: Document.
 
-2016-10-25  Fritz Reese <fritzoreese@gmail.com>
+2016-10-25  Fritz Reese  <fritzoreese@gmail.com>
 
 	* gfortran.texi: Document.
 	* resolve.c (logical_to_bitwise): New function.
@@ -56,17 +69,17 @@
 
 	* intrinsic.texi (cosd): New mathop.
 
-2016-10-25  Fritz Reese <fritzoreese@gmail.com>
+2016-10-25  Fritz Reese  <fritzoreese@gmail.com>
 
 	* match.c (gfc_match_intrinsic_op): Match ".XOR." with -std=legacy.
 	* gfortran.texi: Document.
 
-2016-10-25  Fritz Reese <fritzoreese@gmail.com>
+2016-10-25  Fritz Reese  <fritzoreese@gmail.com>
 
 	* primary.c (gfc_match_rvalue): Match %LOC as LOC with -std=legacy.
 	* gfortran.texi: Document.
 
-2016-10-25  Fritz Reese <fritzoreese@gmail.com>
+2016-10-25  Fritz Reese  <fritzoreese@gmail.com>
 
 	* decl.c (gfc_match_type): New function.
 	* match.h (gfc_match_type): New function.
@@ -74,12 +87,12 @@
 	* gfortran.texi: Update documentation.
 	* parse.c (decode_statement): Invoke gfc_match_type.
 
-2016-10-25  Fritz Reese <fritzoreese@gmail.com>
+2016-10-25  Fritz Reese  <fritzoreese@gmail.com>
 
 	* gfortran.texi: Document.
 	* gfortran.h (gfc_is_whitespace): Include form feed ('\f').
 
-2016-10-25  Fritz Reese <fritzoreese@gmail.com>
+2016-10-25  Fritz Reese  <fritzoreese@gmail.com>
 
 	* invoke.texi, gfortran.texi: Touch up documentation of -fdec.
 	* gfortran.h (gfc_option): Move flag_dec_structure out of gfc_option.
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 94aa830..0996a9e 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -5882,6 +5882,7 @@ gfc_match_select_type (void)
   char name[GFC_MAX_SYMBOL_LEN];
   bool class_array;
   gfc_symbol *sym;
+  gfc_namespace *ns = gfc_current_ns;
 
   m = gfc_match_label ();
   if (m == MATCH_ERROR)
@@ -5891,10 +5892,11 @@ gfc_match_select_type (void)
   if (m != MATCH_YES)
     return m;
 
+  gfc_current_ns = gfc_build_block_ns (ns);
   m = gfc_match (" %n => %e", name, &expr2);
   if (m == MATCH_YES)
     {
-      expr1 = gfc_get_expr();
+      expr1 = gfc_get_expr ();
       expr1->expr_type = EXPR_VARIABLE;
       if (gfc_get_sym_tree (name, NULL, &expr1->symtree, false))
 	{
@@ -5916,7 +5918,11 @@ gfc_match_select_type (void)
     {
       m = gfc_match (" %e ", &expr1);
       if (m != MATCH_YES)
-	return m;
+	{
+	  std::swap (ns, gfc_current_ns);
+	  gfc_free_namespace (ns);
+	  return m;
+	}
     }
 
   m = gfc_match (" )%t");
@@ -5932,19 +5938,19 @@ gfc_match_select_type (void)
      allowed by the standard.
      TODO: see if it is sufficient to exclude component and substring
      references.  */
-  class_array = expr1->expr_type == EXPR_VARIABLE
-		  && expr1->ts.type == BT_CLASS
-		  && CLASS_DATA (expr1)
-		  && (strcmp (CLASS_DATA (expr1)->name, "_data") == 0)
-		  && (CLASS_DATA (expr1)->attr.dimension
-		      || CLASS_DATA (expr1)->attr.codimension)
-		  && expr1->ref
-		  && expr1->ref->type == REF_ARRAY
-		  && expr1->ref->next == NULL;
+  class_array = (expr1->expr_type == EXPR_VARIABLE
+		 && expr1->ts.type == BT_CLASS
+		 && CLASS_DATA (expr1)
+		 && (strcmp (CLASS_DATA (expr1)->name, "_data") == 0)
+		 && (CLASS_DATA (expr1)->attr.dimension
+		     || CLASS_DATA (expr1)->attr.codimension)
+		 && expr1->ref
+		 && expr1->ref->type == REF_ARRAY
+		 && expr1->ref->next == NULL);
 
   /* Check for F03:C811.  */
   if (!expr2 && (expr1->expr_type != EXPR_VARIABLE
-		  || (!class_array && expr1->ref != NULL)))
+		 || (!class_array && expr1->ref != NULL)))
     {
       gfc_error ("Selector in SELECT TYPE at %C is not a named variable; "
 		 "use associate-name=>");
@@ -5958,12 +5964,16 @@ gfc_match_select_type (void)
   new_st.ext.block.ns = gfc_current_ns;
 
   select_type_push (expr1->symtree->n.sym);
+  gfc_current_ns = ns;
 
   return MATCH_YES;
 
 cleanup:
   gfc_free_expr (expr1);
   gfc_free_expr (expr2);
+  gfc_undo_symbols ();
+  std::swap (ns, gfc_current_ns);
+  gfc_free_namespace (ns);
   return m;
 }
 
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 760d3af..2aa2afc 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -295,7 +295,6 @@ static bool in_specification_block;
 static gfc_statement
 decode_statement (void)
 {
-  gfc_namespace *ns;
   gfc_statement st;
   locus old_locus;
   match m = MATCH_NO;
@@ -424,12 +423,7 @@ decode_statement (void)
   match (NULL, gfc_match_associate, ST_ASSOCIATE);
   match (NULL, gfc_match_critical, ST_CRITICAL);
   match (NULL, gfc_match_select, ST_SELECT_CASE);
-
-  gfc_current_ns = gfc_build_block_ns (gfc_current_ns);
   match (NULL, gfc_match_select_type, ST_SELECT_TYPE);
-  ns = gfc_current_ns;
-  gfc_current_ns = gfc_current_ns->parent;
-  gfc_free_namespace (ns);
 
   /* General statement matching: Instead of testing every possible
      statement, we eliminate most possibilities by peeking at the
@@ -4103,6 +4097,7 @@ parse_select_type_block (void)
   gfc_code *cp;
   gfc_state_data s;
 
+  gfc_current_ns = new_st.ext.block.ns;
   accept_statement (ST_SELECT_TYPE);
 
   cp = gfc_state_stack->tail;
@@ -5188,7 +5183,7 @@ parse_executable (gfc_statement st)
 	  break;
 
 	case ST_SELECT_TYPE:
-	  parse_select_type_block();
+	  parse_select_type_block ();
 	  break;
 
 	case ST_DO:
@@ -6027,12 +6022,11 @@ loop:
       prog_locus = gfc_current_locus;
 
       push_state (&s, COMP_PROGRAM, gfc_new_block);
-      main_program_symbol(gfc_current_ns, gfc_new_block->name);
+      main_program_symbol (gfc_current_ns, gfc_new_block->name);
       accept_statement (st);
       add_global_program ();
       parse_progunit (ST_NONE);
       goto prog_units;
-      break;
 
     case ST_SUBROUTINE:
       add_global_procedure (true);
@@ -6040,7 +6034,6 @@ loop:
       accept_statement (st);
       parse_progunit (ST_NONE);
       goto prog_units;
-      break;
 
     case ST_FUNCTION:
       add_global_procedure (false);
@@ -6048,7 +6041,6 @@ loop:
       accept_statement (st);
       parse_progunit (ST_NONE);
       goto prog_units;
-      break;
 
     case ST_BLOCK_DATA:
       push_state (&s, COMP_BLOCK_DATA, gfc_new_block);
@@ -6083,7 +6075,6 @@ loop:
       main_program_symbol (gfc_current_ns, "MAIN__");
       parse_progunit (st);
       goto prog_units;
-      break;
     }
 
   /* Handle the non-program units.  */
@@ -6132,14 +6123,12 @@ prog_units:
   pop_state ();
   goto loop;
 
-  done:
-
+done:
   /* Do the resolution.  */
   resolve_all_program_units (gfc_global_ns_list);
 
   /* Do the parse tree dump.  */
-  gfc_current_ns
-	= flag_dump_fortran_original ? gfc_global_ns_list : NULL;
+  gfc_current_ns = flag_dump_fortran_original ? gfc_global_ns_list : NULL;
 
   for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling)
     if (!gfc_current_ns->proc_name
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9ce3f64..a8d187c 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,9 +1,13 @@
 2016-10-27  Jakub Jelinek  <jakub@redhat.com>
 
+	PR fortran/78026
+	* gfortran.dg/gomp/pr78026.f03: New test.
+	* gfortran.dg/select_type_38.f03: New test.
+
 	PR middle-end/78025
 	* g++.dg/gomp/declare-simd-7.C: New test.
 
-2016-10-27  Fritz Reese <fritzoreese@gmail.com>
+2016-10-27  Fritz Reese  <fritzoreese@gmail.com>
 
 	* gfortran.dg/dec_init_1.f90: Remove -fdump-tree-original.
 	* gfortran.dg/dec_init_2.f90: Likewise.
@@ -14,7 +18,7 @@
 
 	* gcc.dg/fold-narrowbopcst-1.c: New test.
 
-2016-10-27  Fritz Reese <fritzoreese@gmail.com>
+2016-10-27  Fritz Reese  <fritzoreese@gmail.com>
 
 	* gfortran.dg/dec_io_5.f90: Don't use "test.txt", and use
 	dg-shouldfail/dg-output instead of XFAIL.
@@ -70,7 +74,7 @@
 	* gfortran.dg/pr78061.f: New test.
 	* g++.dg/pr78088.C: New test.
 
-2016-10-26  Fritz Reese <fritzoreese@gmail.com>
+2016-10-26  Fritz Reese  <fritzoreese@gmail.com>
 
 	* gfortran.dg/dec_io_1.f90: New test.
 	* gfortran.dg/dec_io_2.f90: New test.
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr78026.f03 b/gcc/testsuite/gfortran.dg/gomp/pr78026.f03
new file mode 100644
index 0000000..61f9458
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr78026.f03
@@ -0,0 +1,5 @@
+! PR fortran/78026
+select type (a)		! { dg-error "Selector shall be polymorphic in SELECT TYPE statement" }
+end select
+!$omp declare simd(b)	! { dg-error "Unexpected !.OMP DECLARE SIMD statement" }
+end			! { dg-error "should refer to containing procedure" "" { target *-*-* } .-1 }
diff --git a/gcc/testsuite/gfortran.dg/select_type_38.f03 b/gcc/testsuite/gfortran.dg/select_type_38.f03
new file mode 100644
index 0000000..a643e99
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_38.f03
@@ -0,0 +1,10 @@
+  type :: t1
+  end type
+  type, extends(t1) :: t2
+  end type
+  class(t1), pointer :: a
+lab1: select type (a)
+  end select lab1
+lab1: select type (a)		! { dg-error "Duplicate construct label" }
+  end select lab1		! { dg-error "Expecting END PROGRAM statement" }
+end