-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.
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.
* 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.
* 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.
* 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.
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)
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))
{
{
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");
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=>");
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;
}
static gfc_statement
decode_statement (void)
{
- gfc_namespace *ns;
gfc_statement st;
locus old_locus;
match m = MATCH_NO;
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
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;
break;
case ST_SELECT_TYPE:
- parse_select_type_block();
+ parse_select_type_block ();
break;
case ST_DO:
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);
accept_statement (st);
parse_progunit (ST_NONE);
goto prog_units;
- break;
case ST_FUNCTION:
add_global_procedure (false);
accept_statement (st);
parse_progunit (ST_NONE);
goto prog_units;
- break;
case ST_BLOCK_DATA:
push_state (&s, COMP_BLOCK_DATA, gfc_new_block);
main_program_symbol (gfc_current_ns, "MAIN__");
parse_progunit (st);
goto prog_units;
- break;
}
/* Handle the non-program 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
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.
* 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.
* 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.
--- /dev/null
+! 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 }
--- /dev/null
+ 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
projects / gcc.git / commitdiff