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 (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.
......
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;
}
......
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
......
gcc/testsuite/ChangeLog
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.
......
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