From 36b0a1b039d86aea9b9684db3b8edaf09a150285 Mon Sep 17 00:00:00 2001 From: burnus Date: Sun, 28 Jun 2009 17:56:41 +0000 Subject: 2009-06-28 Tobias Burnus Francois-Xavier Coudert PR fortran/34112 * symbol.c (gfc_add_ext_attribute): New function. (gfc_get_sym_tree): New argument allow_subroutine. (gfc_get_symbol,gfc_get_ha_sym_tree,gen_cptr_param,gen_fptr_param gen_shape_param,generate_isocbinding_symbol): Use it. * decl.c (find_special): New argument allow_subroutine. (add_init_expr_to_sym,add_hidden_procptr_result,attr_decl1, match_procedure_in_type,gfc_match_final_decl): Use it. (gfc_match_gcc_attributes): New function. * gfortran.texi (Mixed-Language Programming): New section "GNU Fortran Compiler Directives". * gfortran.h (ext_attr_t): New struct. (symbol_attributes): Use it. (gfc_add_ext_attribute): New prototype. (gfc_get_sym_tree): Update pototype. * expr.c (gfc_check_pointer_assign): Check whether call convention is the same. * module.c (import_iso_c_binding_module, create_int_parameter, use_iso_fortran_env_module): Update gfc_get_sym_tree call. * scanner.c (skip_gcc_attribute): New function. (skip_free_comments,skip_fixed_comments): Use it. (gfc_next_char_literal): Support !GCC$ lines. * resolve.c (check_host_association): Update gfc_get_sym_tree call. * match.c (gfc_match_sym_tree,gfc_match_call): Update gfc_get_sym_tree call. * trans-decl.c (add_attributes_to_decl): New function. (gfc_get_symbol_decl,get_proc_pointer_decl, gfc_get_extern_function_decl,build_function_decl: Use it. * match.h (gfc_match_gcc_attributes): Add prototype. * parse.c (decode_gcc_attribute): New function. (next_free,next_fixed): Support !GCC$ lines. * primary.c (match_actual_arg,check_for_implicit_index, gfc_match_rvalue,gfc_match_rvalue): Update gfc_get_sym_tree call. 2009-06-28 Tobias Burnus PR fortran/34112 * gfortran.dg/compiler-directive_1.f90: New test. * gfortran.dg/compiler-directive_2.f: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149036 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 74 ++++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 65 insertions(+), 9 deletions(-) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 0b2cbf3cb0e..da16c2b570f 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -566,6 +566,34 @@ decode_omp_directive (void) return ST_NONE; } +static gfc_statement +decode_gcc_attribute (void) +{ + locus old_locus; + +#ifdef GFC_DEBUG + gfc_symbol_state (); +#endif + + gfc_clear_error (); /* Clear any pending errors. */ + gfc_clear_warning (); /* Clear any pending warnings. */ + old_locus = gfc_current_locus; + + match ("attributes", gfc_match_gcc_attributes, ST_ATTR_DECL); + + /* All else has failed, so give up. See if any of the matchers has + stored an error message of some sort. */ + + if (gfc_error_check () == 0) + gfc_error_now ("Unclassifiable GCC directive at %C"); + + reject_statement (); + + gfc_error_recovery (); + + return ST_NONE; +} + #undef match @@ -637,21 +665,39 @@ next_free (void) else if (c == '!') { /* Comments have already been skipped by the time we get here, - except for OpenMP directives. */ - if (gfc_option.flag_openmp) + except for GCC attributes and OpenMP directives. */ + + gfc_next_ascii_char (); /* Eat up the exclamation sign. */ + c = gfc_peek_ascii_char (); + + if (c == 'g') { int i; c = gfc_next_ascii_char (); - for (i = 0; i < 5; i++, c = gfc_next_ascii_char ()) - gcc_assert (c == "!$omp"[i]); + for (i = 0; i < 4; i++, c = gfc_next_ascii_char ()) + gcc_assert (c == "gcc$"[i]); + + gfc_gobble_whitespace (); + return decode_gcc_attribute (); + + } + else if (c == '$' && gfc_option.flag_openmp) + { + int i; + + c = gfc_next_ascii_char (); + for (i = 0; i < 4; i++, c = gfc_next_ascii_char ()) + gcc_assert (c == "$omp"[i]); gcc_assert (c == ' ' || c == '\t'); gfc_gobble_whitespace (); return decode_omp_directive (); } - } + gcc_unreachable (); + } + if (at_bol && c == ';') { gfc_error_now ("Semicolon at %C needs to be preceded by statement"); @@ -709,12 +755,22 @@ next_fixed (void) break; /* Comments have already been skipped by the time we get - here, except for OpenMP directives. */ + here, except for GCC attributes and OpenMP directives. */ + case '*': - if (gfc_option.flag_openmp) + c = gfc_next_char_literal (0); + + if (TOLOWER (c) == 'g') + { + for (i = 0; i < 4; i++, c = gfc_next_char_literal (0)) + gcc_assert (TOLOWER (c) == "gcc$"[i]); + + return decode_gcc_attribute (); + } + else if (c == '$' && gfc_option.flag_openmp) { - for (i = 0; i < 5; i++, c = gfc_next_char_literal (0)) - gcc_assert ((char) gfc_wide_tolower (c) == "*$omp"[i]); + for (i = 0; i < 4; i++, c = gfc_next_char_literal (0)) + gcc_assert ((char) gfc_wide_tolower (c) == "$omp"[i]); if (c != ' ' && c != '0') { -- cgit v1.2.1 From 7ea64434b40d07d43f4aa6cafac4684487e69304 Mon Sep 17 00:00:00 2001 From: pault Date: Sat, 1 Aug 2009 13:45:12 +0000 Subject: 2009-08-01 Paul Thomas PR fortran/40011 * error.c : Add static flag 'warnings_not_errors'. (gfc_error): If 'warnings_not_errors' is set, branch to code from gfc_warning. (gfc_clear_error): Reset 'warnings_not_errors'. (gfc_errors_to_warnings): New function. * options.c (gfc_post_options): If pedantic and flag_whole_file change the latter to a value of 2. * parse.c (parse_module): Add module namespace to gsymbol. (resolve_all_program_units): New function. (clean_up_modules): New function. (translate_all_program_units): New function. (gfc_parse_file): If whole_file, do not clean up module right away and add derived types to namespace derived types. In addition, call the three new functions above. * resolve.c (not_in_recursive): New function. (not_entry_self_reference): New function. (resolve_global_procedure): Symbol must not be IFSRC_UNKNOWN, procedure must not be in the course of being resolved and must return false for the two new functions. Pack away the current derived type list before calling gfc_resolve for the gsymbol namespace. It is unconditionally an error if the ranks of the reference and ther procedure do not match. Convert errors to warnings during call to gfc_procedure_use if not pedantic or legacy. (gfc_resolve): Set namespace resolved flag to -1 during resolution and store current cs_base. * trans-decl.c (gfc_get_symbol_decl): If whole_file compilation substitute a use associated variable, if it is available in a gsymbolnamespace. (gfc_get_extern_function_decl): If the procedure is use assoc, do not attempt to find it in a gsymbol because it could be an interface. If the symbol exists in a module namespace, return its backend_decl. * trans-expr.c (gfc_trans_scalar_assign): If a derived type assignment, set the rhs TYPE_MAIN_VARIANT to that of the rhs. * trans-types.c (copy_dt_decls_ifequal): Add 'from_gsym' as a boolean argument. Copy component backend_decls directly if the components are derived types and from_gsym is true. (gfc_get_derived_type): If whole_file copy the derived type from the module if it is use associated, otherwise, if can be found in another gsymbol namespace, use the existing derived type as the TYPE_CANONICAL and build normally. * gfortran.h : Add derived_types and resolved fields to gfc_namespace. Include prototype for gfc_errors_to_warnings. 2009-08-01 Paul Thomas PR fortran/40011 * gfortran.dg/whole_file_7.f90: New test. * gfortran.dg/whole_file_8.f90: New test. * gfortran.dg/whole_file_9.f90: New test. * gfortran.dg/whole_file_10.f90: New test. * gfortran.dg/whole_file_11.f90: New test. * gfortran.dg/whole_file_12.f90: New test. * gfortran.dg/whole_file_13.f90: New test. * gfortran.dg/whole_file_14.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@150333 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 113 ++++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 91 insertions(+), 22 deletions(-) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index da16c2b570f..e4463bd7edf 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -3760,6 +3760,8 @@ loop: st = next_statement (); goto loop; } + + s->ns = gfc_current_ns; } @@ -3809,6 +3811,76 @@ add_global_program (void) } +/* Resolve all the program units when whole file scope option + is active. */ +static void +resolve_all_program_units (gfc_namespace *gfc_global_ns_list) +{ + gfc_free_dt_list (); + gfc_current_ns = gfc_global_ns_list; + for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling) + { + gfc_current_locus = gfc_current_ns->proc_name->declared_at; + gfc_resolve (gfc_current_ns); + gfc_current_ns->derived_types = gfc_derived_types; + gfc_derived_types = NULL; + } +} + + +static void +clean_up_modules (gfc_gsymbol *gsym) +{ + if (gsym == NULL) + return; + + clean_up_modules (gsym->left); + clean_up_modules (gsym->right); + + if (gsym->type != GSYM_MODULE || !gsym->ns) + return; + + gfc_current_ns = gsym->ns; + gfc_derived_types = gfc_current_ns->derived_types; + gfc_done_2 (); + gsym->ns = NULL; + return; +} + + +/* Translate all the program units when whole file scope option + is active. This could be in a different order to resolution if + there are forward references in the file. */ +static void +translate_all_program_units (gfc_namespace *gfc_global_ns_list) +{ + int errors; + + gfc_current_ns = gfc_global_ns_list; + gfc_get_errors (NULL, &errors); + + for (; !errors && gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling) + { + gfc_current_locus = gfc_current_ns->proc_name->declared_at; + gfc_derived_types = gfc_current_ns->derived_types; + gfc_generate_code (gfc_current_ns); + gfc_current_ns->translated = 1; + } + + /* Clean up all the namespaces after translation. */ + gfc_current_ns = gfc_global_ns_list; + for (;gfc_current_ns;) + { + gfc_namespace *ns = gfc_current_ns->sibling; + gfc_derived_types = gfc_current_ns->derived_types; + gfc_done_2 (); + gfc_current_ns = ns; + } + + clean_up_modules (gfc_gsym_root); +} + + /* Top level parser. */ gfc_try @@ -3933,15 +4005,24 @@ loop: gfc_dump_module (s.sym->name, errors_before == errors); if (errors == 0) gfc_generate_module_code (gfc_current_ns); + pop_state (); + if (!gfc_option.flag_whole_file) + gfc_done_2 (); + else + { + gfc_current_ns->derived_types = gfc_derived_types; + gfc_derived_types = NULL; + gfc_current_ns = NULL; + } } else { if (errors == 0) gfc_generate_code (gfc_current_ns); + pop_state (); + gfc_done_2 (); } - pop_state (); - gfc_done_2 (); goto loop; prog_units: @@ -3964,35 +4045,23 @@ prog_units: if (!gfc_option.flag_whole_file) goto termination; - /* Do the resolution. */ - gfc_current_ns = gfc_global_ns_list; - for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling) - { - gfc_current_locus = gfc_current_ns->proc_name->declared_at; - gfc_resolve (gfc_current_ns); - } + /* Do the resolution. */ + resolve_all_program_units (gfc_global_ns_list); /* Do the parse tree dump. */ - gfc_current_ns = gfc_option.dump_parse_tree ? gfc_global_ns_list : NULL; + gfc_current_ns + = gfc_option.dump_parse_tree ? gfc_global_ns_list : NULL; + for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling) { gfc_dump_parse_tree (gfc_current_ns, stdout); - fputs ("-----------------------------------------\n\n", stdout); + fputs ("------------------------------------------\n\n", stdout); } - gfc_current_ns = gfc_global_ns_list; - gfc_get_errors (NULL, &errors); - - /* Do the translation. This could be in a different order to - resolution if there are forward references in the file. */ - for (; !errors && gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling) - { - gfc_current_locus = gfc_current_ns->proc_name->declared_at; - gfc_generate_code (gfc_current_ns); - } + /* Do the translation. */ + translate_all_program_units (gfc_global_ns_list); termination: - gfc_free_dt_list (); gfc_end_source_files (); return SUCCESS; -- cgit v1.2.1 From eeebe20ba63ca092de5e2d4575b5765dd88a7ce6 Mon Sep 17 00:00:00 2001 From: janus Date: Thu, 13 Aug 2009 19:46:46 +0000 Subject: 2009-08-13 Janus Weil PR fortran/40941 * gfortran.h (gfc_typespec): Put 'derived' and 'cl' into union. * decl.c (build_struct): Make sure 'cl' is only used if type is BT_CHARACTER. * symbol.c (gfc_set_default_type): Ditto. * resolve.c (resolve_symbol, resolve_fl_derived): Ditto. (resolve_equivalence,resolve_equivalence_derived): Make sure 'derived' is only used if type is BT_DERIVED. * trans-io.c (transfer_expr): Make sure 'derived' is only used if type is BT_DERIVED or BT_INTEGER (special case: C_PTR/C_FUNPTR). * array.c: Mechanical replacements to accomodate union in gfc_typespec. * check.c: Ditto. * data.c: Ditto. * decl.c: Ditto. * dump-parse-tree.c: Ditto. * expr.c: Ditto. * interface.c: Ditto. * iresolve.c: Ditto. * match.c: Ditto. * misc.c: Ditto. * module.c: Ditto. * openmp.c: Ditto. * parse.c: Ditto. * primary.c: Ditto. * resolve.c: Ditto. * simplify.c: Ditto. * symbol.c: Ditto. * target-memory.c: Ditto. * trans-array.c: Ditto. * trans-common.c: Ditto. * trans-const.c: Ditto. * trans-decl.c: Ditto. * trans-expr.c: Ditto. * trans-intrinsic.c: Ditto. * trans-io.c: Ditto. * trans-stmt.c: Ditto. * trans-types.c: Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@150725 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index e4463bd7edf..2552fcd6788 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -2049,24 +2049,24 @@ endType: { /* Look for allocatable components. */ if (c->attr.allocatable - || (c->ts.type == BT_DERIVED && c->ts.derived->attr.alloc_comp)) + || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.alloc_comp)) sym->attr.alloc_comp = 1; /* Look for pointer components. */ if (c->attr.pointer - || (c->ts.type == BT_DERIVED && c->ts.derived->attr.pointer_comp)) + || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.pointer_comp)) sym->attr.pointer_comp = 1; /* Look for procedure pointer components. */ if (c->attr.proc_pointer || (c->ts.type == BT_DERIVED - && c->ts.derived->attr.proc_pointer_comp)) + && c->ts.u.derived->attr.proc_pointer_comp)) sym->attr.proc_pointer_comp = 1; /* Look for private components. */ if (sym->component_access == ACCESS_PRIVATE || c->attr.access == ACCESS_PRIVATE - || (c->ts.type == BT_DERIVED && c->ts.derived->attr.private_comp)) + || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.private_comp)) sym->attr.private_comp = 1; } @@ -2320,7 +2320,7 @@ match_deferred_characteristics (gfc_typespec * ts) { ts->kind = 0; - if (!ts->derived || !ts->derived->components) + if (!ts->u.derived || !ts->u.derived->components) m = MATCH_ERROR; } @@ -2360,8 +2360,8 @@ check_function_result_typed (void) /* Check type-parameters, at the moment only CHARACTER lengths possible. */ /* TODO: Extend when KIND type parameters are implemented. */ - if (ts->type == BT_CHARACTER && ts->cl && ts->cl->length) - gfc_expr_check_typed (ts->cl->length, gfc_current_ns, true); + if (ts->type == BT_CHARACTER && ts->u.cl && ts->u.cl->length) + gfc_expr_check_typed (ts->u.cl->length, gfc_current_ns, true); } @@ -2540,7 +2540,7 @@ declSt: gfc_current_block ()->ts.kind = 0; /* Keep the derived type; if it's bad, it will be discovered later. */ - if (!(ts->type == BT_DERIVED && ts->derived)) + if (!(ts->type == BT_DERIVED && ts->u.derived)) ts->type = BT_UNKNOWN; } -- cgit v1.2.1 From a6a7eb12db7f17e79e3036e4494643dd1a88250b Mon Sep 17 00:00:00 2001 From: jvdelisle Date: Tue, 1 Sep 2009 03:02:07 +0000 Subject: 2009-08-31 Jerry DeLisle PR fortran/39229 * scanner.c (next_char): Fix typo in comment. (gfc_get_char_literal): Warn if truncate flag is set for both fixed and free form source, adjusting error locus as needed. * parse.c (next_fixed): Clear the truncate flag. (next_statement): Remove truncate warning. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@151258 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 2552fcd6788..e7439892f15 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -849,6 +849,8 @@ next_fixed (void) blank_line: if (digit_flag) gfc_warning ("Ignoring statement label in empty statement at %C"); + + gfc_current_locus.lb->truncated = 0; gfc_advance_line (); return ST_NONE; } @@ -862,6 +864,7 @@ next_statement (void) { gfc_statement st; locus old_locus; + gfc_new_block = NULL; gfc_current_ns->old_cl_list = gfc_current_ns->cl_list; @@ -871,14 +874,7 @@ next_statement (void) gfc_buffer_error (1); if (gfc_at_eol ()) - { - if ((gfc_option.warn_line_truncation || gfc_current_form == FORM_FREE) - && gfc_current_locus.lb - && gfc_current_locus.lb->truncated) - gfc_warning_now ("Line truncated at %C"); - - gfc_advance_line (); - } + gfc_advance_line (); gfc_skip_comments (); -- cgit v1.2.1 From 67f3a7b4ceae88e94a95f91d88b304f81d132632 Mon Sep 17 00:00:00 2001 From: kargl Date: Thu, 24 Sep 2009 21:53:36 +0000 Subject: 2009-09-24 Steven G. Kargl PR fortran/41459 * gfortran.dg/empty_label.f: New test. * gfortran.dg/empty_label.f90: Ditto. * gfortran.dg/warnings_are_errors_1.f: Fix to emit a single warning. 2009-09-24 Steven G. Kargl PR fortran/41459 * error.c(gfc_warning_now): Move warnings_are_errors test to after actual emitting of the warning. * parse.c (next_free): Improve error locus printing. (next_fixed): Change gfc_warn to gfc_warning_now, and improve locus reporting. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@152147 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index e7439892f15..93a6cfdc7f6 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -655,7 +655,7 @@ next_free (void) if (gfc_match_eos () == MATCH_YES) { gfc_warning_now ("Ignoring statement label in empty statement " - "at %C"); + "at %L", &label_locus); gfc_free_st_label (gfc_statement_label); gfc_statement_label = NULL; return ST_NONE; @@ -848,7 +848,8 @@ next_fixed (void) blank_line: if (digit_flag) - gfc_warning ("Ignoring statement label in empty statement at %C"); + gfc_warning_now ("Ignoring statement label in empty statement at %L", + &label_locus); gfc_current_locus.lb->truncated = 0; gfc_advance_line (); -- cgit v1.2.1 From 6a7084d700f33c25ffdfe5e213b60f05785ba87c Mon Sep 17 00:00:00 2001 From: domob Date: Tue, 29 Sep 2009 07:42:42 +0000 Subject: 2009-09-29 Daniel Kraft PR fortran/39626 * gfortran.h (enum gfc_statement): Add ST_BLOCK and ST_END_BLOCK. (struct gfc_namespace): Convert flags to bit-fields and add flag `construct_entities' for use with BLOCK constructs. (enum gfc_exec_code): Add EXEC_BLOCK. (struct gfc_code): Add namespace field to union for EXEC_BLOCK. * match.h (gfc_match_block): New prototype. * parse.h (enum gfc_compile_state): Add COMP_BLOCK. * trans.h (gfc_process_block_locals): New prototype. (gfc_trans_deferred_vars): Made public, new prototype. * trans-stmt.h (gfc_trans_block_construct): New prototype. * decl.c (gfc_match_end): Handle END BLOCK correctly. (gfc_match_intent): Error if inside of BLOCK. (gfc_match_optional), (gfc_match_value): Ditto. * match.c (gfc_match_block): New routine. * parse.c (decode_statement): Handle BLOCK statement. (case_exec_markers): Add ST_BLOCK. (case_end): Add ST_END_BLOCK. (gfc_ascii_statement): Handle ST_BLOCK and ST_END_BLOCK. (parse_spec): Check for statements not allowed inside of BLOCK. (parse_block_construct): New routine. (parse_executable): Parse BLOCKs. (parse_progunit): Disallow CONTAINS in BLOCK constructs. * resolve.c (is_illegal_recursion): Find real container procedure and don't get confused by BLOCK constructs. (resolve_block_construct): New routine. (gfc_resolve_blocks), (resolve_code): Handle EXEC_BLOCK. * st.c (gfc_free_statement): Handle EXEC_BLOCK statements. * trans-decl.c (saved_local_decls): New static variable. (add_decl_as_local): New routine. (gfc_finish_var_decl): Add variable as local if inside BLOCK. (gfc_trans_deferred_vars): Make public. (gfc_process_block_locals): New routine. * trans-stmt.c (gfc_trans_block_construct): New routine. * trans.c (gfc_trans_code): Handle EXEC_BLOCK statements. 2009-09-29 Daniel Kraft PR fortran/39626 * gfortran.dg/block_1.f08: New test. * gfortran.dg/block_2.f08: New test. * gfortran.dg/block_3.f90: New test. * gfortran.dg/block_4.f08: New test. * gfortran.dg/block_5.f08: New test. * gfortran.dg/block_6.f08: New test. * gfortran.dg/block_7.f08: New test. * gfortran.dg/block_8.f08: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@152266 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 109 ++++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 98 insertions(+), 11 deletions(-) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 93a6cfdc7f6..e6b5dbb1801 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -289,7 +289,7 @@ decode_statement (void) gfc_undo_symbols (); gfc_current_locus = old_locus; - /* Check for the IF, DO, SELECT, WHERE and FORALL statements, which + /* Check for the IF, DO, SELECT, WHERE, FORALL and BLOCK statements, which might begin with a block label. The match functions for these statements are unusual in that their keyword is not seen before the matcher is called. */ @@ -309,6 +309,7 @@ decode_statement (void) gfc_undo_symbols (); gfc_current_locus = old_locus; + match (NULL, gfc_match_block, ST_BLOCK); match (NULL, gfc_match_do, ST_DO); match (NULL, gfc_match_select, ST_SELECT_CASE); @@ -933,7 +934,8 @@ next_statement (void) /* Statements that mark other executable statements. */ -#define case_exec_markers case ST_DO: case ST_FORALL_BLOCK: case ST_IF_BLOCK: \ +#define case_exec_markers case ST_DO: case ST_FORALL_BLOCK: \ + case ST_IF_BLOCK: case ST_BLOCK: \ case ST_WHERE_BLOCK: case ST_SELECT_CASE: case ST_OMP_PARALLEL: \ case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_SECTIONS: case ST_OMP_ORDERED: \ case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \ @@ -952,7 +954,8 @@ next_statement (void) are detected in gfc_match_end(). */ #define case_end case ST_END_BLOCK_DATA: case ST_END_FUNCTION: \ - case ST_END_PROGRAM: case ST_END_SUBROUTINE + case ST_END_PROGRAM: case ST_END_SUBROUTINE: \ + case ST_END_BLOCK /* Push a new state onto the stack. */ @@ -1142,6 +1145,9 @@ gfc_ascii_statement (gfc_statement st) case ST_BACKSPACE: p = "BACKSPACE"; break; + case ST_BLOCK: + p = "BLOCK"; + break; case ST_BLOCK_DATA: p = "BLOCK DATA"; break; @@ -1190,6 +1196,9 @@ gfc_ascii_statement (gfc_statement st) case ST_ELSEWHERE: p = "ELSEWHERE"; break; + case ST_END_BLOCK: + p = "END BLOCK"; + break; case ST_END_BLOCK_DATA: p = "END BLOCK DATA"; break; @@ -2391,6 +2400,27 @@ parse_spec (gfc_statement st) } loop: + + /* If we're inside a BLOCK construct, some statements are disallowed. + Check this here. Attribute declaration statements like INTENT, OPTIONAL + or VALUE are also disallowed, but they don't have a particular ST_* + key so we have to check for them individually in their matcher routine. */ + if (gfc_current_state () == COMP_BLOCK) + switch (st) + { + case ST_IMPLICIT: + case ST_IMPLICIT_NONE: + case ST_NAMELIST: + case ST_COMMON: + case ST_EQUIVALENCE: + case ST_STATEMENT_FUNCTION: + gfc_error ("%s statement is not allowed inside of BLOCK at %C", + gfc_ascii_statement (st)); + break; + + default: + break; + } /* If we find a statement that can not be followed by an IMPLICIT statement (and thus we can expect to see none any further), type the function result @@ -2908,6 +2938,58 @@ check_do_closure (void) } +/* Parse a series of contained program units. */ + +static void parse_progunit (gfc_statement); + + +/* Parse a BLOCK construct. */ + +static void +parse_block_construct (void) +{ + gfc_namespace* parent_ns; + gfc_namespace* my_ns; + gfc_state_data s; + + gfc_notify_std (GFC_STD_F2008, "Fortran 2008: BLOCK construct at %C"); + + parent_ns = gfc_current_ns; + my_ns = gfc_get_namespace (parent_ns, 1); + my_ns->construct_entities = 1; + + /* Give the BLOCK a symbol of flavor LABEL; this is later needed for correct + code generation (so it must not be NULL). + We set its recursive argument if our container procedure is recursive, so + that local variables are accordingly placed on the stack when it + will be necessary. */ + if (gfc_new_block) + my_ns->proc_name = gfc_new_block; + else + { + gfc_try t; + + gfc_get_symbol ("block@", my_ns, &my_ns->proc_name); + t = gfc_add_flavor (&my_ns->proc_name->attr, FL_LABEL, + my_ns->proc_name->name, NULL); + gcc_assert (t == SUCCESS); + } + my_ns->proc_name->attr.recursive = parent_ns->proc_name->attr.recursive; + + new_st.op = EXEC_BLOCK; + new_st.ext.ns = my_ns; + accept_statement (ST_BLOCK); + + push_state (&s, COMP_BLOCK, my_ns->proc_name); + gfc_current_ns = my_ns; + + parse_progunit (ST_NONE); + + gfc_current_ns = parent_ns; + pop_state (); +} + + /* Parse a DO loop. Note that the ST_CYCLE and ST_EXIT statements are handled inside of parse_executable(), because they aren't really loop statements. */ @@ -3301,6 +3383,10 @@ parse_executable (gfc_statement st) return ST_IMPLIED_ENDDO; break; + case ST_BLOCK: + parse_block_construct (); + break; + case ST_IF_BLOCK: parse_if_block (); break; @@ -3359,11 +3445,6 @@ parse_executable (gfc_statement st) } -/* Parse a series of contained program units. */ - -static void parse_progunit (gfc_statement); - - /* Fix the symbols for sibling functions. These are incorrectly added to the child namespace as the parser didn't know about this procedure. */ @@ -3545,7 +3626,7 @@ parse_contained (int module) } -/* Parse a PROGRAM, SUBROUTINE or FUNCTION unit. */ +/* Parse a PROGRAM, SUBROUTINE, FUNCTION unit or BLOCK construct. */ static void parse_progunit (gfc_statement st) @@ -3560,7 +3641,10 @@ parse_progunit (gfc_statement st) unexpected_eof (); case ST_CONTAINS: - goto contains; + /* This is not allowed within BLOCK! */ + if (gfc_current_state () != COMP_BLOCK) + goto contains; + break; case_end: accept_statement (st); @@ -3584,7 +3668,10 @@ loop: unexpected_eof (); case ST_CONTAINS: - goto contains; + /* This is not allowed within BLOCK! */ + if (gfc_current_state () != COMP_BLOCK) + goto contains; + break; case_end: accept_statement (st); -- cgit v1.2.1 From 1de1b1a9e40b5aa064d5e3d032dd43ce14f6d2ad Mon Sep 17 00:00:00 2001 From: burnus Date: Wed, 30 Sep 2009 19:55:45 +0000 Subject: fortran/ 2009-09-30 Janus Weil * check.c (gfc_check_same_type_as): New function for checking SAME_TYPE_AS and EXTENDS_TYPE_OF. * decl.c (encapsulate_class_symbol): Set ABSTRACT attribute for class container, if the contained type has it. Add an initializer for the class container. (add_init_expr_to_sym): Handle BT_CLASS. (vindex_counter): New counter for setting vindices. (gfc_match_derived_decl): Set vindex for all derived types, not only those which are being extended. * expr.c (gfc_check_assign_symbol): Handle NULL initialization of class pointers. * gfortran.h (gfc_isym_id): New values GFC_ISYM_SAME_TYPE_AS and GFC_ISYM_EXTENDS_TYPE_OF. (gfc_type_is_extensible): New prototype. * intrinsic.h (gfc_check_same_type_as): New prototype. * intrinsic.c (add_functions): Add SAME_TYPE_AS and EXTENDS_TYPE_OF. * primary.c (gfc_expr_attr): Handle CLASS-valued functions. * resolve.c (resolve_structure_cons): Handle BT_CLASS. (type_is_extensible): Make non-static and rename to 'gfc_type_is_extensible. (resolve_select_type): Renamed type_is_extensible. (resolve_class_assign): Handle NULL pointers. (resolve_fl_variable_derived): Renamed type_is_extensible. (resolve_fl_derived): Ditto. * trans-expr.c (gfc_trans_subcomponent_assign): Handle NULL initialization of class pointer components. (gfc_conv_structure): Handle BT_CLASS. * trans-intrinsic.c (gfc_conv_same_type_as,gfc_conv_extends_type_of): New functions. (gfc_conv_intrinsic_function): Handle SAME_TYPE_AS and EXTENDS_TYPE_OF. 2009-09-30 Janus Weil * gfortran.h (type_selector, select_type_tmp): New global variables. * match.c (type_selector, select_type_tmp): New global variables, used for SELECT TYPE statements. (gfc_match_select_type): Better error handling. Remember selector. (gfc_match_type_is): Create temporary variable. * module.c (ab_attribute): New value 'AB_IS_CLASS'. (attr_bits): New string. (mio_symbol_attribute): Handle 'is_class'. * resolve.c (resolve_select_type): Insert pointer assignment statement, to assign temporary to selector. * symbol.c (gfc_get_ha_sym_tree): Replace selector by a temporary in SELECT TYPE statements. 2009-09-30 Janus Weil * dump-parse-tree.c (show_code_node): Renamed 'alloc_list'. * gfortran.h (gfc_code): Rename 'alloc_list'. Add member 'ts'. (gfc_expr_to_initialize): New prototype. * match.c (alloc_opt_list): Correctly check type compatibility. Renamed 'alloc_list'. (dealloc_opt_list): Renamed 'alloc_list'. * resolve.c (expr_to_initialize): Rename to 'gfc_expr_to_initialize' and make it non-static. (resolve_allocate_expr): Set vindex for CLASS variables correctly. Move initialization code to gfc_trans_allocate. Renamed 'alloc_list'. (resolve_allocate_deallocate): Renamed 'alloc_list'. (check_class_pointer_assign): Rename to 'resolve_class_assign'. Change argument type. Adjust to work with ordinary assignments. (resolve_code): Call 'resolve_class_assign' for ordinary assignments. Renamed 'check_class_pointer_assign'. * st.c (gfc_free_statement): Renamed 'alloc_list'. * trans-stmt.c (gfc_trans_allocate): Renamed 'alloc_list'. Handle size determination and initialization of CLASS variables. Bugfix for ALLOCATE statements with default initialization and SOURCE block. (gfc_trans_deallocate): Renamed 'alloc_list'. 2009-09-30 Paul Thomas * trans-expr.c (gfc_conv_procedure_call): Convert a derived type actual to a class object if the formal argument is a class. 2009-09-30 Janus Weil PR fortran/40996 * decl.c (build_struct): Handle allocatable scalar components. * expr.c (gfc_add_component_ref): Correctly set typespec of expression, after inserting component reference. * match.c (gfc_match_type_is,gfc_match_class_is): Make sure that no variables are being used uninitialized. * primary.c (gfc_match_varspec): Handle CLASS array components. * resolve.c (resolve_select_type): Transform EXEC_SELECT_TYPE to EXEC_SELECT. * trans-array.c (structure_alloc_comps,gfc_trans_deferred_array): Handle allocatable scalar components. * trans-expr.c (gfc_conv_component_ref): Ditto. * trans-types.c (gfc_get_derived_type): Ditto. 2009-09-30 Janus Weil * decl.c (encapsulate_class_symbol): Modify names of class container components by prefixing with '$'. (gfc_match_end): Handle COMP_SELECT_TYPE. * expr.c (gfc_add_component_ref): Modify names of class container components by prefixing with '$'. * gfortran.h (gfc_statement): Add ST_SELECT_TYPE, ST_TYPE_IS and ST_CLASS_IS. (gfc_case): New field 'ts'. (gfc_exec_op): Add EXEC_SELECT_TYPE. (gfc_type_is_extension_of): New prototype. * match.h (gfc_match_select_type,gfc_match_type_is,gfc_match_class_is): New prototypes. * match.c (match_derived_type_spec): New function. (match_type_spec): Use 'match_derived_type_spec'. (match_case_eos): Modify error message. (gfc_match_select_type): New function. (gfc_match_case): Modify error message. (gfc_match_type_is): New function. (gfc_match_class_is): Ditto. * parse.h (gfc_compile_state): Add COMP_SELECT_TYPE. * parse.c (decode_statement): Handle SELECT TYPE, TYPE IS and CLASS IS statements. (next_statement): Handle ST_SELECT_TYPE. (gfc_ascii_statement): Handle ST_SELECT_TYPE, ST_TYPE_IS, ST_CLASS_IS. (parse_select_type_block): New function. (parse_executable): Handle ST_SELECT_TYPE. * resolve.c (resolve_deallocate_expr): Handle BT_CLASS. Modify names of class container components by prefixing with '$'. (resolve_allocate_expr): Ditto. (resolve_select_type): New function. (gfc_resolve_blocks): Handle EXEC_SELECT_TYPE. (check_class_pointer_assign): Modify names of class container components by prefixing with '$'. (resolve_code): Ditto. * st.c (gfc_free_statement): Ditto. * symbol.c (gfc_type_is_extension_of): New function. (gfc_type_compatible): Use 'gfc_type_is_extension_of', plus a bugfix. * trans.c (gfc_trans_code): Handel EXEC_SELECT_TYPE. 2009-09-30 Janus Weil Paul Thomas * check.c (gfc_check_move_alloc): Arguments don't have to be arrays. The second argument needs to be type-compatible with the first (not the other way around, which makes a difference for CLASS entities). * decl.c (encapsulate_class_symbol): New function. (build_sym,build_struct): Handle BT_CLASS, call 'encapsulate_class_symbol'. (gfc_match_decl_type_spec): Remove warning, use BT_CLASS. (gfc_match_derived_decl): Set vindex; * expr.c (gfc_add_component_ref): New function. (gfc_copy_expr,gfc_check_pointer_assign,gfc_check_assign_symbol): Handle BT_CLASS. * dump-parse-tree.c (show_symbol): Print vindex. * gfortran.h (bt): New basic type BT_CLASS. (symbol_attribute): New field 'is_class'. (gfc_typespec): Remove field 'is_class'. (gfc_symbol): New field 'vindex'. (gfc_get_ultimate_derived_super_type): New prototype. (gfc_add_component_ref): Ditto. * interface.c (gfc_compare_derived_types): Pointer equality check moved here from gfc_compare_types. (gfc_compare_types): Handle BT_CLASS and use gfc_type_compatible. * match.c (gfc_match_allocate,gfc_match_deallocate,gfc_match_call): Handle BT_CLASS. * misc.c (gfc_clear_ts): Removed is_class. (gfc_basic_typename,gfc_typename): Handle BT_CLASS. * module.c (bt_types,mio_typespec): Handle BT_CLASS. (mio_symbol): Handle vindex. * primary.c (gfc_match_varspec,gfc_variable_attr): Handle BT_CLASS. * resolve.c (find_array_spec,check_typebound_baseobject): Handle BT_CLASS. (resolve_ppc_call,resolve_expr_ppc): Don't call 'gfc_is_proc_ptr_comp' inside 'gcc_assert'. (resolve_deallocate_expr,resolve_allocate_expr): Handle BT_CLASS. (check_class_pointer_assign): New function. (resolve_code): Handle BT_CLASS, call check_class_pointer_assign. (resolve_fl_var_and_proc,type_is_extensible,resolve_fl_variable_derived, resolve_fl_variable): Handle BT_CLASS. (check_generic_tbp_ambiguity): Add special case. (resolve_typebound_procedure,resolve_fl_derived): Handle BT_CLASS. * symbol.c (gfc_get_ultimate_derived_super_type): New function. (gfc_type_compatible): Handle BT_CLASS. * trans-expr.c (conv_parent_component_references): Handle CLASS containers. (gfc_conv_initializer): Handle BT_CLASS. * trans-types.c (gfc_typenode_for_spec,gfc_get_derived_type): Handle BT_CLASS. testsuite/ 2009-09-30 Janus Weil * gfortran.dg/same_type_as_1.f03: New test. * gfortran.dg/same_type_as_2.f03: Ditto. 2009-09-30 Janus Weil * gfortran.dg/select_type_1.f03: Extended. * gfortran.dg/select_type_3.f03: New test. 2009-09-30 Janus Weil * gfortran.dg/class_allocate_1.f03: New test. 2009-09-30 Janus Weil PR fortran/40996 * gfortran.dg/allocatable_scalar_3.f90: New test. * gfortran.dg/select_type_2.f03: Ditto. * gfortran.dg/typebound_proc_5.f03: Changed error messages. 2009-09-30 Janus Weil * gfortran.dg/block_name_2.f90: Modified error message. * gfortran.dg/select_6.f90: Ditto. * gfortran.dg/select_type_1.f03: New test. 2009-09-30 Janus Weil * gfortran.dg/allocate_derived_1.f90: Remove -w option. * gfortran.dg/class_1.f03: Ditto. * gfortran.dg/class_2.f03: Ditto. * gfortran.dg/proc_ptr_comp_pass_1.f90: Ditto. * gfortran.dg/proc_ptr_comp_pass_2.f90: Ditto. * gfortran.dg/proc_ptr_comp_pass_3.f90: Ditto. * gfortran.dg/typebound_call_10.f03: Ditto. * gfortran.dg/typebound_call_2.f03: Ditto. * gfortran.dg/typebound_call_3.f03: Ditto. * gfortran.dg/typebound_call_4.f03: Ditto. * gfortran.dg/typebound_call_9.f03: Ditto. * gfortran.dg/typebound_generic_3.f03: Ditto. * gfortran.dg/typebound_generic_4.f03: Ditto. * gfortran.dg/typebound_operator_1.f03: Ditto. * gfortran.dg/typebound_operator_2.f03: Ditto. * gfortran.dg/typebound_operator_3.f03: Ditto. * gfortran.dg/typebound_operator_4.f03: Ditto. * gfortran.dg/typebound_proc_1.f08: Ditto. * gfortran.dg/typebound_proc_5.f03: Ditto. * gfortran.dg/typebound_proc_6.f03: Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@152345 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 96 ++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 95 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index e6b5dbb1801..13199c91bb0 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -312,6 +312,7 @@ decode_statement (void) match (NULL, gfc_match_block, ST_BLOCK); match (NULL, gfc_match_do, ST_DO); match (NULL, gfc_match_select, ST_SELECT_CASE); + match (NULL, gfc_match_select_type, ST_SELECT_TYPE); /* General statement matching: Instead of testing every possible statement, we eliminate most possibilities by peeking at the @@ -343,6 +344,7 @@ decode_statement (void) match ("case", gfc_match_case, ST_CASE); match ("common", gfc_match_common, ST_COMMON); match ("contains", gfc_match_eos, ST_CONTAINS); + match ("class", gfc_match_class_is, ST_CLASS_IS); break; case 'd': @@ -432,6 +434,7 @@ decode_statement (void) case 't': match ("target", gfc_match_target, ST_ATTR_DECL); match ("type", gfc_match_derived_decl, ST_DERIVED_DECL); + match ("type is", gfc_match_type_is, ST_TYPE_IS); break; case 'u': @@ -936,7 +939,8 @@ next_statement (void) #define case_exec_markers case ST_DO: case ST_FORALL_BLOCK: \ case ST_IF_BLOCK: case ST_BLOCK: \ - case ST_WHERE_BLOCK: case ST_SELECT_CASE: case ST_OMP_PARALLEL: \ + case ST_WHERE_BLOCK: case ST_SELECT_CASE: case ST_SELECT_TYPE: \ + case ST_OMP_PARALLEL: \ case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_SECTIONS: case ST_OMP_ORDERED: \ case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \ case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \ @@ -1360,6 +1364,15 @@ gfc_ascii_statement (gfc_statement st) case ST_SELECT_CASE: p = "SELECT CASE"; break; + case ST_SELECT_TYPE: + p = "SELECT TYPE"; + break; + case ST_TYPE_IS: + p = "TYPE IS"; + break; + case ST_CLASS_IS: + p = "CLASS IS"; + break; case ST_SEQUENCE: p = "SEQUENCE"; break; @@ -2874,6 +2887,83 @@ parse_select_block (void) } +/* Parse a SELECT TYPE construct (F03:R821). */ + +static void +parse_select_type_block (void) +{ + gfc_statement st; + gfc_code *cp; + gfc_state_data s; + + accept_statement (ST_SELECT_TYPE); + + cp = gfc_state_stack->tail; + push_state (&s, COMP_SELECT_TYPE, gfc_new_block); + + /* Make sure that the next statement is a TYPE IS, CLASS IS, CLASS DEFAULT + or END SELECT. */ + for (;;) + { + st = next_statement (); + if (st == ST_NONE) + unexpected_eof (); + if (st == ST_END_SELECT) + { + /* Empty SELECT CASE is OK. */ + accept_statement (st); + pop_state (); + return; + } + if (st == ST_TYPE_IS || st == ST_CLASS_IS) + break; + + gfc_error ("Expected TYPE IS, CLASS IS or END SELECT statement " + "following SELECT TYPE at %C"); + + reject_statement (); + } + + /* At this point, we're got a nonempty select block. */ + cp = new_level (cp); + *cp = new_st; + + accept_statement (st); + + do + { + st = parse_executable (ST_NONE); + switch (st) + { + case ST_NONE: + unexpected_eof (); + + case ST_TYPE_IS: + case ST_CLASS_IS: + cp = new_level (gfc_state_stack->head); + *cp = new_st; + gfc_clear_new_st (); + + accept_statement (st); + /* Fall through */ + + case ST_END_SELECT: + break; + + /* Can't have an executable statement because of + parse_executable(). */ + default: + unexpected_statement (st); + break; + } + } + while (st != ST_END_SELECT); + + pop_state (); + accept_statement (st); +} + + /* Given a symbol, make sure it is not an iteration variable for a DO statement. This subroutine is called when the symbol is seen in a context that causes it to become redefined. If the symbol is an @@ -3395,6 +3485,10 @@ parse_executable (gfc_statement st) parse_select_block (); break; + case ST_SELECT_TYPE: + parse_select_type_block(); + break; + case ST_DO: parse_do_block (); if (check_do_closure () == 1) -- cgit v1.2.1 From cd62bad79a89b57a105448aba8130fdfb88c0382 Mon Sep 17 00:00:00 2001 From: janus Date: Wed, 7 Oct 2009 10:54:35 +0000 Subject: 2009-10-07 Janus Weil * expr.c (gfc_check_pointer_assign): Do the correct type checking when CLASS variables are involved. * match.c (gfc_match_select_type): Parse associate-name in SELECT TYPE statements, and set up a local namespace for the SELECT TYPE block. * parse.h (gfc_build_block_ns): New prototype. * parse.c (parse_select_type_block): Return from local namespace to its parent after SELECT TYPE block. (gfc_build_block_ns): New function for setting up the local namespace for a BLOCK construct. (parse_block_construct): Use gfc_build_block_ns. * resolve.c (resolve_select_type): Insert assignment for the selector variable, in case an associate-name is given, and put the SELECT TYPE statement inside a BLOCK. (resolve_code): Call resolve_class_assign after checking the assignment. * symbol.c (gfc_find_sym_tree): Moved some code here from gfc_get_ha_sym_tree. (gfc_get_ha_sym_tree): Moved some code to gfc_find_sym_tree. 2009-10-07 Janus Weil * gfortran.dg/same_type_as_2.f03: Modified (was illegal). * gfortran.dg/select_type_1.f03: Modified error message. * gfortran.dg/select_type_5.f03: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@152526 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 39 ++++++++++++++++++++++++--------------- 1 file changed, 24 insertions(+), 15 deletions(-) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 13199c91bb0..770c7efe9f6 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -2909,12 +2909,8 @@ parse_select_type_block (void) if (st == ST_NONE) unexpected_eof (); if (st == ST_END_SELECT) - { - /* Empty SELECT CASE is OK. */ - accept_statement (st); - pop_state (); - return; - } + /* Empty SELECT CASE is OK. */ + goto done; if (st == ST_TYPE_IS || st == ST_CLASS_IS) break; @@ -2959,8 +2955,10 @@ parse_select_type_block (void) } while (st != ST_END_SELECT); +done: pop_state (); accept_statement (st); + gfc_current_ns = gfc_current_ns->parent; } @@ -3033,18 +3031,13 @@ check_do_closure (void) static void parse_progunit (gfc_statement); -/* Parse a BLOCK construct. */ +/* Set up the local namespace for a BLOCK construct. */ -static void -parse_block_construct (void) +gfc_namespace* +gfc_build_block_ns (gfc_namespace *parent_ns) { - gfc_namespace* parent_ns; gfc_namespace* my_ns; - gfc_state_data s; - gfc_notify_std (GFC_STD_F2008, "Fortran 2008: BLOCK construct at %C"); - - parent_ns = gfc_current_ns; my_ns = gfc_get_namespace (parent_ns, 1); my_ns->construct_entities = 1; @@ -3066,6 +3059,22 @@ parse_block_construct (void) } my_ns->proc_name->attr.recursive = parent_ns->proc_name->attr.recursive; + return my_ns; +} + + +/* Parse a BLOCK construct. */ + +static void +parse_block_construct (void) +{ + gfc_namespace* my_ns; + gfc_state_data s; + + gfc_notify_std (GFC_STD_F2008, "Fortran 2008: BLOCK construct at %C"); + + my_ns = gfc_build_block_ns (gfc_current_ns); + new_st.op = EXEC_BLOCK; new_st.ext.ns = my_ns; accept_statement (ST_BLOCK); @@ -3075,7 +3084,7 @@ parse_block_construct (void) parse_progunit (ST_NONE); - gfc_current_ns = parent_ns; + gfc_current_ns = gfc_current_ns->parent; pop_state (); } -- cgit v1.2.1 From c151eaabaf50c3360ef47e70c15abd146ad11cd1 Mon Sep 17 00:00:00 2001 From: janus Date: Fri, 9 Oct 2009 20:25:19 +0000 Subject: 2009-10-09 Janus Weil PR fortran/41579 * gfortran.h (gfc_select_type_stack): New struct, to be used as a stack for SELECT TYPE statements. (select_type_stack): New global variable. (type_selector,select_type_tmp): Removed. * match.c (type_selector,type_selector): Removed. (select_type_stack): New variable, serving as a stack for SELECT TYPE statements. (select_type_push,select_type_set_tmp): New functions. (gfc_match_select_type): Call select_type_push. (gfc_match_type_is): Call select_type_set_tmp. * parse.c (select_type_pop): New function. (parse_select_type_block): Call select_type_pop. * symbol.c (select_type_insert_tmp): New function. (gfc_find_sym_tree): Call select_type_insert_tmp. 2009-10-09 Janus Weil PR fortran/41579 * gfortran.dg/select_type_6.f03: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@152600 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 12 ++++++++++++ 1 file changed, 12 insertions(+) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 770c7efe9f6..49d449cfdc8 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -2887,6 +2887,17 @@ parse_select_block (void) } +/* Pop the current selector from the SELECT TYPE stack. */ + +static void +select_type_pop (void) +{ + gfc_select_type_stack *old = select_type_stack; + select_type_stack = old->prev; + gfc_free (old); +} + + /* Parse a SELECT TYPE construct (F03:R821). */ static void @@ -2959,6 +2970,7 @@ done: pop_state (); accept_statement (st); gfc_current_ns = gfc_current_ns->parent; + select_type_pop (); } -- cgit v1.2.1 From b3704193582f3a455ad91d1d20b99034ca9ddb02 Mon Sep 17 00:00:00 2001 From: pault Date: Sat, 17 Oct 2009 18:09:25 +0000 Subject: 2009-10-17 Janus Weil Paul Thomas PR fortran/41608 * decl.c (gfc_match_data_decl): Add BT_CLASS for undefined type and empty type errors. * parse.c (gfc_build_block_ns): Only set recursive if parent ns has a proc_name. PR fortran/41629 PR fortran/41618 PR fortran/41587 * gfortran.h : Add class_ok bitfield to symbol_attr. * decl.c (build_sym): Set attr.class_ok if dummy, pointer or allocatable. (build_struct): Use gfc_try 't' to carry errors past the call to encapsulate_class_symbol. (attr_decl1): For a CLASS object, apply the new attribute to the data component. * match.c (gfc_match_select_type): Set attr.class_ok for an assigned selector. * resolve.c (resolve_fl_variable_derived): Check a CLASS object is dummy, pointer or allocatable by testing the class_ok and the use_assoc attribute. 2009-10-17 Janus Weil Paul Thomas PR fortran/41629 * gfortran.dg/class_6.f90: New test. PR fortran/41608 PR fortran/41587 * gfortran.dg/class_7.f90: New test. PR fortran/41618 * gfortran.dg/class_8.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@152955 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 49d449cfdc8..c168c52147f 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -3069,7 +3069,9 @@ gfc_build_block_ns (gfc_namespace *parent_ns) my_ns->proc_name->name, NULL); gcc_assert (t == SUCCESS); } - my_ns->proc_name->attr.recursive = parent_ns->proc_name->attr.recursive; + + if (parent_ns->proc_name) + my_ns->proc_name->attr.recursive = parent_ns->proc_name->attr.recursive; return my_ns; } -- cgit v1.2.1 From 0a96a7ccecc2a2e9bf373254760deaf74d43cadf Mon Sep 17 00:00:00 2001 From: janus Date: Mon, 19 Oct 2009 19:21:18 +0000 Subject: 2009-10-19 Janus Weil PR fortran/41586 * parse.c (parse_derived): Correctly set 'alloc_comp' and 'pointer_comp' for CLASS variables. * trans-array.c (structure_alloc_comps): Handle deallocation and nullification of allocatable scalar components. * trans-decl.c (gfc_get_symbol_decl): Remember allocatable scalars for automatic deallocation. (gfc_trans_deferred_vars): Automatically deallocate allocatable scalars. 2009-10-19 Janus Weil PR fortran/41586 * gfortran.dg/auto_dealloc_1.f90: New test case. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@152988 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index c168c52147f..95a327bf23d 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -2068,11 +2068,15 @@ endType: { /* Look for allocatable components. */ if (c->attr.allocatable + || (c->ts.type == BT_CLASS + && c->ts.u.derived->components->attr.allocatable) || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.alloc_comp)) sym->attr.alloc_comp = 1; /* Look for pointer components. */ if (c->attr.pointer + || (c->ts.type == BT_CLASS + && c->ts.u.derived->components->attr.pointer) || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.pointer_comp)) sym->attr.pointer_comp = 1; -- cgit v1.2.1 From 66a56860076243903465dadec8482f55d32144dc Mon Sep 17 00:00:00 2001 From: jakub Date: Sat, 28 Nov 2009 12:13:21 +0000 Subject: * trans-common.c (create_common): Remove unused offset variable. * io.c (gfc_match_wait): Remove unused loc variable. * trans-openmp.c (gfc_trans_omp_clauses): Remove unused old_clauses variable. (gfc_trans_omp_do): Remove unused outermost variable. * iresolve.c (gfc_resolve_alarm_sub, gfc_resolve_fseek_sub): Remove unused status variable. * module.c (number_use_names): Remove unused c variable. (load_derived_extensions): Remove unused nuse variable. * trans-expr.c (gfc_conv_substring): Remove unused var variable. * trans-types.c (gfc_get_array_descr_info): Remove unused offset_off variable. * matchexp.c (match_primary): Remove unused where variable. * trans-intrinsic.c (gfc_conv_intrinsic_bound): Remove unused cond2 variable. (gfc_conv_intrinsic_sizeof): Remove unused source variable. (gfc_conv_intrinsic_transfer): Remove unused stride variable. (gfc_conv_intrinsic_function): Remove unused isym variable. * arith.c (gfc_hollerith2real, gfc_hollerith2complex, gfc_hollerith2logical): Remove unused len variable. * parse.c (parse_derived): Remove unused derived_sym variable. * decl.c (variable_decl): Remove unused old_locus variable. * resolve.c (check_class_members): Remove unused tbp_sym variable. (resolve_ordinary_assign): Remove unused assign_proc variable. (resolve_equivalence): Remove unused value_name variable. * data.c (get_array_index): Remove unused re variable. * trans-array.c (gfc_conv_array_transpose): Remove unused src_info variable. (gfc_conv_resolve_dependencies): Remove unused aref and temp_dim variables. (gfc_conv_loop_setup): Remove unused dim and len variables. (gfc_walk_variable_expr): Remove unused head variable. * match.c (match_typebound_call): Remove unused var variable. * intrinsic.c (gfc_convert_chartype): Remove unused from_ts variable. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@154722 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 3 --- 1 file changed, 3 deletions(-) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 95a327bf23d..c5d35484a3a 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -1940,7 +1940,6 @@ parse_derived (void) int compiling_type, seen_private, seen_sequence, seen_component, error_flag; gfc_statement st; gfc_state_data s; - gfc_symbol *derived_sym = NULL; gfc_symbol *sym; gfc_component *c; @@ -2061,8 +2060,6 @@ endType: /* need to verify that all fields of the derived type are * interoperable with C if the type is declared to be bind(c) */ - derived_sym = gfc_current_block(); - sym = gfc_current_block (); for (c = sym->components; c; c = c->next) { -- cgit v1.2.1 From 6d6202444e629924e529f8ae07aafe002b4abd94 Mon Sep 17 00:00:00 2001 From: dfranke Date: Thu, 10 Dec 2009 21:03:40 +0000 Subject: 2009-12-10 Daniel Franke PR fortran/41369 * parse.c (match_deferred_characteristics): Removed check for empty types in function return values. 2009-12-10 Daniel Franke PR fortran/41369 * gfortran.dg/func_derived_5.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@155141 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index c5d35484a3a..98d684ff86c 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -2340,7 +2340,7 @@ match_deferred_characteristics (gfc_typespec * ts) { ts->kind = 0; - if (!ts->u.derived || !ts->u.derived->components) + if (!ts->u.derived) m = MATCH_ERROR; } -- cgit v1.2.1 From 738928bee1b9d374e8d3db6508a3975867771734 Mon Sep 17 00:00:00 2001 From: burnus Date: Fri, 8 Jan 2010 09:23:26 +0000 Subject: 2010-01-08 Tobias Burnus Date: Tue, 2 Feb 2010 13:05:50 +0000 Subject: 2010-02-02 Tobias Burnus PR fortran/42650 * parse.c (decode_specification_statement): Use sym->result not * sym. 2010-02-02 Tobias Burnus PR fortran/42650 * gfortran.dg/func_result_5.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@156449 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 8f7ec29f1ad..9e8a123919e 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -111,7 +111,7 @@ decode_specification_statement (void) match ("import", gfc_match_import, ST_IMPORT); match ("use", gfc_match_use, ST_USE); - if (gfc_current_block ()->ts.type != BT_DERIVED) + if (gfc_current_block ()->result->ts.type != BT_DERIVED) goto end_of_block; match (NULL, gfc_match_st_function, ST_STATEMENT_FUNCTION); -- cgit v1.2.1 From 1384ae99ee84aa34f559ffb29468099e22d88dd2 Mon Sep 17 00:00:00 2001 From: pault Date: Thu, 1 Apr 2010 18:06:05 +0000 Subject: 2010-04-01 Paul Thomas * ioparm.def : Update copyright. * lang.opt : ditto * trans-array.c : ditto * trans-array.h : ditto * expr.c: ditto * trans-types.c: ditto * dependency.c : ditto * gfortran.h : ditto * options.c : ditto * trans-io.c : ditto * trans-intrinsic.c : ditto * libgfortran.h : ditto * invoke.texi : ditto * intrinsic.texi : ditto * trans.c : ditto * trans.h : ditto * intrinsic.c : ditto * interface.c : ditto * iresolve.c : ditto * trans-stmt.c : ditto * trans-stmt.h : ditto * parse,c : ditto * match.h : ditto * error.c : ditto git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@157923 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 9e8a123919e..2679e92a831 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -1,6 +1,6 @@ /* Main parser. Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, - 2009 + 2009, 2010 Free Software Foundation, Inc. Contributed by Andy Vaught -- cgit v1.2.1 From c6cd3066bcb72a59fecce6bfa99cb4e169a4a751 Mon Sep 17 00:00:00 2001 From: burnus Date: Tue, 6 Apr 2010 16:26:02 +0000 Subject: 2010-04-06 Tobias Burnus PR fortran/39997 * intrinsic.c (add_functions): Add num_images. * decl.c (gfc_match_end): Handle END CRITICAL. * intrinsic.h (gfc_simplify_num_images): Add prototype. * dump-parse-tree.c (show_code_node): Dump CRITICAL, ERROR STOP, and SYNC. * gfortran.h (gfc_statement): Add enum items for those. (gfc_exec_op) Ditto. (gfc_isym_id): Add num_images. * trans-stmt.c (gfc_trans_stop): Handle ERROR STOP. (gfc_trans_sync,gfc_trans_critical): New functions. * trans-stmt.h (gfc_trans_stop,gfc_trans_sync, gfc_trans_critical): Add/update prototypes. * trans.c (gfc_trans_code): Handle CRITICAL, ERROR STOP, and SYNC statements. * trans.h (gfor_fndecl_error_stop_string) Add variable. * resolve.c (resolve_sync): Add function. (gfc_resolve_blocks): Handle CRITICAL. (resolve_code): Handle CRITICAL, ERROR STOP, (resolve_branch): Add CRITICAL constraint check. and SYNC statements. * st.c (gfc_free_statement): Add new statements. * trans-decl.c (gfor_fndecl_error_stop_string): Global variable. (gfc_build_builtin_function_decls): Initialize it. * match.c (gfc_match_if): Handle ERROR STOP and SYNC. (gfc_match_critical, gfc_match_error_stop, sync_statement, gfc_match_sync_all, gfc_match_sync_images, gfc_match_sync_memory): New functions. (match_exit_cycle): Handle CRITICAL constraint. (gfc_match_stopcode): Handle ERROR STOP. * match.h (gfc_match_critical, gfc_match_error_stop, gfc_match_sync_all, gfc_match_sync_images, gfc_match_sync_memory): Add prototype. * parse.c (decode_statement, gfc_ascii_statement, parse_executable): Handle new statements. (parse_critical_block): New function. * parse.h (gfc_compile_state): Add COMP_CRITICAL. * intrinsic.texi (num_images): Document new function. * simplify.c (gfc_simplify_num_images): Add function. 2010-04-06 Tobias Burnus PR fortran/39997 * gfortran.dg/coarray_1.f90: New test. * gfortran.dg/coarray_2.f90: New test. * gfortran.dg/coarray_3.f90: New test. 2010-04-06 Tobias Burnus PR fortran/39997 * runtime/stop.c (error_stop_string): New function. * gfortran.map (_gfortran_error_stop_string): Add. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158008 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 100 ++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 94 insertions(+), 6 deletions(-) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 2679e92a831..7d935c33655 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -291,9 +291,9 @@ decode_statement (void) gfc_undo_symbols (); gfc_current_locus = old_locus; - /* Check for the IF, DO, SELECT, WHERE, FORALL and BLOCK statements, which - might begin with a block label. The match functions for these - statements are unusual in that their keyword is not seen before + /* Check for the IF, DO, SELECT, WHERE, FORALL, CRITICAL, and BLOCK + statements, which might begin with a block label. The match functions for + these statements are unusual in that their keyword is not seen before the matcher is called. */ if (gfc_match_if (&st) == MATCH_YES) @@ -311,8 +311,9 @@ decode_statement (void) gfc_undo_symbols (); gfc_current_locus = old_locus; - match (NULL, gfc_match_block, ST_BLOCK); match (NULL, gfc_match_do, ST_DO); + match (NULL, gfc_match_block, ST_BLOCK); + match (NULL, gfc_match_critical, ST_CRITICAL); match (NULL, gfc_match_select, ST_SELECT_CASE); match (NULL, gfc_match_select_type, ST_SELECT_TYPE); @@ -362,6 +363,7 @@ decode_statement (void) match ("else", gfc_match_else, ST_ELSE); match ("else where", gfc_match_elsewhere, ST_ELSEWHERE); match ("else if", gfc_match_elseif, ST_ELSEIF); + match ("error stop", gfc_match_error_stop, ST_ERROR_STOP); match ("enum , bind ( c )", gfc_match_enum, ST_ENUM); if (gfc_match_end (&st) == MATCH_YES) @@ -432,6 +434,9 @@ decode_statement (void) match ("sequence", gfc_match_eos, ST_SEQUENCE); match ("stop", gfc_match_stop, ST_STOP); match ("save", gfc_match_save, ST_ATTR_DECL); + match ("sync all", gfc_match_sync_all, ST_SYNC_ALL); + match ("sync images", gfc_match_sync_images, ST_SYNC_IMAGES); + match ("sync memory", gfc_match_sync_memory, ST_SYNC_MEMORY); break; case 't': @@ -936,7 +941,8 @@ next_statement (void) case ST_POINTER_ASSIGNMENT: case ST_EXIT: case ST_CYCLE: \ case ST_ASSIGNMENT: case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \ case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \ - case ST_OMP_BARRIER: case ST_OMP_TASKWAIT + case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_ERROR_STOP: \ + case ST_SYNC_ALL: case ST_SYNC_IMAGES: case ST_SYNC_MEMORY /* Statements that mark other executable statements. */ @@ -948,7 +954,7 @@ next_statement (void) case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \ case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \ case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \ - case ST_OMP_TASK + case ST_OMP_TASK: case ST_CRITICAL /* Declaration statements */ @@ -1082,6 +1088,7 @@ check_statement_label (gfc_statement st) case ST_ENDDO: case ST_ENDIF: case ST_END_SELECT: + case ST_END_CRITICAL: case_executable: case_exec_markers: type = ST_LABEL_TARGET; @@ -1176,6 +1183,9 @@ gfc_ascii_statement (gfc_statement st) case ST_CONTAINS: p = "CONTAINS"; break; + case ST_CRITICAL: + p = "CRITICAL"; + break; case ST_CYCLE: p = "CYCLE"; break; @@ -1209,6 +1219,9 @@ gfc_ascii_statement (gfc_statement st) case ST_END_BLOCK_DATA: p = "END BLOCK DATA"; break; + case ST_END_CRITICAL: + p = "END CRITICAL"; + break; case ST_ENDDO: p = "END DO"; break; @@ -1251,6 +1264,9 @@ gfc_ascii_statement (gfc_statement st) case ST_EQUIVALENCE: p = "EQUIVALENCE"; break; + case ST_ERROR_STOP: + p = "ERROR STOP"; + break; case ST_EXIT: p = "EXIT"; break; @@ -1339,6 +1355,15 @@ gfc_ascii_statement (gfc_statement st) case ST_STOP: p = "STOP"; break; + case ST_SYNC_ALL: + p = "SYNC ALL"; + break; + case ST_SYNC_IMAGES: + p = "SYNC IMAGES"; + break; + case ST_SYNC_MEMORY: + p = "SYNC MEMORY"; + break; case ST_SUBROUTINE: p = "SUBROUTINE"; break; @@ -1555,6 +1580,7 @@ accept_statement (gfc_statement st) case ST_ENDIF: case ST_END_SELECT: + case ST_END_CRITICAL: if (gfc_statement_label != NULL) { new_st.op = EXEC_END_BLOCK; @@ -3047,6 +3073,61 @@ check_do_closure (void) static void parse_progunit (gfc_statement); +/* Parse a CRITICAL block. */ + +static void +parse_critical_block (void) +{ + gfc_code *top, *d; + gfc_state_data s; + gfc_statement st; + + s.ext.end_do_label = new_st.label1; + + accept_statement (ST_CRITICAL); + top = gfc_state_stack->tail; + + push_state (&s, COMP_CRITICAL, gfc_new_block); + + d = add_statement (); + d->op = EXEC_CRITICAL; + top->block = d; + + do + { + st = parse_executable (ST_NONE); + + switch (st) + { + case ST_NONE: + unexpected_eof (); + break; + + case ST_END_CRITICAL: + if (s.ext.end_do_label != NULL + && s.ext.end_do_label != gfc_statement_label) + gfc_error_now ("Statement label in END CRITICAL at %C does not " + "match CRITIAL label"); + + if (gfc_statement_label != NULL) + { + new_st.op = EXEC_NOP; + add_statement (); + } + break; + + default: + unexpected_statement (st); + break; + } + } + while (st != ST_END_CRITICAL); + + pop_state (); + accept_statement (st); +} + + /* Set up the local namespace for a BLOCK construct. */ gfc_namespace* @@ -3472,9 +3553,12 @@ parse_executable (gfc_statement st) case ST_CYCLE: case ST_PAUSE: case ST_STOP: + case ST_ERROR_STOP: case ST_END_SUBROUTINE: case ST_DO: + case ST_CRITICAL: + case ST_BLOCK: case ST_FORALL: case ST_WHERE: case ST_SELECT_CASE: @@ -3522,6 +3606,10 @@ parse_executable (gfc_statement st) return ST_IMPLIED_ENDDO; break; + case ST_CRITICAL: + parse_critical_block (); + break; + case ST_WHERE_BLOCK: parse_where_block (); break; -- cgit v1.2.1 From aff518b0c6c0be70a7a986a3abe418ddc323eaf8 Mon Sep 17 00:00:00 2001 From: burnus Date: Tue, 6 Apr 2010 18:16:13 +0000 Subject: 2010-04-06 Tobias Burnus PR fortran/18918 * array.c (gfc_free_array_spec,gfc_resolve_array_spec, match_array_element_spec,gfc_copy_array_spec, gfc_compare_array_spec): Include corank. (match_array_element_spec,gfc_set_array_spec): Support codimension. * decl.c (build_sym,build_struct,variable_decl, match_attr_spec,attr_decl1,cray_pointer_decl, gfc_match_volatile): Add codimension. (gfc_match_codimension): New function. * dump-parse-tree.c (show_array_spec,show_attr): Support * codimension. * gfortran.h (symbol_attribute,gfc_array_spec): Ditto. (gfc_add_codimension): New function prototype. * match.h (gfc_match_codimension): New function prototype. (gfc_match_array_spec): Update prototype * match.c (gfc_match_common): Update gfc_match_array_spec call. * module.c (MOD_VERSION): Bump. (mio_symbol_attribute): Support coarray attributes. (mio_array_spec): Add corank support. * parse.c (decode_specification_statement,decode_statement, parse_derived): Add coarray support. * resolve.c (resolve_formal_arglist, was_declared, is_non_constant_shape_array, resolve_fl_variable, resolve_fl_derived, resolve_symbol): Add coarray support. * symbol.c (check_conflict, gfc_add_volatile, gfc_copy_attr, gfc_build_class_symbol): Add coarray support. (gfc_add_codimension): New function. 2010-04-06 Tobias Burnus PR fortran/18918 * gfortran.dg/coarray_4.f90: New test. * gfortran.dg/coarray_5.f90: New test. * gfortran.dg/coarray_6.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158012 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 7d935c33655..b68afba3d66 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -138,6 +138,7 @@ decode_specification_statement (void) break; case 'c': + match ("codimension", gfc_match_codimension, ST_ATTR_DECL); break; case 'd': @@ -349,6 +350,7 @@ decode_statement (void) match ("common", gfc_match_common, ST_COMMON); match ("contains", gfc_match_eos, ST_CONTAINS); match ("class", gfc_match_class_is, ST_CLASS_IS); + match ("codimension", gfc_match_codimension, ST_ATTR_DECL); break; case 'd': @@ -2112,6 +2114,10 @@ endType: && c->ts.u.derived->attr.proc_pointer_comp)) sym->attr.proc_pointer_comp = 1; + /* Looking for coarray components. */ + if (c->attr.codimension || c->attr.coarray_comp) + sym->attr.coarray_comp = 1; + /* Look for private components. */ if (sym->component_access == ACCESS_PRIVATE || c->attr.access == ACCESS_PRIVATE -- cgit v1.2.1 From 2d640d61aabac1395dd2f903d406cf037df4cf7e Mon Sep 17 00:00:00 2001 From: burnus Date: Tue, 6 Apr 2010 18:23:56 +0000 Subject: 2010-04-06 Tobias Burnus PR fortran/18918 * gfortran.h (gfc_array_spec): Add cotype. * array.c (gfc_match_array_spec,gfc_set_array_spec): Use it and defer error diagnostic. * resolve.c (resolve_fl_derived): Add missing check. (resolve_symbol): Add cotype/type check. * parse.c (parse_derived): Fix setting of coarray_comp. 2010-04-06 Tobias Burnus PR fortran/18918 * gfortran.dg/coarray_4.f90: Fix test. * gfortran.dg/coarray_6.f90: Add more tests. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158014 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index b68afba3d66..190148c24ee 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -2115,7 +2115,8 @@ endType: sym->attr.proc_pointer_comp = 1; /* Looking for coarray components. */ - if (c->attr.codimension || c->attr.coarray_comp) + if (c->attr.codimension + || (c->attr.coarray_comp && !c->attr.pointer && !c->attr.allocatable)) sym->attr.coarray_comp = 1; /* Look for private components. */ -- cgit v1.2.1 From 4081d362fba108e17784f385774bfae44e2dcee2 Mon Sep 17 00:00:00 2001 From: jakub Date: Wed, 7 Apr 2010 20:27:37 +0000 Subject: * tree-ssa-pre.c (my_rev_post_order_compute): Remove set but not used count variable. * genemit.c (gen_expand, gen_split): Avoid set but not used warnings when operandN variables aren't used in the body of the expander or splitter. * tree-outof-ssa.c (FOR_EACH_ELIM_GRAPH_SUCC, FOR_EACH_ELIM_GRAPH_PRED): Avoid set but not used warnings. * tree-ssa-operands.h (FOR_EACH_SSA_TREE_OPERAND): Likewise. * tree-flow.h (FOR_EACH_IMM_USE_FAST, FOR_EACH_IMM_USE_STMT, FOR_EACH_IMM_USE_ON_STMT): Likewise. * tree.h (FOR_EACH_CONSTRUCTOR_ELT): Likewise. * tree.c (PROCESS_ARG): Likewise. fortran/ * parse.c (parse_derived, parse_enum): Avoid set but not used warning. java/ * expr.c (process_jvm_instruction): Avoid set but not used warning. * builtins.c (compareAndSwapInt_builtin, compareAndSwapLong_builtin, getVolatile_builtin): Likewise. libjava/ * exception.cc (_Jv_Throw): Avoid set but not used warning. * include/java-assert.h (JvAssertMessage, JvAssert): Use argument in sizeof to avoid set but not used warnings. libjava/classpath/ * native/jni/midi-alsa/gnu_javax_sound_midi_alsa_AlsaPortDevice.c (Java_gnu_javax_sound_midi_alsa_AlsaPortDevice_run_1receiver_1thread_1): Avoid set but not used warning. libiberty/ * regex.c (byte_re_match_2_internal): Avoid set but not used warning. gcc/testsuite/ * gcc.dg/builtin-choose-expr.c: Avoid set but not used warnings. * gcc.dg/trunc-1.c: Likewise. * gcc.dg/vla-9.c: Likewise. * gcc.dg/dfp/composite-type.c: Likewise. libffi/ * testsuite/libffi.call/err_bad_abi.c: Remove unused args variable. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158084 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 40 ++++++++++------------------------------ 1 file changed, 10 insertions(+), 30 deletions(-) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 190148c24ee..ef8931d2a2c 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -1968,14 +1968,12 @@ parse_derived_contains (void) static void parse_derived (void) { - int compiling_type, seen_private, seen_sequence, seen_component, error_flag; + int compiling_type, seen_private, seen_sequence, seen_component; gfc_statement st; gfc_state_data s; gfc_symbol *sym; gfc_component *c; - error_flag = 0; - accept_statement (ST_DERIVED_DECL); push_state (&s, COMP_DERIVED, gfc_new_block); @@ -2002,18 +2000,15 @@ parse_derived (void) case ST_FINAL: gfc_error ("FINAL declaration at %C must be inside CONTAINS"); - error_flag = 1; break; case ST_END_TYPE: endType: compiling_type = 0; - if (!seen_component - && (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Derived type " - "definition at %C without components") - == FAILURE)) - error_flag = 1; + if (!seen_component) + gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Derived type " + "definition at %C without components"); accept_statement (ST_END_TYPE); break; @@ -2023,7 +2018,6 @@ endType: { gfc_error ("PRIVATE statement in TYPE at %C must be inside " "a MODULE"); - error_flag = 1; break; } @@ -2031,15 +2025,11 @@ endType: { gfc_error ("PRIVATE statement at %C must precede " "structure components"); - error_flag = 1; break; } if (seen_private) - { - gfc_error ("Duplicate PRIVATE statement at %C"); - error_flag = 1; - } + gfc_error ("Duplicate PRIVATE statement at %C"); s.sym->component_access = ACCESS_PRIVATE; @@ -2052,7 +2042,6 @@ endType: { gfc_error ("SEQUENCE statement at %C must precede " "structure components"); - error_flag = 1; break; } @@ -2063,7 +2052,6 @@ endType: if (seen_sequence) { gfc_error ("Duplicate SEQUENCE statement at %C"); - error_flag = 1; } seen_sequence = 1; @@ -2072,14 +2060,12 @@ endType: break; case ST_CONTAINS: - if (gfc_notify_std (GFC_STD_F2003, - "Fortran 2003: CONTAINS block in derived type" - " definition at %C") == FAILURE) - error_flag = 1; + gfc_notify_std (GFC_STD_F2003, + "Fortran 2003: CONTAINS block in derived type" + " definition at %C"); accept_statement (ST_CONTAINS); - if (parse_derived_contains ()) - error_flag = 1; + parse_derived_contains (); goto endType; default: @@ -2138,14 +2124,11 @@ endType: static void parse_enum (void) { - int error_flag; gfc_statement st; int compiling_enum; gfc_state_data s; int seen_enumerator = 0; - error_flag = 0; - push_state (&s, COMP_ENUM, gfc_new_block); compiling_enum = 1; @@ -2167,10 +2150,7 @@ parse_enum (void) case ST_END_ENUM: compiling_enum = 0; if (!seen_enumerator) - { - gfc_error ("ENUM declaration at %C has no ENUMERATORS"); - error_flag = 1; - } + gfc_error ("ENUM declaration at %C has no ENUMERATORS"); accept_statement (st); break; -- cgit v1.2.1 From 09c509edcc2f6e6859f02de43ce0fe10a941a8d7 Mon Sep 17 00:00:00 2001 From: pault Date: Thu, 29 Apr 2010 19:10:48 +0000 Subject: 2010-04-29 Janus Weil PR fortran/43896 * symbol.c (add_proc_component,copy_vtab_proc_comps): Remove initializers for PPC members of the vtabs. 2010-04-29 Janus Weil PR fortran/42274 * symbol.c (add_proc_component,add_proc_comps): Correctly set the 'ppc' attribute for all PPC members of the vtypes. (copy_vtab_proc_comps): Copy the correct interface. * trans.h (gfc_trans_assign_vtab_procs): Modified prototype. * trans-expr.c (gfc_trans_assign_vtab_procs): Pass the derived type as a dummy argument and make sure all PPC members of the vtab are initialized correctly. (gfc_conv_derived_to_class,gfc_trans_class_assign): Additional argument in call to gfc_trans_assign_vtab_procs. * trans-stmt.c (gfc_trans_allocate): Ditto. 2010-04-29 Paul Thomas PR fortran/43326 * resolve.c (resolve_typebound_function): Renamed resolve_class_compcall.Do all the detection of class references here. (resolve_typebound_subroutine): resolve_class_typebound_call renamed. Otherwise same as resolve_typebound_function. (gfc_resolve_expr): Call resolve_typebound_function. (resolve_code): Call resolve_typebound_subroutine. 2010-04-29 Janus Weil PR fortran/43492 * resolve.c (resolve_typebound_generic_call): For CLASS methods pass back the specific symtree name, rather than the target name. 2010-04-29 Paul Thomas PR fortran/42353 * resolve.c (resolve_structure_cons): Make the initializer of the vtab component 'extends' the same type as the component. 2010-04-29 Jerry DeLisle PR fortran/42680 * interface.c (check_interface1): Pass symbol name rather than NULL to gfc_compare_interfaces.(gfc_compare_interfaces): Add assert to trap MULL. (gfc_compare_derived_types): Revert previous change incorporated incorrectly during merge from trunk, r155778. * resolve.c (check_generic_tbp_ambiguity): Pass symbol name rather than NULL to gfc_compare_interfaces. * symbol.c (add_generic_specifics): Likewise. 2010-02-29 Janus Weil PR fortran/42353 * interface.c (gfc_compare_derived_types): Add condition for vtype. * symbol.c (gfc_find_derived_vtab): Sey access to private. (gfc_find_derived_vtab): Likewise. * module.c (ab_attribute): Add enumerator AB_VTAB. (mio_symbol_attribute): Use new attribute, AB_VTAB. (check_for_ambiguous): Likewise. 2010-04-29 Paul Thomas Janus Weil PR fortran/41829 * trans-expr.c (select_class_proc): Remove function. (conv_function_val): Delete reference to previous. (gfc_conv_derived_to_class): Add second argument to the call to gfc_find_derived_vtab. (gfc_conv_structure): Exclude proc_pointer components when accessing $data field of class objects. (gfc_trans_assign_vtab_procs): New function. (gfc_trans_class_assign): Add second argument to the call to gfc_find_derived_vtab. * symbol.c (gfc_build_class_symbol): Add delayed_vtab arg and implement holding off searching for the vptr derived type. (add_proc_component): New function. (add_proc_comps): New function. (add_procs_to_declared_vtab1): New function. (copy_vtab_proc_comps): New function. (add_procs_to_declared_vtab): New function. (void add_generic_specifics): New function. (add_generics_to_declared_vtab): New function. (gfc_find_derived_vtab): Add second argument to the call to gfc_find_derived_vtab. Add the calls to add_procs_to_declared_vtab and add_generics_to_declared_vtab. * decl.c (build_sym, build_struct): Use new arg in calls to gfc_build_class_symbol. * gfortran.h : Add vtype bitfield to symbol_attr. Remove the definition of struct gfc_class_esym_list. Modify prototypes of gfc_build_class_symbol and gfc_find_derived_vtab. * trans-stmt.c (gfc_trans_allocate): Add second argument to the call to gfc_find_derived_vtab. * module.c : Add the vtype attribute. * trans.h : Add prototype for gfc_trans_assign_vtab_procs. * resolve.c (resolve_typebound_generic_call): Add second arg to pass along the generic name for class methods. (resolve_typebound_call): The same. (resolve_compcall): Use the second arg to carry the generic name from the above. Remove the reference to class_esym. (check_members, check_class_members, resolve_class_esym, hash_value_expr): Remove functions. (resolve_class_compcall, resolve_class_typebound_call): Modify to use vtable rather than member by member calls. (gfc_resolve_expr): Modify second arg in call to resolve_compcall. (resolve_select_type): Add second arg in call to gfc_find_derived_vtab. (resolve_code): Add second arg in call resolve_typebound_call. (resolve_fl_derived): Exclude vtypes from check for late procedure definitions. Likewise for checking of explicit interface and checking of pass arg. * iresolve.c (gfc_resolve_extends_type_of): Add second arg in calls to gfc_find_derived_vtab. * match.c (select_type_set_tmp): Use new arg in call to gfc_build_class_symbol. * trans-decl.c (gfc_get_symbol_decl): Complete vtable if necessary. * parse.c (endType): Finish incomplete classes. 2010-04-29 Janus Weil PR fortran/42274 * gfortran.dg/class_16.f03: New test. 2010-04-29 Janus Weil PR fortran/42274 * gfortran.dg/class_15.f03: New. 2010-04-29 Paul Thomas PR fortran/43326 * gfortran.dg/dynamic_dispatch_9.f03: New test. 2010-04-29 Janus Weil PR fortran/43492 * gfortran.dg/generic_22.f03 : New test. 2010-04-29 Paul Thomas PR fortran/42353 * gfortran.dg/class_14.f03: New test. 2010-04-29 Jerry DeLisle PR fortran/42680 * gfortran.dg/interface_32.f90: New test. 2009-04-29 Paul Thomas Janus Weil PR fortran/41829 * gfortran.dg/dynamic_dispatch_5.f03 : Change to "run". * gfortran.dg/dynamic_dispatch_7.f03 : New test. * gfortran.dg/dynamic_dispatch_8.f03 : New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158910 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index ef8931d2a2c..8ad52d28efb 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -2110,6 +2110,22 @@ endType: || c->attr.access == ACCESS_PRIVATE || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.private_comp)) sym->attr.private_comp = 1; + + /* Fix up incomplete CLASS components. */ + if (c->ts.type == BT_CLASS) + { + gfc_component *data; + gfc_component *vptr; + gfc_symbol *vtab; + data = gfc_find_component (c->ts.u.derived, "$data", true, true); + vptr = gfc_find_component (c->ts.u.derived, "$vptr", true, true); + if (vptr->ts.u.derived == NULL) + { + vtab = gfc_find_derived_vtab (data->ts.u.derived, false); + gcc_assert (vtab); + vptr->ts.u.derived = vtab->ts.u.derived; + } + } } if (!seen_component) -- cgit v1.2.1 From 501acd875d9aa0eccd275b8e68abaf8327415b49 Mon Sep 17 00:00:00 2001 From: kargl Date: Mon, 3 May 2010 17:57:14 +0000 Subject: 2010-05-03 Steven G. Kargl PR fortran/43592 * fortran/parse.c (parse_interface): Do not dereference a NULL pointer. 2010-05-03 Steven G. Kargl PR fortran/43592 * gfortran.dg/unexpected_interface.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158998 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 8ad52d28efb..93200694743 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -2264,9 +2264,9 @@ loop: { if (current_state == COMP_NONE) { - if (new_state == COMP_FUNCTION) + if (new_state == COMP_FUNCTION && sym) gfc_add_function (&sym->attr, sym->name, NULL); - else if (new_state == COMP_SUBROUTINE) + else if (new_state == COMP_SUBROUTINE && sym) gfc_add_subroutine (&sym->attr, sym->name, NULL); current_state = new_state; -- cgit v1.2.1 From ebdf1a90331e831625837777390992ff585cc16c Mon Sep 17 00:00:00 2001 From: janus Date: Sat, 22 May 2010 18:55:53 +0000 Subject: 2010-05-22 Janus Weil PR fortran/44212 * match.c (gfc_match_select_type): On error jump back out of the local namespace. * parse.c (parse_derived): Defer creation of vtab symbols to resolution stage, more precisely to ... * resolve.c (resolve_fl_derived): ... this place. 2010-05-22 Janus Weil PR fortran/44212 * gfortran.dg/class_22.f03: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159745 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 16 ---------------- 1 file changed, 16 deletions(-) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 93200694743..dfc589310a4 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -2110,22 +2110,6 @@ endType: || c->attr.access == ACCESS_PRIVATE || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.private_comp)) sym->attr.private_comp = 1; - - /* Fix up incomplete CLASS components. */ - if (c->ts.type == BT_CLASS) - { - gfc_component *data; - gfc_component *vptr; - gfc_symbol *vtab; - data = gfc_find_component (c->ts.u.derived, "$data", true, true); - vptr = gfc_find_component (c->ts.u.derived, "$vptr", true, true); - if (vptr->ts.u.derived == NULL) - { - vtab = gfc_find_derived_vtab (data->ts.u.derived, false); - gcc_assert (vtab); - vptr->ts.u.derived = vtab->ts.u.derived; - } - } } if (!seen_component) -- cgit v1.2.1 From 50b4b37ba4128b5e02d6b8af5f872770063c1d2b Mon Sep 17 00:00:00 2001 From: janus Date: Sun, 30 May 2010 21:56:11 +0000 Subject: 2010-05-30 Janus Weil * gcc/fortran/gfortran.h (CLASS_DATA): New macro for accessing the $data component of a class container. * gcc/fortran/decl.c (attr_decl1): Use macro CLASS_DATA. * gcc/fortran/expr.c (gfc_check_pointer_assign,gfc_check_assign_symbol, gfc_has_ultimate_allocatable,gfc_has_ultimate_pointer): Ditto. * gcc/fortran/interface.c (matching_typebound_op): Ditto. * gcc/fortran/match.c (gfc_match_allocate, gfc_match_deallocate): Ditto. * gcc/fortran/parse.c (parse_derived): Ditto. * gcc/fortran/primary.c (gfc_match_varspec, gfc_variable_attr, gfc_expr_attr): Ditto. * gcc/fortran/resolve.c (resolve_structure_cons, find_array_spec, resolve_deallocate_expr, resolve_allocate_expr, resolve_select_type, resolve_fl_var_and_proc, resolve_typebound_procedure, resolve_fl_derived): Ditto. * gcc/fortran/symbol.c (gfc_type_compatible): Restructured. * gcc/fortran/trans-array.c (structure_alloc_comps): Use macro CLASS_DATA. * gcc/fortran/trans-decl.c (gfc_get_symbol_decl, gfc_trans_deferred_vars): Ditto. * gcc/fortran/trans-stmt.c (gfc_trans_allocate): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@160060 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index dfc589310a4..31ad7cf385c 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -2082,15 +2082,13 @@ endType: { /* Look for allocatable components. */ if (c->attr.allocatable - || (c->ts.type == BT_CLASS - && c->ts.u.derived->components->attr.allocatable) + || (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable) || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.alloc_comp)) sym->attr.alloc_comp = 1; /* Look for pointer components. */ if (c->attr.pointer - || (c->ts.type == BT_CLASS - && c->ts.u.derived->components->attr.pointer) + || (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.pointer) || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.pointer_comp)) sym->attr.pointer_comp = 1; -- cgit v1.2.1 From 765cd02a2ed016ddf28e071479cefee07aa0b694 Mon Sep 17 00:00:00 2001 From: burnus Date: Wed, 2 Jun 2010 05:55:19 +0000 Subject: 2010-06-02 Tobias Burnus PR fortran/44360 * parse.c (gfc_fixup_sibling_symbols): Do not "fix" use-associated symbols. 2010-06-02 Tobias Burnus PR fortran/44360 * gfortran.dg/use_13.f90: New test case. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@160138 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 1 + 1 file changed, 1 insertion(+) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 31ad7cf385c..7fc35418bec 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -3667,6 +3667,7 @@ gfc_fixup_sibling_symbols (gfc_symbol *sym, gfc_namespace *siblings) || (old_sym->ts.type != BT_UNKNOWN && !old_sym->attr.implicit_type) || old_sym->attr.flavor == FL_PARAMETER + || old_sym->attr.use_assoc || old_sym->attr.in_common || old_sym->attr.in_equivalence || old_sym->attr.data -- cgit v1.2.1 From d18a512a42d8072efb8b9f2bb82ea97536b4cea3 Mon Sep 17 00:00:00 2001 From: domob Date: Thu, 10 Jun 2010 14:47:49 +0000 Subject: 2010-06-10 Daniel Kraft PR fortran/38936 * gfortran.h (enum gfc_statement): Add ST_ASSOCIATE, ST_END_ASSOCIATE. (struct gfc_symbol): New field `assoc'. (struct gfc_association_list): New struct. (struct gfc_code): New struct `block' in union, move `ns' there and add association list. (gfc_free_association_list): New method. (gfc_has_vector_subscript): Made public; * match.h (gfc_match_associate): New method. * parse.h (enum gfc_compile_state): Add COMP_ASSOCIATE. * decl.c (gfc_match_end): Handle ST_END_ASSOCIATE. * interface.c (gfc_has_vector_subscript): Made public. (compare_actual_formal): Rename `has_vector_subscript' accordingly. * match.c (gfc_match_associate): New method. (gfc_match_select_type): Change reference to gfc_code's `ns' field. * primary.c (match_variable): Don't allow names associated to expr here. * parse.c (decode_statement): Try matching ASSOCIATE statement. (case_exec_markers, case_end): Add ASSOCIATE statement. (gfc_ascii_statement): Hande ST_ASSOCIATE and ST_END_ASSOCIATE. (parse_associate): New method. (parse_executable): Handle ST_ASSOCIATE. (parse_block_construct): Change reference to gfc_code's `ns' field. * resolve.c (resolve_select_type): Ditto. (resolve_code): Ditto. (resolve_block_construct): Ditto and add comment. (resolve_select_type): Set association list in generated BLOCK to NULL. (resolve_symbol): Resolve associate names. * st.c (gfc_free_statement): Change reference to gfc_code's `ns' field and free association list. (gfc_free_association_list): New method. * symbol.c (gfc_new_symbol): NULL new field `assoc'. * trans-stmt.c (gfc_trans_block_construct): Change reference to gfc_code's `ns' field. 2010-06-10 Daniel Kraft PR fortran/38936 * gfortran.dg/associate_1.f03: New test. * gfortran.dg/associate_2.f95: New test. * gfortran.dg/associate_3.f03: New test. * gfortran.dg/associate_4.f08: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@160550 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 108 +++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 102 insertions(+), 6 deletions(-) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 7fc35418bec..7b887bc1e39 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -292,7 +292,7 @@ decode_statement (void) gfc_undo_symbols (); gfc_current_locus = old_locus; - /* Check for the IF, DO, SELECT, WHERE, FORALL, CRITICAL, and BLOCK + /* Check for the IF, DO, SELECT, WHERE, FORALL, CRITICAL, BLOCK and ASSOCIATE statements, which might begin with a block label. The match functions for these statements are unusual in that their keyword is not seen before the matcher is called. */ @@ -314,6 +314,7 @@ decode_statement (void) match (NULL, gfc_match_do, ST_DO); match (NULL, gfc_match_block, ST_BLOCK); + match (NULL, gfc_match_associate, ST_ASSOCIATE); match (NULL, gfc_match_critical, ST_CRITICAL); match (NULL, gfc_match_select, ST_SELECT_CASE); match (NULL, gfc_match_select_type, ST_SELECT_TYPE); @@ -949,7 +950,7 @@ next_statement (void) /* Statements that mark other executable statements. */ #define case_exec_markers case ST_DO: case ST_FORALL_BLOCK: \ - case ST_IF_BLOCK: case ST_BLOCK: \ + case ST_IF_BLOCK: case ST_BLOCK: case ST_ASSOCIATE: \ case ST_WHERE_BLOCK: case ST_SELECT_CASE: case ST_SELECT_TYPE: \ case ST_OMP_PARALLEL: \ case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_SECTIONS: case ST_OMP_ORDERED: \ @@ -970,7 +971,7 @@ next_statement (void) #define case_end case ST_END_BLOCK_DATA: case ST_END_FUNCTION: \ case ST_END_PROGRAM: case ST_END_SUBROUTINE: \ - case ST_END_BLOCK + case ST_END_BLOCK: case ST_END_ASSOCIATE /* Push a new state onto the stack. */ @@ -1155,6 +1156,9 @@ gfc_ascii_statement (gfc_statement st) case ST_ALLOCATE: p = "ALLOCATE"; break; + case ST_ASSOCIATE: + p = "ASSOCIATE"; + break; case ST_ATTR_DECL: p = _("attribute declaration"); break; @@ -1215,6 +1219,9 @@ gfc_ascii_statement (gfc_statement st) case ST_ELSEWHERE: p = "ELSEWHERE"; break; + case ST_END_ASSOCIATE: + p = "END ASSOCIATE"; + break; case ST_END_BLOCK: p = "END BLOCK"; break; @@ -3160,7 +3167,8 @@ parse_block_construct (void) my_ns = gfc_build_block_ns (gfc_current_ns); new_st.op = EXEC_BLOCK; - new_st.ext.ns = my_ns; + new_st.ext.block.ns = my_ns; + new_st.ext.block.assoc = NULL; accept_statement (ST_BLOCK); push_state (&s, COMP_BLOCK, my_ns->proc_name); @@ -3173,6 +3181,92 @@ parse_block_construct (void) } +/* Parse an ASSOCIATE construct. This is essentially a BLOCK construct + behind the scenes with compiler-generated variables. */ + +static void +parse_associate (void) +{ + gfc_namespace* my_ns; + gfc_state_data s; + gfc_statement st; + gfc_association_list* a; + gfc_code* assignTail; + + gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ASSOCIATE construct at %C"); + + my_ns = gfc_build_block_ns (gfc_current_ns); + + new_st.op = EXEC_BLOCK; + new_st.ext.block.ns = my_ns; + gcc_assert (new_st.ext.block.assoc); + + /* Add all associations to expressions as BLOCK variables, and create + assignments to them giving their values. */ + gfc_current_ns = my_ns; + assignTail = NULL; + for (a = new_st.ext.block.assoc; a; a = a->next) + if (!a->variable) + { + gfc_code* newAssign; + + if (gfc_get_sym_tree (a->name, NULL, &a->st, false)) + gcc_unreachable (); + + /* Note that in certain cases, the target-expression's type is not yet + known and so we have to adapt the symbol's ts also during resolution + for these cases. */ + a->st->n.sym->ts = a->target->ts; + a->st->n.sym->attr.flavor = FL_VARIABLE; + a->st->n.sym->assoc = a; + gfc_set_sym_referenced (a->st->n.sym); + + /* Create the assignment to calculate the expression and set it. */ + newAssign = gfc_get_code (); + newAssign->op = EXEC_ASSIGN; + newAssign->loc = gfc_current_locus; + newAssign->expr1 = gfc_get_variable_expr (a->st); + newAssign->expr2 = a->target; + + /* Hang it in. */ + if (assignTail) + assignTail->next = newAssign; + else + gfc_current_ns->code = newAssign; + assignTail = newAssign; + } + else + { + gfc_error ("Association to variables is not yet supported at %C"); + return; + } + gcc_assert (assignTail); + + accept_statement (ST_ASSOCIATE); + push_state (&s, COMP_ASSOCIATE, my_ns->proc_name); + +loop: + st = parse_executable (ST_NONE); + switch (st) + { + case ST_NONE: + unexpected_eof (); + + case_end: + accept_statement (st); + assignTail->next = gfc_state_stack->head; + break; + + default: + unexpected_statement (st); + goto loop; + } + + gfc_current_ns = gfc_current_ns->parent; + pop_state (); +} + + /* Parse a DO loop. Note that the ST_CYCLE and ST_EXIT statements are handled inside of parse_executable(), because they aren't really loop statements. */ @@ -3542,8 +3636,6 @@ parse_executable (gfc_statement st) case ST_END_SUBROUTINE: case ST_DO: - case ST_CRITICAL: - case ST_BLOCK: case ST_FORALL: case ST_WHERE: case ST_SELECT_CASE: @@ -3573,6 +3665,10 @@ parse_executable (gfc_statement st) parse_block_construct (); break; + case ST_ASSOCIATE: + parse_associate (); + break; + case ST_IF_BLOCK: parse_if_block (); break; -- cgit v1.2.1 From b3c3927c05d8ad190b76c56ae6020e1650b85a97 Mon Sep 17 00:00:00 2001 From: burnus Date: Mon, 21 Jun 2010 14:15:56 +0000 Subject: 2010-06-20 Tobias Burnus PR fortran/40632 * interface.c (compare_parameter): Add gfc_is_simply_contiguous checks. * symbol.c (gfc_add_contiguous): New function. (gfc_copy_attr, check_conflict): Handle contiguous attribute. * decl.c (match_attr_spec): Ditto. (gfc_match_contiguous): New function. * resolve.c (resolve_fl_derived, resolve_symbol): Handle contiguous. * gfortran.h (symbol_attribute): Add contiguous. (gfc_is_simply_contiguous): Add prototype. (gfc_add_contiguous): Add prototype. * match.h (gfc_match_contiguous): Add prototype. * parse.c (decode_specification_statement, decode_statement): Handle contiguous attribute. * expr.c (gfc_is_simply_contiguous): New function. * dump-parse-tree.c (show_attr): Handle contiguous. * module.c (ab_attribute, attr_bits, mio_symbol_attribute): Ditto. * trans-expr.c (gfc_add_interface_mapping): Copy attr.contiguous. * trans-array.c (gfc_conv_descriptor_stride_get, gfc_conv_array_parameter): Handle contiguous arrays. * trans-types.c (gfc_build_array_type, gfc_build_array_type, gfc_sym_type, gfc_get_derived_type, gfc_get_array_descr_info): Ditto. * trans.h (gfc_array_kind): Ditto. * trans-decl.c (gfc_get_symbol_decl): Ditto. 2010-06-20 Tobias Burnus PR fortran/40632 * gfortran.dg/contiguous_1.f90: New. * gfortran.dg/contiguous_2.f90: New. * gfortran.dg/contiguous_3.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@161079 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 2 ++ 1 file changed, 2 insertions(+) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 7b887bc1e39..26ea73a627c 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -139,6 +139,7 @@ decode_specification_statement (void) case 'c': match ("codimension", gfc_match_codimension, ST_ATTR_DECL); + match ("contiguous", gfc_match_contiguous, ST_ATTR_DECL); break; case 'd': @@ -346,6 +347,7 @@ decode_statement (void) match ("call", gfc_match_call, ST_CALL); match ("close", gfc_match_close, ST_CLOSE); match ("continue", gfc_match_continue, ST_CONTINUE); + match ("contiguous", gfc_match_contiguous, ST_ATTR_DECL); match ("cycle", gfc_match_cycle, ST_CYCLE); match ("case", gfc_match_case, ST_CASE); match ("common", gfc_match_common, ST_COMMON); -- cgit v1.2.1 From 1b37751e20018b7c3fc58446fc80066f8698088a Mon Sep 17 00:00:00 2001 From: burnus Date: Fri, 25 Jun 2010 19:01:04 +0000 Subject: 2010-06-25 Tobias Burnus * parse.c (next_free, next_fixed): Allow ";" as first character. 2010-06-25 Tobias Burnus * gfortran.dg/semicolon_fixed.f: Update. * gfortran.dg/semicolon_fixed_2.f: New. * gfortran.dg/semicolon_free_2.f90: New. * gfortran.dg/semicolon_free.f90: Update. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@161405 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 26ea73a627c..50f795723eb 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -717,7 +717,9 @@ next_free (void) if (at_bol && c == ';') { - gfc_error_now ("Semicolon at %C needs to be preceded by statement"); + if (!(gfc_option.allow_std & GFC_STD_F2008)) + gfc_error_now ("Fortran 2008: Semicolon at %C without preceding " + "statement"); gfc_next_ascii_char (); /* Eat up the semicolon. */ return ST_NONE; } @@ -853,7 +855,11 @@ next_fixed (void) if (c == ';') { - gfc_error_now ("Semicolon at %C needs to be preceded by statement"); + if (digit_flag) + gfc_error_now ("Semicolon at %C needs to be preceded by statement"); + else if (!(gfc_option.allow_std & GFC_STD_F2008)) + gfc_error_now ("Fortran 2008: Semicolon at %C without preceding " + "statement"); return ST_NONE; } -- cgit v1.2.1 From a33fbb6f8853e5ec06f3ec241af9f5e91bd4e1c3 Mon Sep 17 00:00:00 2001 From: janus Date: Sun, 11 Jul 2010 07:55:11 +0000 Subject: 2010-07-11 Janus Weil PR fortran/44689 * decl.c (build_sym,attr_decl1): Only build the class container if the symbol has sufficient attributes. * expr.c (gfc_check_pointer_assign): Use class_pointer instead of pointer attribute for classes. * match.c (gfc_match_allocate,gfc_match_deallocate): Ditto. * module.c (MOD_VERSION): Bump. (enum ab_attribute,attr_bits): Add AB_CLASS_POINTER. (mio_symbol_attribute): Handle class_pointer attribute. * parse.c (parse_derived): Use class_pointer instead of pointer attribute for classes. * primary.c (gfc_variable_attr,gfc_expr_attr): Ditto. * resolve.c (resolve_structure_cons,resolve_deallocate_expr, resolve_allocate_expr,resolve_fl_derived): Ditto. (resolve_fl_var_and_proc): Check for class_ok attribute. 2010-07-11 Janus Weil PR fortran/44689 * gfortran.dg/class_24.f03: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@162052 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/parse.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 50f795723eb..a1af0264658 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -2103,7 +2103,7 @@ endType: /* Look for pointer components. */ if (c->attr.pointer - || (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.pointer) + || (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.class_pointer) || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.pointer_comp)) sym->attr.pointer_comp = 1; -- cgit v1.2.1