Skip to content

R
riscv-gcc-1
Commit 6f21288f by Jakub Jelinek
Options

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
parent 47ffb5d9
Showing with 70 additions and 39 deletions
gcc/fortran/ChangeLog
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 (generate_union_initializer, get_union_initializer): New.
* expr.c (component_initializer): Consider BT_UNION specially. * expr.c (component_initializer): Consider BT_UNION specially.
...@@ -21,7 +34,7 @@ ...@@ -21,7 +34,7 @@
suppress the error and return if the same procedure symbol suppress the error and return if the same procedure symbol
is added more than once to the interface. 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. * frontend-passes.c (gfc_code_walker): Add SHARE and CARRIAGECONTROL.
* io.c (gfc_free_open, gfc_resolve_open, gfc_match_open): Ditto. * io.c (gfc_free_open, gfc_resolve_open, gfc_match_open): Ditto.
...@@ -32,7 +45,7 @@ ...@@ -32,7 +45,7 @@
* io.c (match_dec_etag, match_dec_ftag): New functions. * io.c (match_dec_etag, match_dec_ftag): New functions.
* gfortran.texi: Document. * gfortran.texi: Document.
2016-10-25 Fritz Reese <fritzoreese@gmail.com> 2016-10-25 Fritz Reese <fritzoreese@gmail.com>
* gfortran.texi: Document. * gfortran.texi: Document.
* resolve.c (logical_to_bitwise): New function. * resolve.c (logical_to_bitwise): New function.
...@@ -56,17 +69,17 @@ ...@@ -56,17 +69,17 @@
* intrinsic.texi (cosd): New mathop. * 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. * match.c (gfc_match_intrinsic_op): Match ".XOR." with -std=legacy.
* gfortran.texi: Document. * 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. * primary.c (gfc_match_rvalue): Match %LOC as LOC with -std=legacy.
* gfortran.texi: Document. * 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. * decl.c (gfc_match_type): New function.
* match.h (gfc_match_type): New function. * match.h (gfc_match_type): New function.
...@@ -74,12 +87,12 @@ ...@@ -74,12 +87,12 @@
* gfortran.texi: Update documentation. * gfortran.texi: Update documentation.
* parse.c (decode_statement): Invoke gfc_match_type. * 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.texi: Document.
* gfortran.h (gfc_is_whitespace): Include form feed ('\f'). * 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. * invoke.texi, gfortran.texi: Touch up documentation of -fdec.
* gfortran.h (gfc_option): Move flag_dec_structure out of gfc_option. * gfortran.h (gfc_option): Move flag_dec_structure out of gfc_option.
......
gcc/fortran/match.c
...@@ -5882,6 +5882,7 @@ gfc_match_select_type (void) ...@@ -5882,6 +5882,7 @@ gfc_match_select_type (void)
char name[GFC_MAX_SYMBOL_LEN]; char name[GFC_MAX_SYMBOL_LEN];
bool class_array; bool class_array;
gfc_symbol *sym; gfc_symbol *sym;
gfc_namespace *ns = gfc_current_ns;
m = gfc_match_label (); m = gfc_match_label ();
if (m == MATCH_ERROR) if (m == MATCH_ERROR)
...@@ -5891,10 +5892,11 @@ gfc_match_select_type (void) ...@@ -5891,10 +5892,11 @@ gfc_match_select_type (void)
if (m != MATCH_YES) if (m != MATCH_YES)
return m; return m;
gfc_current_ns = gfc_build_block_ns (ns);
m = gfc_match (" %n => %e", name, &expr2); m = gfc_match (" %n => %e", name, &expr2);
if (m == MATCH_YES) if (m == MATCH_YES)
{ {
expr1 = gfc_get_expr(); expr1 = gfc_get_expr ();
expr1->expr_type = EXPR_VARIABLE; expr1->expr_type = EXPR_VARIABLE;
if (gfc_get_sym_tree (name, NULL, &expr1->symtree, false)) if (gfc_get_sym_tree (name, NULL, &expr1->symtree, false))
{ {
...@@ -5916,7 +5918,11 @@ gfc_match_select_type (void) ...@@ -5916,7 +5918,11 @@ gfc_match_select_type (void)
{ {
m = gfc_match (" %e ", &expr1); m = gfc_match (" %e ", &expr1);
if (m != MATCH_YES) if (m != MATCH_YES)
return m; {
std::swap (ns, gfc_current_ns);
gfc_free_namespace (ns);
return m;
}
} }
m = gfc_match (" )%t"); m = gfc_match (" )%t");
...@@ -5932,19 +5938,19 @@ gfc_match_select_type (void) ...@@ -5932,19 +5938,19 @@ gfc_match_select_type (void)
allowed by the standard. allowed by the standard.
TODO: see if it is sufficient to exclude component and substring TODO: see if it is sufficient to exclude component and substring
references. */ references. */
class_array = expr1->expr_type == EXPR_VARIABLE class_array = (expr1->expr_type == EXPR_VARIABLE
&& expr1->ts.type == BT_CLASS && expr1->ts.type == BT_CLASS
&& CLASS_DATA (expr1) && CLASS_DATA (expr1)
&& (strcmp (CLASS_DATA (expr1)->name, "_data") == 0) && (strcmp (CLASS_DATA (expr1)->name, "_data") == 0)
&& (CLASS_DATA (expr1)->attr.dimension && (CLASS_DATA (expr1)->attr.dimension
|| CLASS_DATA (expr1)->attr.codimension) || CLASS_DATA (expr1)->attr.codimension)
&& expr1->ref && expr1->ref
&& expr1->ref->type == REF_ARRAY && expr1->ref->type == REF_ARRAY
&& expr1->ref->next == NULL; && expr1->ref->next == NULL);
/* Check for F03:C811. */ /* Check for F03:C811. */
if (!expr2 && (expr1->expr_type != EXPR_VARIABLE 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; " gfc_error ("Selector in SELECT TYPE at %C is not a named variable; "
"use associate-name=>"); "use associate-name=>");
...@@ -5958,12 +5964,16 @@ gfc_match_select_type (void) ...@@ -5958,12 +5964,16 @@ gfc_match_select_type (void)
new_st.ext.block.ns = gfc_current_ns; new_st.ext.block.ns = gfc_current_ns;
select_type_push (expr1->symtree->n.sym); select_type_push (expr1->symtree->n.sym);
gfc_current_ns = ns;
return MATCH_YES; return MATCH_YES;
cleanup: cleanup:
gfc_free_expr (expr1); gfc_free_expr (expr1);
gfc_free_expr (expr2); gfc_free_expr (expr2);
gfc_undo_symbols ();
std::swap (ns, gfc_current_ns);
gfc_free_namespace (ns);
return m; return m;
} }
......
gcc/fortran/parse.c
...@@ -295,7 +295,6 @@ static bool in_specification_block; ...@@ -295,7 +295,6 @@ static bool in_specification_block;
static gfc_statement static gfc_statement
decode_statement (void) decode_statement (void)
{ {
gfc_namespace *ns;
gfc_statement st; gfc_statement st;
locus old_locus; locus old_locus;
match m = MATCH_NO; match m = MATCH_NO;
...@@ -424,12 +423,7 @@ decode_statement (void) ...@@ -424,12 +423,7 @@ decode_statement (void)
match (NULL, gfc_match_associate, ST_ASSOCIATE); match (NULL, gfc_match_associate, ST_ASSOCIATE);
match (NULL, gfc_match_critical, ST_CRITICAL); match (NULL, gfc_match_critical, ST_CRITICAL);
match (NULL, gfc_match_select, ST_SELECT_CASE); 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); 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 /* General statement matching: Instead of testing every possible
statement, we eliminate most possibilities by peeking at the statement, we eliminate most possibilities by peeking at the
...@@ -4103,6 +4097,7 @@ parse_select_type_block (void) ...@@ -4103,6 +4097,7 @@ parse_select_type_block (void)
gfc_code *cp; gfc_code *cp;
gfc_state_data s; gfc_state_data s;
gfc_current_ns = new_st.ext.block.ns;
accept_statement (ST_SELECT_TYPE); accept_statement (ST_SELECT_TYPE);
cp = gfc_state_stack->tail; cp = gfc_state_stack->tail;
...@@ -5188,7 +5183,7 @@ parse_executable (gfc_statement st) ...@@ -5188,7 +5183,7 @@ parse_executable (gfc_statement st)
break; break;
case ST_SELECT_TYPE: case ST_SELECT_TYPE:
parse_select_type_block(); parse_select_type_block ();
break; break;
case ST_DO: case ST_DO:
...@@ -6027,12 +6022,11 @@ loop: ...@@ -6027,12 +6022,11 @@ loop:
prog_locus = gfc_current_locus; prog_locus = gfc_current_locus;
push_state (&s, COMP_PROGRAM, gfc_new_block); 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); accept_statement (st);
add_global_program (); add_global_program ();
parse_progunit (ST_NONE); parse_progunit (ST_NONE);
goto prog_units; goto prog_units;
break;
case ST_SUBROUTINE: case ST_SUBROUTINE:
add_global_procedure (true); add_global_procedure (true);
...@@ -6040,7 +6034,6 @@ loop: ...@@ -6040,7 +6034,6 @@ loop:
accept_statement (st); accept_statement (st);
parse_progunit (ST_NONE); parse_progunit (ST_NONE);
goto prog_units; goto prog_units;
break;
case ST_FUNCTION: case ST_FUNCTION:
add_global_procedure (false); add_global_procedure (false);
...@@ -6048,7 +6041,6 @@ loop: ...@@ -6048,7 +6041,6 @@ loop:
accept_statement (st); accept_statement (st);
parse_progunit (ST_NONE); parse_progunit (ST_NONE);
goto prog_units; goto prog_units;
break;
case ST_BLOCK_DATA: case ST_BLOCK_DATA:
push_state (&s, COMP_BLOCK_DATA, gfc_new_block); push_state (&s, COMP_BLOCK_DATA, gfc_new_block);
...@@ -6083,7 +6075,6 @@ loop: ...@@ -6083,7 +6075,6 @@ loop:
main_program_symbol (gfc_current_ns, "MAIN__"); main_program_symbol (gfc_current_ns, "MAIN__");
parse_progunit (st); parse_progunit (st);
goto prog_units; goto prog_units;
break;
} }
/* Handle the non-program units. */ /* Handle the non-program units. */
...@@ -6132,14 +6123,12 @@ prog_units: ...@@ -6132,14 +6123,12 @@ prog_units:
pop_state (); pop_state ();
goto loop; goto loop;
done: done:
/* Do the resolution. */ /* Do the resolution. */
resolve_all_program_units (gfc_global_ns_list); resolve_all_program_units (gfc_global_ns_list);
/* Do the parse tree dump. */ /* Do the parse tree dump. */
gfc_current_ns gfc_current_ns = flag_dump_fortran_original ? gfc_global_ns_list : NULL;
= flag_dump_fortran_original ? gfc_global_ns_list : NULL;
for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling) for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling)
if (!gfc_current_ns->proc_name if (!gfc_current_ns->proc_name
......
gcc/testsuite/ChangeLog
2016-10-27 Jakub Jelinek <jakub@redhat.com> 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 PR middle-end/78025
* g++.dg/gomp/declare-simd-7.C: New test. * 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_1.f90: Remove -fdump-tree-original.
* gfortran.dg/dec_init_2.f90: Likewise. * gfortran.dg/dec_init_2.f90: Likewise.
...@@ -14,7 +18,7 @@ ...@@ -14,7 +18,7 @@
* gcc.dg/fold-narrowbopcst-1.c: New test. * 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 * gfortran.dg/dec_io_5.f90: Don't use "test.txt", and use
dg-shouldfail/dg-output instead of XFAIL. dg-shouldfail/dg-output instead of XFAIL.
...@@ -70,7 +74,7 @@ ...@@ -70,7 +74,7 @@
* gfortran.dg/pr78061.f: New test. * gfortran.dg/pr78061.f: New test.
* g++.dg/pr78088.C: 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_1.f90: New test.
* gfortran.dg/dec_io_2.f90: New test. * gfortran.dg/dec_io_2.f90: New test.
......
gcc/testsuite/gfortran.dg/gomp/pr78026.f03 0 → 100644
! 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 }
gcc/testsuite/gfortran.dg/select_type_38.f03 0 → 100644
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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment