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/primary.c | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'gcc/fortran/primary.c') diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 1a03165fcbe..cc6cada545c 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1388,7 +1388,7 @@ match_actual_arg (gfc_expr **result) have a function argument. */ if (symtree == NULL) { - gfc_get_sym_tree (name, NULL, &symtree); + gfc_get_sym_tree (name, NULL, &symtree, false); gfc_set_sym_referenced (symtree->n.sym); } else @@ -2365,7 +2365,7 @@ check_for_implicit_index (gfc_symtree **st, gfc_symbol **sym) && !(*sym)->attr.use_assoc) { int i; - i = gfc_get_sym_tree ((*sym)->name, NULL, st); + i = gfc_get_sym_tree ((*sym)->name, NULL, st, false); if (i) return MATCH_ERROR; *sym = (*st)->n.sym; @@ -2423,7 +2423,7 @@ gfc_match_rvalue (gfc_expr **result) if (gfc_find_state (COMP_INTERFACE) == SUCCESS && !gfc_current_ns->has_import_set) - i = gfc_get_sym_tree (name, NULL, &symtree); + i = gfc_get_sym_tree (name, NULL, &symtree, false); else i = gfc_get_ha_sym_tree (name, &symtree); @@ -2782,7 +2782,7 @@ gfc_match_rvalue (gfc_expr **result) /* Give up, assume we have a function. */ - gfc_get_sym_tree (name, NULL, &symtree); /* Can't fail */ + gfc_get_sym_tree (name, NULL, &symtree, false); /* Can't fail */ sym = symtree->n.sym; e->expr_type = EXPR_FUNCTION; @@ -2815,7 +2815,7 @@ gfc_match_rvalue (gfc_expr **result) break; generic_function: - gfc_get_sym_tree (name, NULL, &symtree); /* Can't fail */ + gfc_get_sym_tree (name, NULL, &symtree, false); /* Can't fail */ e = gfc_get_expr (); e->symtree = symtree; -- cgit v1.2.1 From ff70e44325c390560120b8ab5a8e0043d0403aef Mon Sep 17 00:00:00 2001 From: janus Date: Thu, 9 Jul 2009 14:07:03 +0000 Subject: 2009-07-09 Janus Weil PR fortran/40646 * dump-parse-tree.c (show_expr): Renamed 'is_proc_ptr_comp'. * expr.c (is_proc_ptr_comp): Renamed to 'gfc_is_proc_ptr_comp'. (gfc_check_pointer_assign): Renamed 'is_proc_ptr_comp'. (replace_comp,gfc_expr_replace_comp): New functions, analogous to 'replace_symbol' and 'gfc_expr_replace_symbol', just with components instead of symbols. * gfortran.h (gfc_expr_replace_comp): New prototype. (is_proc_ptr_comp): Renamed to 'gfc_is_proc_ptr_comp'. * interface.c (compare_actual_formal): Renamed 'is_proc_ptr_comp'. * match.c (gfc_match_pointer_assignment): Ditto. * primary.c (gfc_match_varspec): Handle array-valued procedure pointers and procedure pointer components. Renamed 'is_proc_ptr_comp'. * resolve.c (resolve_fl_derived): Correctly handle interfaces with RESULT statement, and handle array-valued procedure pointer components. (resolve_actual_arglist,resolve_ppc_call,resolve_expr_ppc): Renamed 'is_proc_ptr_comp'. * trans-array.c (gfc_walk_function_expr): Ditto. * trans-decl.c (gfc_get_symbol_decl): Security check for presence of ns->proc_name. * trans-expr.c (gfc_conv_procedure_call): Handle array-valued procedure pointer components. Renamed 'is_proc_ptr_comp'. (conv_function_val,gfc_trans_arrayfunc_assign): Renamed 'is_proc_ptr_comp'. (gfc_get_proc_ptr_comp): Do not modify the argument 'e', but instead make a copy of it. * trans-io.c (gfc_trans_transfer): Handle array-valued procedure pointer components. 2009-07-09 Janus Weil PR fortran/40646 * gfortran.dg/proc_ptr_22.f90: New. * gfortran.dg/proc_ptr_comp_12.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149419 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/primary.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/primary.c') diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index cc6cada545c..4a84aedbc30 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1727,7 +1727,10 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, gfc_gobble_whitespace (); if ((equiv_flag && gfc_peek_ascii_char () == '(') - || (sym->attr.dimension && !sym->attr.proc_pointer)) + || (sym->attr.dimension && !sym->attr.proc_pointer + && !gfc_is_proc_ptr_comp (primary, NULL) + && !(gfc_matching_procptr_assignment + && sym->attr.flavor == FL_PROCEDURE))) { /* In EQUIVALENCE, we don't know yet whether we are seeing an array, character variable or array of character -- cgit v1.2.1 From b2d83a62511ce18574a98f00fb4b0008153a83f6 Mon Sep 17 00:00:00 2001 From: pault Date: Fri, 10 Jul 2009 04:37:19 +0000 Subject: 2009-07-10 Paul Thomas PR fortran/39334 * primary.c (match_kind_param): Return MATCH_NO if the symbol has no value. 2009-07-10 Paul Thomas PR fortran/39334 * gfortran.dg/recursive_parameter_1.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149456 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/primary.c | 3 +++ 1 file changed, 3 insertions(+) (limited to 'gcc/fortran/primary.c') diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 4a84aedbc30..8013cc86d1e 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -57,6 +57,9 @@ match_kind_param (int *kind) if (sym->attr.flavor != FL_PARAMETER) return MATCH_NO; + if (sym->value == NULL) + return MATCH_NO; + p = gfc_extract_int (sym->value, kind); if (p != NULL) return MATCH_NO; -- cgit v1.2.1 From 165177fb4444856ed5b4ce00639a0bce7d3b7d76 Mon Sep 17 00:00:00 2001 From: burnus Date: Mon, 13 Jul 2009 06:26:38 +0000 Subject: 2009-07-12 Tobias Burnus Philippe Marguinaud PR fortran/40588 * primary.c (match_charkind_name): Fix condition for $ matching. PR libfortran/22423 * libgfortran.h: Typedef the GFC_DTYPE_* enum. 2009-07-12 Tobias Burnus PR libfortran/22423 * io/io.h (namelist_type): Use the proper enum for GFC_DTYPE_*. * intrinsics/iso_c_binding.c (c_f_pointer_u0): Make sure variable is initialized to silence warning. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149545 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/primary.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/fortran/primary.c') diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 8013cc86d1e..0d52c6c0940 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -832,7 +832,7 @@ match_charkind_name (char *name) if (!ISALNUM (c) && c != '_' - && (gfc_option.flag_dollar_ok && c != '$')) + && (c != '$' || !gfc_option.flag_dollar_ok)) break; *name++ = c; -- 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/primary.c | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) (limited to 'gcc/fortran/primary.c') diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 0d52c6c0940..e0021c54b18 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1770,7 +1770,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, if (sym->ts.type != BT_DERIVED || gfc_match_char ('%') != MATCH_YES) goto check_substring; - sym = sym->ts.derived; + sym = sym->ts.u.derived; for (;;) { @@ -1864,7 +1864,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, || gfc_match_char ('%') != MATCH_YES) break; - sym = component->ts.derived; + sym = component->ts.u.derived; } check_substring: @@ -1881,7 +1881,7 @@ check_substring: if (primary->ts.type == BT_CHARACTER) { - switch (match_substring (primary->ts.cl, equiv_flag, &substring)) + switch (match_substring (primary->ts.u.cl, equiv_flag, &substring)) { case MATCH_YES: if (tail == NULL) @@ -1893,7 +1893,7 @@ check_substring: primary->expr_type = EXPR_SUBSTRING; if (substring) - primary->ts.cl = NULL; + primary->ts.u.cl = NULL; break; @@ -1990,7 +1990,7 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts) follows. */ if (ts->type == BT_CHARACTER && ref->next && ref->next->type == REF_SUBSTRING) - ts->cl = NULL; + ts->u.cl = NULL; } pointer = ref->u.c.component->attr.pointer; @@ -2106,7 +2106,7 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head, value->where = gfc_current_locus; if (build_actual_constructor (comp_head, &value->value.constructor, - comp->ts.derived) == FAILURE) + comp->ts.u.derived) == FAILURE) { gfc_free_expr (value); return FAILURE; @@ -2284,13 +2284,13 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result, && sym->attr.extension && (comp_tail->val->ts.type != BT_DERIVED || - comp_tail->val->ts.derived != this_comp->ts.derived)) + comp_tail->val->ts.u.derived != this_comp->ts.u.derived)) { gfc_current_locus = where; gfc_free_expr (comp_tail->val); comp_tail->val = NULL; - m = gfc_match_structure_constructor (comp->ts.derived, + m = gfc_match_structure_constructor (comp->ts.u.derived, &comp_tail->val, true); if (m == MATCH_NO) goto syntax; @@ -2335,7 +2335,7 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result, e->expr_type = EXPR_STRUCTURE; e->ts.type = BT_DERIVED; - e->ts.derived = sym; + e->ts.u.derived = sym; e->where = where; e->value.constructor = ctor_head; @@ -2758,7 +2758,7 @@ gfc_match_rvalue (gfc_expr **result) that we're not sure is a variable yet. */ if ((implicit_char || sym->ts.type == BT_CHARACTER) - && match_substring (sym->ts.cl, 0, &e->ref) == MATCH_YES) + && match_substring (sym->ts.u.cl, 0, &e->ref) == MATCH_YES) { e->expr_type = EXPR_VARIABLE; @@ -2780,7 +2780,7 @@ gfc_match_rvalue (gfc_expr **result) e->ts = sym->ts; if (e->ref) - e->ts.cl = NULL; + e->ts.u.cl = NULL; m = MATCH_YES; break; } @@ -2957,7 +2957,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag) type may still have to be resolved. */ if (sym->ts.type == BT_DERIVED - && gfc_use_derived (sym->ts.derived) == NULL) + && gfc_use_derived (sym->ts.u.derived) == NULL) return MATCH_ERROR; break; } -- cgit v1.2.1 From 1d84f30a09bc526c646dbbbef88787b991feca8f Mon Sep 17 00:00:00 2001 From: janus Date: Fri, 21 Aug 2009 09:43:04 +0000 Subject: 2009-08-21 Janus Weil PR fortran/41106 * primary.c (gfc_variable_attr): Make it work also on EXPR_FUNCTION. (gfc_expr_attr): Use gfc_variable_attr for procedure pointer components. * resolve.c (resolve_fl_derived): Handle CHARACTER-valued procedure pointer components. * trans-expr.c (gfc_conv_component_ref): Ditto. (gfc_conv_variable): Ditto. (gfc_conv_procedure_call): Ditto. (gfc_trans_pointer_assignment): Ditto. * trans-types.c (gfc_get_derived_type): Ditto. 2009-08-21 Janus Weil PR fortran/41106 * gfortran.dg/proc_ptr_23.f90: New. * gfortran.dg/proc_ptr_comp_15.f90: New. * gfortran.dg/proc_ptr_comp_16.f90: New. * gfortran.dg/proc_ptr_comp_17.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@150987 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/primary.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/primary.c') diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index e0021c54b18..0a917f7f048 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1938,7 +1938,7 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts) symbol_attribute attr; gfc_ref *ref; - if (expr->expr_type != EXPR_VARIABLE) + if (expr->expr_type != EXPR_VARIABLE && expr->expr_type != EXPR_FUNCTION) gfc_internal_error ("gfc_variable_attr(): Expression isn't a variable"); ref = expr->ref; @@ -2032,6 +2032,8 @@ gfc_expr_attr (gfc_expr *e) if (e->value.function.esym != NULL) attr = e->value.function.esym->result->attr; + else + attr = gfc_variable_attr (e, NULL); /* TODO: NULL() returns pointers. May have to take care of this here. */ -- cgit v1.2.1 From 0fd53ac9e79421de9b0d1f42521f15e9845983e7 Mon Sep 17 00:00:00 2001 From: janus Date: Tue, 25 Aug 2009 14:26:44 +0000 Subject: 2009-08-25 Janus Weil PR fortran/41139 * primary.c (gfc_match_varspec): Make sure EXPR_PPC is only used for calls to procedure pointer components, other references to procedure pointer components are EXPR_VARIABLE. * resolve.c (resolve_actual_arglist): Bugfix (there can be calls without actual arglist). * trans-expr.c (gfc_get_proc_ptr_comp): Renamed to 'get_proc_ptr_comp', removed argument 'se' and made static. Avoid inserting a temporary variable for calling the PPC. (conv_function_val): Renamed gfc_get_proc_ptr_comp. (gfc_conv_procedure_call): Distinguish functions returning a procedure pointer from calls to a procedure pointer. Distinguish calls to procedure pointer components from procedure pointer components as actual arguments. * trans-stmt.h (gfc_get_proc_ptr_comp): Make it static. 2009-08-25 Janus Weil PR fortran/41139 * gfortran.dg/proc_ptr_25.f90: New. * gfortran.dg/proc_ptr_comp_18.f90: New. * gfortran.dg/proc_ptr_comp_19.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@151081 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/primary.c | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) (limited to 'gcc/fortran/primary.c') diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 0a917f7f048..79db19510f2 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1839,13 +1839,12 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, if (component->attr.proc_pointer && ppc_arg && !gfc_matching_procptr_assignment) { - primary->expr_type = EXPR_PPC; - m = gfc_match_actual_arglist (component->attr.subroutine, + m = gfc_match_actual_arglist (sub_flag, &primary->value.compcall.actual); if (m == MATCH_ERROR) return MATCH_ERROR; - if (m == MATCH_NO) - primary->value.compcall.actual = NULL; + if (m == MATCH_YES) + primary->expr_type = EXPR_PPC; break; } -- cgit v1.2.1 From 7d034542867cddd55dc133813dae02338fdb9cf2 Mon Sep 17 00:00:00 2001 From: domob Date: Thu, 27 Aug 2009 11:42:56 +0000 Subject: 2009-08-27 Daniel Kraft PR fortran/37425 * gfortran.h (gfc_expr): Optionally store base-object in compcall value and add a new flag to distinguish assign-calls generated. (gfc_find_typebound_proc): Add locus argument. (gfc_find_typebound_user_op), (gfc_find_typebound_intrinsic_op): Ditto. (gfc_extend_expr): Return if failure was by a real error. * interface.c (matching_typebound_op): New routine. (build_compcall_for_operator): New routine. (gfc_extend_expr): Handle type-bound operators, some clean-up and return if failure was by a real error or just by not finding an appropriate operator definition. (gfc_extend_assign): Handle type-bound assignments. * module.c (MOD_VERSION): Incremented. (mio_intrinsic_op): New routine. (mio_full_typebound_tree): New routine to make typebound-procedures IO code reusable for type-bound user operators. (mio_f2k_derived): IO of type-bound operators. * primary.c (gfc_match_varspec): Initialize new fields in gfc_expr and pass locus to gfc_find_typebound_proc. * resolve.c (resolve_operator): Only output error about no matching interface if gfc_extend_expr did not already fail with an error. (extract_compcall_passed_object): Use specified base-object if present. (update_compcall_arglist): Handle ignore_pass field. (resolve_ordinary_assign): Update to handle extended code for type-bound assignments, too. (resolve_code): Handle EXEC_ASSIGN_CALL statement code. (resolve_tb_generic_targets): Pass locus to gfc_find_typebound_proc. (resolve_typebound_generic), (resolve_typebound_procedure): Ditto. (resolve_typebound_intrinsic_op), (resolve_typebound_user_op): Ditto. (ensure_not_abstract_walker), (resolve_fl_derived): Ditto. (resolve_typebound_procedures): Remove not-implemented error. (resolve_typebound_call): Handle assign-call flag. * symbol.c (find_typebound_proc_uop): New argument to pass locus for error message about PRIVATE, verify that a found procedure is not marked as erraneous. (gfc_find_typebound_intrinsic_op): Ditto. (gfc_find_typebound_proc), (gfc_find_typebound_user_op): New locus arg. 2009-08-27 Daniel Kraft PR fortran/37425 * gfortran.dg/impure_assignment_1.f90: Change expected error message. * gfortran.dg/typebound_operator_1.f03: Remove check for not-implemented error and fix problem with recursive assignment. * gfortran.dg/typebound_operator_2.f03: No not-implemented check. * gfortran.dg/typebound_operator_3.f03: New test. * gfortran.dg/typebound_operator_4.f03: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@151140 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/primary.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/primary.c') diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 79db19510f2..267819c69f6 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1783,7 +1783,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, if (m != MATCH_YES) return MATCH_ERROR; - tbp = gfc_find_typebound_proc (sym, &t, name, false); + tbp = gfc_find_typebound_proc (sym, &t, name, false, &gfc_current_locus); if (tbp) { gfc_symbol* tbp_sym; @@ -1802,6 +1802,9 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, primary->expr_type = EXPR_COMPCALL; primary->value.compcall.tbp = tbp->n.tb; primary->value.compcall.name = tbp->name; + primary->value.compcall.ignore_pass = 0; + primary->value.compcall.assign = 0; + primary->value.compcall.base_object = NULL; gcc_assert (primary->symtree->n.sym->attr.referenced); if (tbp_sym) primary->ts = tbp_sym->ts; -- cgit v1.2.1 From ef95c72eedcf4c86338b63b4bd4ecae8f04e5b22 Mon Sep 17 00:00:00 2001 From: pault Date: Sat, 5 Sep 2009 14:20:51 +0000 Subject: 2009-09-05 Paul Thomas PR fortran/41258 * primary.c (gfc_match_varspec): Do not look for typebound procedures unless the derived type has a f2k_derived namespace. 2009-09-05 Paul Thomas PR fortran/41258 * gfortran.dg/typebound_proc_12.f90 : New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@151451 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/primary.c | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/primary.c') diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 267819c69f6..f25de2397bf 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1783,7 +1783,11 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, if (m != MATCH_YES) return MATCH_ERROR; - tbp = gfc_find_typebound_proc (sym, &t, name, false, &gfc_current_locus); + if (sym->f2k_derived) + tbp = gfc_find_typebound_proc (sym, &t, name, false, &gfc_current_locus); + else + tbp = NULL; + if (tbp) { gfc_symbol* tbp_sym; -- 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/primary.c | 74 +++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 60 insertions(+), 14 deletions(-) (limited to 'gcc/fortran/primary.c') diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index f25de2397bf..c0777c48b85 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1733,7 +1733,9 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, || (sym->attr.dimension && !sym->attr.proc_pointer && !gfc_is_proc_ptr_comp (primary, NULL) && !(gfc_matching_procptr_assignment - && sym->attr.flavor == FL_PROCEDURE))) + && sym->attr.flavor == FL_PROCEDURE)) + || (sym->ts.type == BT_CLASS + && sym->ts.u.derived->components->attr.dimension)) { /* In EQUIVALENCE, we don't know yet whether we are seeing an array, character variable or array of character @@ -1767,7 +1769,8 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, && gfc_get_default_type (sym->name, sym->ns)->type == BT_DERIVED) gfc_set_default_type (sym, 0, sym->ns); - if (sym->ts.type != BT_DERIVED || gfc_match_char ('%') != MATCH_YES) + if ((sym->ts.type != BT_DERIVED && sym->ts.type != BT_CLASS) + || gfc_match_char ('%') != MATCH_YES) goto check_substring; sym = sym->ts.u.derived; @@ -1865,8 +1868,21 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, if (m != MATCH_YES) return m; } + else if (component->ts.type == BT_CLASS + && component->ts.u.derived->components->as != NULL + && !component->attr.proc_pointer) + { + tail = extend_ref (primary, tail); + tail->type = REF_ARRAY; - if (component->ts.type != BT_DERIVED + m = gfc_match_array_ref (&tail->u.ar, + component->ts.u.derived->components->as, + equiv_flag); + if (m != MATCH_YES) + return m; + } + + if ((component->ts.type != BT_DERIVED && component->ts.type != BT_CLASS) || gfc_match_char ('%') != MATCH_YES) break; @@ -1875,7 +1891,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, check_substring: unknown = false; - if (primary->ts.type == BT_UNKNOWN) + if (primary->ts.type == BT_UNKNOWN && sym->attr.flavor != FL_DERIVED) { if (gfc_get_default_type (sym->name, sym->ns)->type == BT_CHARACTER) { @@ -1943,23 +1959,35 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts) int dimension, pointer, allocatable, target; symbol_attribute attr; gfc_ref *ref; + gfc_symbol *sym; + gfc_component *comp; if (expr->expr_type != EXPR_VARIABLE && expr->expr_type != EXPR_FUNCTION) gfc_internal_error ("gfc_variable_attr(): Expression isn't a variable"); ref = expr->ref; - attr = expr->symtree->n.sym->attr; + sym = expr->symtree->n.sym; + attr = sym->attr; - dimension = attr.dimension; - pointer = attr.pointer; - allocatable = attr.allocatable; + if (sym->ts.type == BT_CLASS) + { + dimension = sym->ts.u.derived->components->attr.dimension; + pointer = sym->ts.u.derived->components->attr.pointer; + allocatable = sym->ts.u.derived->components->attr.allocatable; + } + else + { + dimension = attr.dimension; + pointer = attr.pointer; + allocatable = attr.allocatable; + } target = attr.target; if (pointer || attr.proc_pointer) target = 1; if (ts != NULL && expr->ts.type == BT_UNKNOWN) - *ts = expr->symtree->n.sym->ts; + *ts = sym->ts; for (; ref; ref = ref->next) switch (ref->type) @@ -1988,10 +2016,11 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts) break; case REF_COMPONENT: - attr = ref->u.c.component->attr; + comp = ref->u.c.component; + attr = comp->attr; if (ts != NULL) { - *ts = ref->u.c.component->ts; + *ts = comp->ts; /* Don't set the string length if a substring reference follows. */ if (ts->type == BT_CHARACTER @@ -1999,8 +2028,16 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts) ts->u.cl = NULL; } - pointer = ref->u.c.component->attr.pointer; - allocatable = ref->u.c.component->attr.allocatable; + if (comp->ts.type == BT_CLASS) + { + pointer = comp->ts.u.derived->components->attr.pointer; + allocatable = comp->ts.u.derived->components->attr.allocatable; + } + else + { + pointer = comp->attr.pointer; + allocatable = comp->attr.allocatable; + } if (pointer || attr.proc_pointer) target = 1; @@ -2037,7 +2074,16 @@ gfc_expr_attr (gfc_expr *e) gfc_clear_attr (&attr); if (e->value.function.esym != NULL) - attr = e->value.function.esym->result->attr; + { + gfc_symbol *sym = e->value.function.esym->result; + attr = sym->attr; + if (sym->ts.type == BT_CLASS) + { + attr.dimension = sym->ts.u.derived->components->attr.dimension; + attr.pointer = sym->ts.u.derived->components->attr.pointer; + attr.allocatable = sym->ts.u.derived->components->attr.allocatable; + } + } else attr = gfc_variable_attr (e, NULL); -- cgit v1.2.1 From 208593734c14b141f1a6f1a6524605e01f7f0b22 Mon Sep 17 00:00:00 2001 From: janus Date: Thu, 26 Nov 2009 19:01:02 +0000 Subject: 2009-11-26 Janus Weil PR fortran/42048 PR fortran/42167 * gfortran.h (gfc_is_function_return_value): New prototype. * match.c (gfc_match_call): Use new function 'gfc_is_function_return_value'. * primary.c (gfc_is_function_return_value): New function to check if a symbol is the return value of an encompassing function. (match_actual_arg,gfc_match_rvalue,match_variable): Use new function 'gfc_is_function_return_value'. * resolve.c (resolve_common_blocks,resolve_actual_arglist): Ditto. 2009-11-26 Janus Weil PR fortran/42048 PR fortran/42167 * gfortran.dg/select_type_10.f03: New test case. * gfortran.dg/typebound_call_11.f03: Extended test case. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@154679 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/primary.c | 32 ++++++++++++++++++++++---------- 1 file changed, 22 insertions(+), 10 deletions(-) (limited to 'gcc/fortran/primary.c') diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index c0777c48b85..113729fb059 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1347,6 +1347,25 @@ gfc_match_literal_constant (gfc_expr **result, int signflag) } +/* This checks if a symbol is the return value of an encompassing function. + Function nesting can be maximally two levels deep, but we may have + additional local namespaces like BLOCK etc. */ + +bool +gfc_is_function_return_value (gfc_symbol *sym, gfc_namespace *ns) +{ + if (!sym->attr.function || (sym->result != sym)) + return false; + while (ns) + { + if (ns->proc_name == sym) + return true; + ns = ns->parent; + } + return false; +} + + /* Match a single actual argument value. An actual argument is usually an expression, but can also be a procedure name. If the argument is a single name, it is not always possible to tell @@ -1415,9 +1434,7 @@ match_actual_arg (gfc_expr **result) is being defined, then we have a variable. */ if (sym->attr.function && sym->result == sym) { - if (gfc_current_ns->proc_name == sym - || (gfc_current_ns->parent != NULL - && gfc_current_ns->parent->proc_name == sym)) + if (gfc_is_function_return_value (sym, gfc_current_ns)) break; if (sym->attr.entry @@ -2521,9 +2538,7 @@ gfc_match_rvalue (gfc_expr **result) return MATCH_ERROR; } - if (gfc_current_ns->proc_name == sym - || (gfc_current_ns->parent != NULL - && gfc_current_ns->parent->proc_name == sym)) + if (gfc_is_function_return_value (sym, gfc_current_ns)) goto variable; if (sym->attr.entry @@ -2998,10 +3013,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag) if (sym->attr.function && !sym->attr.external && sym->result == sym - && ((sym == gfc_current_ns->proc_name - && sym == gfc_current_ns->proc_name->result) - || (gfc_current_ns->parent - && sym == gfc_current_ns->parent->proc_name->result) + && (gfc_is_function_return_value (sym, gfc_current_ns) || (sym->attr.entry && sym->ns == gfc_current_ns) || (sym->attr.entry -- cgit v1.2.1 From e97ac7c06c53487872b7d9d11148725317ef5588 Mon Sep 17 00:00:00 2001 From: burnus Date: Fri, 9 Apr 2010 05:54:29 +0000 Subject: 2010-04-09 Tobias Burnus PR fortran/18918 * decl.c (variable_decl, match_attr_spec): Fix setting the array spec. * array.c (match_subscript,gfc_match_array_ref): Add coarray * support. * data.c (gfc_assign_data_value): Ditto. * expr.c (gfc_check_pointer_assign): Add check for coarray * constraint. (gfc_traverse_expr): Traverse also through codimension expressions. (gfc_is_coindexed, gfc_has_ultimate_allocatable, gfc_has_ultimate_pointer): New functions. * gfortran.h (gfc_array_ref_dimen_type): Add DIMEN_STAR for * coarrays. (gfc_array_ref): Add codimen. (gfc_array_ref): Add in_allocate. (gfc_is_coindexed, gfc_has_ultimate_allocatable, gfc_has_ultimate_pointer): Add prototypes. * interface.c (compare_parameter, compare_actual_formal, check_intents): Add coarray constraints. * match.c (gfc_match_iterator): Add coarray constraint. * match.h (gfc_match_array_ref): Update interface. * primary.c (gfc_match_varspec): Handle codimensions. * resolve.c (coarray_alloc, inquiry_argument): New static * variables. (check_class_members): Return gfc_try instead for error recovery. (resolve_typebound_function,resolve_typebound_subroutine, check_members): Handle return value of check_class_members. (resolve_structure_cons, resolve_actual_arglist, resolve_function, check_dimension, compare_spec_to_ref, resolve_array_ref, resolve_ref, resolve_variable, gfc_resolve_expr, conformable_arrays, resolve_allocate_expr, resolve_ordinary_assign): Add coarray support. * trans-array.c (gfc_conv_array_ref, gfc_walk_variable_expr): Skip over coarray refs. (gfc_array_allocate) Add support for references containing coindexes. * trans-expr.c (gfc_add_interface_mapping): Copy coarray * attribute. (gfc_map_intrinsic_function): Ignore codimensions. 2010-04-09 Tobias Burnus PR fortran/18918 * gfortran.dg/coarray_7.f90: New test. * gfortran.dg/coarray_8.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158149 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/primary.c | 48 +++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 43 insertions(+), 5 deletions(-) (limited to 'gcc/fortran/primary.c') diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 113729fb059..34b687471bf 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1746,7 +1746,25 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, tail = NULL; gfc_gobble_whitespace (); + + if (gfc_peek_ascii_char () == '[') + { + if (sym->attr.dimension) + { + gfc_error ("Array section designator, e.g. '(:)', is required " + "besides the coarray designator '[...]' at %C"); + return MATCH_ERROR; + } + if (!sym->attr.codimension) + { + gfc_error ("Coarray designator at %C but '%s' is not a coarray", + sym->name); + return MATCH_ERROR; + } + } + if ((equiv_flag && gfc_peek_ascii_char () == '(') + || gfc_peek_ascii_char () == '[' || sym->attr.codimension || (sym->attr.dimension && !sym->attr.proc_pointer && !gfc_is_proc_ptr_comp (primary, NULL) && !(gfc_matching_procptr_assignment @@ -1761,7 +1779,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, tail->type = REF_ARRAY; m = gfc_match_array_ref (&tail->u.ar, equiv_flag ? NULL : sym->as, - equiv_flag); + equiv_flag, sym->as ? sym->as->corank : 0); if (m != MATCH_YES) return m; @@ -1771,7 +1789,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, tail = extend_ref (primary, tail); tail->type = REF_ARRAY; - m = gfc_match_array_ref (&tail->u.ar, NULL, equiv_flag); + m = gfc_match_array_ref (&tail->u.ar, NULL, equiv_flag, 0); if (m != MATCH_YES) return m; } @@ -1881,7 +1899,8 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, tail = extend_ref (primary, tail); tail->type = REF_ARRAY; - m = gfc_match_array_ref (&tail->u.ar, component->as, equiv_flag); + m = gfc_match_array_ref (&tail->u.ar, component->as, equiv_flag, + component->as->corank); if (m != MATCH_YES) return m; } @@ -1894,7 +1913,8 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, m = gfc_match_array_ref (&tail->u.ar, component->ts.u.derived->components->as, - equiv_flag); + equiv_flag, + component->ts.u.derived->components->as->corank); if (m != MATCH_YES) return m; } @@ -1949,6 +1969,13 @@ check_substring: } } + /* F2008, C727. */ + if (primary->expr_type == EXPR_PPC && gfc_is_coindexed (primary)) + { + gfc_error ("Coindexed procedure-pointer component at %C"); + return MATCH_ERROR; + } + return MATCH_YES; } @@ -2023,7 +2050,9 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts) break; case AR_ELEMENT: - allocatable = pointer = 0; + /* Handle coarrays. */ + if (ref->u.ar.dimen > 0) + allocatable = pointer = 0; break; case AR_UNKNOWN: @@ -2349,6 +2378,15 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result, if (m == MATCH_ERROR) goto cleanup; + /* F2008, R457/C725, for PURE C1283. */ + if (this_comp->attr.pointer && gfc_is_coindexed (comp_tail->val)) + { + gfc_error ("Coindexed expression to pointer component '%s' in " + "structure constructor at %C!", comp_tail->name); + goto cleanup; + } + + /* If not explicitly a parent constructor, gather up the components and build one. */ if (comp && comp == sym->components -- cgit v1.2.1 From 126387b5b6b5a55db23d87e27562c91cc235c906 Mon Sep 17 00:00:00 2001 From: jvdelisle Date: Tue, 13 Apr 2010 01:59:35 +0000 Subject: 2010-04-12 Jerry DeLisle * array.c (extract_element): Restore function from trunk. (gfc_get_array_element): Restore function from trunk. (gfc_expand_constructor): Restore check against flag_max_array_constructor. * constructor.c (node_copy_and_append): Delete unused. * gfortran.h: Delete comment and extra include. * constructor.h: Bump copyright and clean up TODO comments. * resolve.c: Whitespace. 2010-04-12 Daniel Franke * simplify.c (compute_dot_product): Replaced usage of ADVANCE macro with direct access access to elements. Adjusted prototype, fixed all callers. (gfc_simplify_dot_product): Removed duplicate check for zero-sized array. (gfc_simplify_matmul): Removed usage of ADVANCE macro. (gfc_simplify_spread): Removed workaround, directly insert elements at a given array position. (gfc_simplify_transpose): Likewise. (gfc_simplify_pack): Replaced usage of ADVANCE macro with corresponding function calls. (gfc_simplify_unpack): Likewise. 2010-04-12 Daniel Franke * simplify.c (only_convert_cmplx_boz): Renamed to ... (convert_boz): ... this and moved to start of file. (gfc_simplify_abs): Whitespace fix. (gfc_simplify_acos): Whitespace fix. (gfc_simplify_acosh): Whitespace fix. (gfc_simplify_aint): Whitespace fix. (gfc_simplify_dint): Whitespace fix. (gfc_simplify_anint): Whitespace fix. (gfc_simplify_and): Replaced if-gate by more common switch-over-type. (gfc_simplify_dnint): Whitespace fix. (gfc_simplify_asin): Whitespace fix. (gfc_simplify_asinh): Moved creation of result-expr out of switch. (gfc_simplify_atan): Likewise. (gfc_simplify_atanh): Whitespace fix. (gfc_simplify_atan2): Whitespace fix. (gfc_simplify_bessel_j0): Removed ATTRIBUTE_UNUSED. (gfc_simplify_bessel_j1): Likewise. (gfc_simplify_bessel_jn): Likewise. (gfc_simplify_bessel_y0): Likewise. (gfc_simplify_bessel_y1): Likewise. (gfc_simplify_bessel_yn): Likewise. (gfc_simplify_ceiling): Reorderd statements. (simplify_cmplx): Use convert_boz(), check for constant arguments. Whitespace fix. (gfc_simplify_cmplx): Use correct default kind. Removed check for constant arguments. (gfc_simplify_complex): Replaced if-gate. Removed check for constant arguments. (gfc_simplify_conjg): Whitespace fix. (gfc_simplify_cos): Whitespace fix. (gfc_simplify_cosh): Replaced if-gate by more common switch-over-type. (gfc_simplify_dcmplx): Removed check for constant arguments. (gfc_simplify_dble): Use convert_boz() and gfc_convert_constant(). (gfc_simplify_digits): Whitespace fix. (gfc_simplify_dim): Whitespace fix. (gfc_simplify_dprod): Reordered statements. (gfc_simplify_erf): Whitespace fix. (gfc_simplify_erfc): Whitespace fix. (gfc_simplify_epsilon): Whitespace fix. (gfc_simplify_exp): Whitespace fix. (gfc_simplify_exponent): Use convert_boz(). (gfc_simplify_floor): Reorderd statements. (gfc_simplify_gamma): Whitespace fix. (gfc_simplify_huge): Whitespace fix. (gfc_simplify_iand): Whitespace fix. (gfc_simplify_ieor): Whitespace fix. (simplify_intconv): Use gfc_convert_constant(). (gfc_simplify_int): Use simplify_intconv(). (gfc_simplify_int2): Reorderd statements. (gfc_simplify_idint): Reorderd statements. (gfc_simplify_ior): Whitespace fix. (gfc_simplify_ishftc): Removed duplicate type check. (gfc_simplify_len): Use range_check() instead of manual range check. (gfc_simplify_lgamma): Removed ATTRIBUTE_UNUSED. Whitespace fix. (gfc_simplify_log): Whitespace fix. (gfc_simplify_log10): Whitespace fix. (gfc_simplify_minval): Whitespace fix. (gfc_simplify_maxval): Whitespace fix. (gfc_simplify_mod): Whitespace fix. (gfc_simplify_modulo): Whitespace fix. (simplify_nint): Reorderd statements. (gfc_simplify_not): Whitespace fix. (gfc_simplify_or): Replaced if-gate by more common switch-over-type. (gfc_simplify_radix): Removed unused result-variable. Whitespace fix. (gfc_simplify_range): Removed unused result-variable. Whitespace fix. (gfc_simplify_real): Use convert_boz() and gfc_convert_constant(). (gfc_simplify_realpart): Whitespace fix. (gfc_simplify_selected_char_kind): Removed unused result-variable. (gfc_simplify_selected_int_kind): Removed unused result-variable. (gfc_simplify_selected_real_kind): Removed unused result-variable. (gfc_simplify_sign): Whitespace fix. (gfc_simplify_sin): Whitespace fix. (gfc_simplify_sinh): Replaced if-gate by more common switch-over-type. (gfc_simplify_sqrt): Avoided goto by inlining check. Whitespace fix. (gfc_simplify_tan): Replaced if-gate by more common switch-over-type. (gfc_simplify_tanh): Replaced if-gate by more common switch-over-type. (gfc_simplify_xor): Replaced if-gate by more common switch-over-type. 2010-04-12 Daniel Franke * gfortran.h (gfc_start_constructor): Removed. (gfc_get_array_element): Removed. * array.c (gfc_start_constructor): Removed, use gfc_get_array_expr instead. Fixed all callers. (extract_element): Removed. (gfc_expand_constructor): Temporarily removed check for max-array-constructor. Will be re-introduced later if still required. (gfc_get_array_element): Removed, use gfc_constructor_lookup_expr instead. Fixed all callers. * expr.c (find_array_section): Replaced manual lookup of elements by gfc_constructor_lookup. 2010-04-12 Daniel Franke * gfortran.h (gfc_get_null_expr): New prototype. (gfc_get_operator_expr): New prototype. (gfc_get_character_expr): New prototype. (gfc_get_iokind_expr): New prototype. * expr.c (gfc_get_null_expr): New. (gfc_get_character_expr): New. (gfc_get_iokind_expr): New. (gfc_get_operator_expr): Moved here from matchexp.c (build_node). * matchexp.c (build_node): Renamed and moved to expr.c (gfc_get_operator_expr). Reordered arguments to match other functions. Fixed all callers. (gfc_get_parentheses): Use specific function to build expr. * array.c (gfc_match_array_constructor): Likewise. * arith.c (eval_intrinsic): Likewise. (gfc_hollerith2int): Likewise. (gfc_hollerith2real): Likewise. (gfc_hollerith2complex): Likewise. (gfc_hollerith2logical): Likewise. * data.c (create_character_intializer): Likewise. * decl.c (gfc_match_null): Likewise. (enum_initializer): Likewise. * io.c (gfc_match_format): Likewise. (match_io): Likewise. * match.c (gfc_match_nullify): Likewise. * primary.c (match_string_constant): Likewise. (match_logical_constant): Likewise. (build_actual_constructor): Likewise. * resolve.c (build_default_init_expr): Likewise. * symbol.c (generate_isocbinding_symbol): Likewise. (gfc_build_class_symbol): Likewise. (gfc_find_derived_vtab): Likewise. * simplify.c (simplify_achar_char): Likewise. (gfc_simplify_adjustl): Likewise. (gfc_simplify_adjustr): Likewise. (gfc_simplify_and): Likewise. (gfc_simplify_bit_size): Likewise. (gfc_simplify_is_iostat_end): Likewise. (gfc_simplify_is_iostat_eor): Likewise. (gfc_simplify_isnan): Likewise. (simplify_bound): Likewise. (gfc_simplify_leadz): Likewise. (gfc_simplify_len_trim): Likewise. (gfc_simplify_logical): Likewise. (gfc_simplify_maxexponent): Likewise. (gfc_simplify_minexponent): Likewise. (gfc_simplify_new_line): Likewise. (gfc_simplify_null): Likewise. (gfc_simplify_or): Likewise. (gfc_simplify_precision): Likewise. (gfc_simplify_repeat): Likewise. (gfc_simplify_scan): Likewise. (gfc_simplify_size): Likewise. (gfc_simplify_trailz): Likewise. (gfc_simplify_trim): Likewise. (gfc_simplify_verify): Likewise. (gfc_simplify_xor): Likewise. * trans-io.c (build_dt): Likewise. (gfc_new_nml_name_expr): Removed. 2010-04-12 Daniel Franke * arith.h (gfc_constant_result): Removed prototype. * constructor.h (gfc_build_array_expr): Removed prototype. (gfc_build_structure_constructor_expr): Removed prototype. * gfortran.h (gfc_int_expr): Removed prototype. (gfc_logical_expr): Removed prototype. (gfc_get_array_expr): New prototype. (gfc_get_structure_constructor_expr): New prototype. (gfc_get_constant_expr): New prototype. (gfc_get_int_expr): New prototype. (gfc_get_logical_expr): New prototype. * arith.c (gfc_constant_result): Moved and renamed to expr.c (gfc_get_constant_expr). Fixed all callers. * constructor.c (gfc_build_array_expr): Moved and renamed to expr.c (gfc_get_array_expr). Split gfc_typespec argument to type and kind. Fixed all callers. (gfc_build_structure_constructor_expr): Moved and renamed to expr.c (gfc_get_structure_constructor_expr). Split gfc_typespec argument to type and kind. Fixed all callers. * expr.c (gfc_logical_expr): Renamed to ... (gfc_get_logical_expr): ... this. Added kind argument. Fixed all callers. (gfc_int_expr): Renamed to ... (gfc_get_int_expr): ... this. Added kind and where arguments. Fixed all callers. (gfc_get_constant_expr): New. (gfc_get_array_expr): New. (gfc_get_structure_constructor_expr): New. * simplify.c (int_expr_with_kind): Removed, callers use gfc_get_int_expr instead. 2010-04-12 Daniel Franke * constructor.h: New. * constructor.c: New. * Make-lang.in: Add new files to F95_PARSER_OBJS. * arith.c (reducy_unary): Use constructor API. (reduce_binary_ac): Likewise. (reduce_binary_ca): Likewise. (reduce_binary_aa): Likewise. * check.c (gfc_check_pack): Likewise. (gfc_check_reshape): Likewise. (gfc_check_unpack): Likewise. * decl.c (add_init_expr_to_sym): Likewise. (build_struct): Likewise. * dependency.c (gfc_check_dependency): Likewise. (contains_forall_index_p): Likewise. * dump-parse-tree.c (show_constructor): Likewise. * expr.c (free_expr0): Likewise. (gfc_copy_expr): Likewise. (gfc_is_constant_expr): Likewise. (simplify_constructor): Likewise. (find_array_element): Likewise. (find_component_ref): Likewise. (find_array_section): Likewise. (find_substring_ref): Likewise. (simplify_const_ref): Likewise. (scalarize_intrinsic_call): Likewise. (check_alloc_comp_init): Likewise. (gfc_default_initializer): Likewise. (gfc_traverse_expr): Likewise. * iresolve.c (check_charlen_present): Likewise. (gfc_resolve_reshape): Likewise. (gfc_resolve_transfer): Likewise. * module.c (mio_constructor): Likewise. * primary.c (build_actual_constructor): Likewise. (gfc_match_structure_constructor): Likewise. * resolve.c (resolve_structure_cons): Likewise. * simplify.c (is_constant_array_expr): Likewise. (init_result_expr): Likewise. (transformational_result): Likewise. (simplify_transformation_to_scalar): Likewise. (simplify_transformation_to_array): Likewise. (gfc_simplify_dot_product): Likewise. (simplify_bound): Likewise. (simplify_matmul): Likewise. (simplify_minval_maxval): Likewise. (gfc_simplify_pack): Likewise. (gfc_simplify_reshape): Likewise. (gfc_simplify_shape): Likewise. (gfc_simplify_spread): Likewise. (gfc_simplify_transpose): Likewise. (gfc_simplify_unpack): Likewise.q (gfc_convert_constant): Likewise. (gfc_convert_char_constant): Likewise. * target-memory.c (size_array): Likewise. (encode_array): Likewise. (encode_derived): Likewise. (interpret_array): Likewise. (gfc_interpret_derived): Likewise. (expr_to_char): Likewise. (gfc_merge_initializers): Likewise. * trans-array.c (gfc_get_array_constructor_size): Likewise. (gfc_trans_array_constructor_value): Likewise. (get_array_ctor_strlen): Likewise. (gfc_constant_array_constructor_p): Likewise. (gfc_build_constant_array_constructor): Likewise. (gfc_trans_array_constructor): Likewise. (gfc_conv_array_initializer): Likewise. * trans-decl.c (check_constant_initializer): Likewise. * trans-expr.c (flatten_array_ctors_without_strlen): Likewise. (gfc_apply_interface_mapping_to_cons): Likewise. (gfc_trans_structure_assign): Likewise. (gfc_conv_structure): Likewise. * array.c (check_duplicate_iterator): Likewise. (match_array_list): Likewise. (match_array_cons_element): Likewise. (gfc_match_array_constructor): Likewise. (check_constructor_type): Likewise. (check_constructor): Likewise. (expand): Likewise. (expand_constructor): Likewise. (extract_element): Likewise. (gfc_expanded_ac): Likewise. (resolve_array_list): Likewise. (gfc_resolve_character_array_constructor): Likewise. (copy_iterator): Renamed to ... (gfc_copy_iterator): ... this. (gfc_append_constructor): Removed. (gfc_insert_constructor): Removed unused function. (gfc_get_constructor): Removed. (gfc_free_constructor): Removed. (qgfc_copy_constructor): Removed. * gfortran.h (struct gfc_expr): Removed member 'con_by_offset'. Removed all references. Replaced constructor list by splay-tree. (struct gfc_constructor): Removed member 'next', moved 'offset' from the inner struct, added member 'base'. (gfc_append_constructor): Removed prototype. (gfc_insert_constructor): Removed prototype. (gfc_get_constructor): Removed prototype. (gfc_free_constructor): Removed prototype. (qgfc_copy_constructor): Removed prototype. (gfc_copy_iterator): New prototype. * trans-array.h (gfc_constant_array_constructor_p): Adjusted prototype. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158253 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/primary.c | 66 ++++++++++++++------------------------------------- 1 file changed, 18 insertions(+), 48 deletions(-) (limited to 'gcc/fortran/primary.c') diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 34b687471bf..c8ca3d4cf8a 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1,5 +1,5 @@ /* Primary expression subroutines - Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008 + Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. Contributed by Andy Vaught @@ -27,6 +27,7 @@ along with GCC; see the file COPYING3. If not see #include "match.h" #include "parse.h" #include "toplev.h" +#include "constructor.h" /* Matches a kind-parameter expression, which is either a named symbolic constant or a nonnegative integer constant. If @@ -276,8 +277,8 @@ match_hollerith_constant (gfc_expr **result) else { gfc_free_expr (e); - e = gfc_constant_result (BT_HOLLERITH, gfc_default_character_kind, - &gfc_current_locus); + e = gfc_get_constant_expr (BT_HOLLERITH, gfc_default_character_kind, + &gfc_current_locus); e->representation.string = XCNEWVEC (char, num + 1); @@ -711,7 +712,7 @@ match_substring (gfc_charlen *cl, int init, gfc_ref **result) ref->type = REF_SUBSTRING; if (start == NULL) - start = gfc_int_expr (1); + start = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1); ref->u.ss.start = start; if (end == NULL && cl) end = gfc_copy_expr (cl->length); @@ -969,19 +970,10 @@ got_delim: if (peek == 'b' || peek == 'o' || peek =='z' || peek == 'x') goto no_match; - - e = gfc_get_expr (); - - e->expr_type = EXPR_CONSTANT; + e = gfc_get_character_expr (kind, &start_locus, NULL, length); e->ref = NULL; - e->ts.type = BT_CHARACTER; - e->ts.kind = kind; e->ts.is_c_interop = 0; e->ts.is_iso_c = 0; - e->where = start_locus; - - e->value.character.string = p = gfc_get_wide_string (length + 1); - e->value.character.length = length; gfc_current_locus = start_locus; gfc_next_char (); /* Skip delimiter */ @@ -991,6 +983,7 @@ got_delim: warn_ampersand = gfc_option.warn_ampersand; gfc_option.warn_ampersand = 0; + p = e->value.character.string; for (i = 0; i < length; i++) { c = next_string_char (delimiter, &ret); @@ -1084,15 +1077,9 @@ match_logical_constant (gfc_expr **result) return MATCH_ERROR; } - e = gfc_get_expr (); - - e->expr_type = EXPR_CONSTANT; - e->value.logical = i; - e->ts.type = BT_LOGICAL; - e->ts.kind = kind; + e = gfc_get_logical_expr (kind, &gfc_current_locus, i); e->ts.is_c_interop = 0; e->ts.is_iso_c = 0; - e->where = gfc_current_locus; *result = e; return MATCH_YES; @@ -2175,10 +2162,9 @@ gfc_free_structure_ctor_component (gfc_structure_ctor_component *comp) for components without explicit value given. */ static gfc_try build_actual_constructor (gfc_structure_ctor_component **comp_head, - gfc_constructor **ctor_head, gfc_symbol *sym) + gfc_constructor_base *ctor_head, gfc_symbol *sym) { gfc_structure_ctor_component *comp_iter; - gfc_constructor *ctor_tail = NULL; gfc_component *comp; for (comp = sym->components; comp; comp = comp->next) @@ -2199,11 +2185,10 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head, a value expression for the parent derived type and calling self. */ if (!comp_iter && comp == sym->components && sym->attr.extension) { - value = gfc_get_expr (); - value->expr_type = EXPR_STRUCTURE; - value->value.constructor = NULL; + value = gfc_get_structure_constructor_expr (comp->ts.type, + comp->ts.kind, + &gfc_current_locus); value->ts = comp->ts; - value->where = gfc_current_locus; if (build_actual_constructor (comp_head, &value->value.constructor, comp->ts.u.derived) == FAILURE) @@ -2211,8 +2196,8 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head, gfc_free_expr (value); return FAILURE; } - *ctor_head = ctor_tail = gfc_get_constructor (); - ctor_tail->expr = value; + + gfc_constructor_append_expr (ctor_head, value, NULL); continue; } @@ -2239,15 +2224,7 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head, value = comp_iter->val; /* Add the value to the constructor chain built. */ - if (ctor_tail) - { - ctor_tail->next = gfc_get_constructor (); - ctor_tail = ctor_tail->next; - } - else - *ctor_head = ctor_tail = gfc_get_constructor (); - gcc_assert (value); - ctor_tail->expr = value; + gfc_constructor_append_expr (ctor_head, value, NULL); /* Remove the entry from the component list. We don't want the expression value to be free'd, so set it to NULL. */ @@ -2266,7 +2243,7 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result, bool parent) { gfc_structure_ctor_component *comp_tail, *comp_head, *comp_iter; - gfc_constructor *ctor_head, *ctor_tail; + gfc_constructor_base ctor_head = NULL; gfc_component *comp; /* Is set NULL when named component is first seen */ gfc_expr *e; locus where; @@ -2274,7 +2251,6 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result, const char* last_name = NULL; comp_tail = comp_head = NULL; - ctor_head = ctor_tail = NULL; if (!parent && gfc_match_char ('(') != MATCH_YES) goto syntax; @@ -2439,14 +2415,8 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result, else gcc_assert (!comp_head); - e = gfc_get_expr (); - - e->expr_type = EXPR_STRUCTURE; - - e->ts.type = BT_DERIVED; + e = gfc_get_structure_constructor_expr (BT_DERIVED, 0, &where); e->ts.u.derived = sym; - e->where = where; - e->value.constructor = ctor_head; *result = e; @@ -2462,7 +2432,7 @@ cleanup: gfc_free_structure_ctor_component (comp_iter); comp_iter = next; } - gfc_free_constructor (ctor_head); + gfc_constructor_free (ctor_head); return MATCH_ERROR; } -- cgit v1.2.1 From 4a67dea4cad9a5713bf221208faa30eaf97e614d Mon Sep 17 00:00:00 2001 From: dfranke Date: Wed, 19 May 2010 12:55:26 +0000 Subject: gcc/fortran/: 2010-05-19 Daniel Franke PR fortran/38404 * primary.c (match_string_constant): Move start_locus just inside the string. * data.c (create_character_intializer): Clarified truncation warning. gcc/testsuite/: 2010-05-19 Daniel Franke PR fortran/38404 * gfortran.dg/data_char_1.f90: Updated warning message. * gfortran.dg/data_array_6.f: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159561 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/primary.c | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) (limited to 'gcc/fortran/primary.c') diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index c8ca3d4cf8a..09f4eb1c6d4 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -868,12 +868,11 @@ match_string_constant (gfc_expr **result) gfc_gobble_whitespace (); - start_locus = gfc_current_locus; - c = gfc_next_char (); if (c == '\'' || c == '"') { kind = gfc_default_character_kind; + start_locus = gfc_current_locus; goto got_delim; } @@ -917,12 +916,13 @@ match_string_constant (gfc_expr **result) goto no_match; gfc_gobble_whitespace (); - start_locus = gfc_current_locus; c = gfc_next_char (); if (c != '\'' && c != '"') goto no_match; + start_locus = gfc_current_locus; + if (kind == -1) { q = gfc_extract_int (sym->value, &kind); @@ -976,7 +976,6 @@ got_delim: e->ts.is_iso_c = 0; gfc_current_locus = start_locus; - gfc_next_char (); /* Skip delimiter */ /* We disable the warning for the following loop as the warning has already been printed in the loop above. */ -- cgit v1.2.1 From dca58d219480ce3c10fbc7442128ece6cc724d8f Mon Sep 17 00:00:00 2001 From: burnus Date: Sun, 23 May 2010 17:18:24 +0000 Subject: 2010-05-21 Tobias Burnus * gfortran.h: Do not include system.h. * bbt.c: Include system.h. * data.c: Ditto. * dependency.c: Ditto. * dump-parse-tree.c: Ditto. * arith.h: Do not include gfortran.h. * constructor.h: Do not include gfortran.h and splay-tree.h. * match.h: Do not include gfortran.h. * parse.h: Ditto. * target-memory.h: Ditto. * openmp.c: Do not include toplev.h and target.h. * trans-stmt.c: Ditto not include toplev.h. * primary.c: Ditto. * trans-common.c: Tell why toplev.h is needed. And do not include target.h. * trans-expr.c: Tell why toplev.h is needed. * trans-array.c: Ditto. * trans-openmp.c: Ditto. * trans-const.c: Ditto. * trans.c: Ditto. * trans-types.c: Ditto. * trans-io.c: Ditto. * trans-decl.c: Ditto. * scanner.c: Ditto. * convert.c: Ditto. * trans-intrinsic.c: Ditto. * options.c: Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159763 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/primary.c | 1 - 1 file changed, 1 deletion(-) (limited to 'gcc/fortran/primary.c') diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 09f4eb1c6d4..53da762e2ef 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -26,7 +26,6 @@ along with GCC; see the file COPYING3. If not see #include "arith.h" #include "match.h" #include "parse.h" -#include "toplev.h" #include "constructor.h" /* Matches a kind-parameter expression, which is either a named -- 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/primary.c | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) (limited to 'gcc/fortran/primary.c') diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 53da762e2ef..68b6a437360 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1754,8 +1754,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, && !gfc_is_proc_ptr_comp (primary, NULL) && !(gfc_matching_procptr_assignment && sym->attr.flavor == FL_PROCEDURE)) - || (sym->ts.type == BT_CLASS - && sym->ts.u.derived->components->attr.dimension)) + || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.dimension)) { /* In EQUIVALENCE, we don't know yet whether we are seeing an array, character variable or array of character @@ -1890,16 +1889,15 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, return m; } else if (component->ts.type == BT_CLASS - && component->ts.u.derived->components->as != NULL + && CLASS_DATA (component)->as != NULL && !component->attr.proc_pointer) { tail = extend_ref (primary, tail); tail->type = REF_ARRAY; - m = gfc_match_array_ref (&tail->u.ar, - component->ts.u.derived->components->as, + m = gfc_match_array_ref (&tail->u.ar, CLASS_DATA (component)->as, equiv_flag, - component->ts.u.derived->components->as->corank); + CLASS_DATA (component)->as->corank); if (m != MATCH_YES) return m; } @@ -2000,9 +1998,9 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts) if (sym->ts.type == BT_CLASS) { - dimension = sym->ts.u.derived->components->attr.dimension; - pointer = sym->ts.u.derived->components->attr.pointer; - allocatable = sym->ts.u.derived->components->attr.allocatable; + dimension = CLASS_DATA (sym)->attr.dimension; + pointer = CLASS_DATA (sym)->attr.pointer; + allocatable = CLASS_DATA (sym)->attr.allocatable; } else { @@ -2061,8 +2059,8 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts) if (comp->ts.type == BT_CLASS) { - pointer = comp->ts.u.derived->components->attr.pointer; - allocatable = comp->ts.u.derived->components->attr.allocatable; + pointer = CLASS_DATA (comp)->attr.pointer; + allocatable = CLASS_DATA (comp)->attr.allocatable; } else { @@ -2110,9 +2108,9 @@ gfc_expr_attr (gfc_expr *e) attr = sym->attr; if (sym->ts.type == BT_CLASS) { - attr.dimension = sym->ts.u.derived->components->attr.dimension; - attr.pointer = sym->ts.u.derived->components->attr.pointer; - attr.allocatable = sym->ts.u.derived->components->attr.allocatable; + attr.dimension = CLASS_DATA (sym)->attr.dimension; + attr.pointer = CLASS_DATA (sym)->attr.pointer; + attr.allocatable = CLASS_DATA (sym)->attr.allocatable; } } else -- 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/primary.c | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'gcc/fortran/primary.c') diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 68b6a437360..b6c08a9c406 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -2975,6 +2975,12 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag) gfc_error ("Assigning to PROTECTED variable at %C"); return MATCH_ERROR; } + if (sym->assoc && !sym->assoc->variable) + { + gfc_error ("'%s' associated to expression can't appear in a variable" + " definition context at %C", sym->name); + return MATCH_ERROR; + } break; case FL_UNKNOWN: -- 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/primary.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'gcc/fortran/primary.c') diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index b6c08a9c406..cb6fae20c41 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1999,7 +1999,7 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts) if (sym->ts.type == BT_CLASS) { dimension = CLASS_DATA (sym)->attr.dimension; - pointer = CLASS_DATA (sym)->attr.pointer; + pointer = CLASS_DATA (sym)->attr.class_pointer; allocatable = CLASS_DATA (sym)->attr.allocatable; } else @@ -2059,7 +2059,7 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts) if (comp->ts.type == BT_CLASS) { - pointer = CLASS_DATA (comp)->attr.pointer; + pointer = CLASS_DATA (comp)->attr.class_pointer; allocatable = CLASS_DATA (comp)->attr.allocatable; } else @@ -2109,7 +2109,7 @@ gfc_expr_attr (gfc_expr *e) if (sym->ts.type == BT_CLASS) { attr.dimension = CLASS_DATA (sym)->attr.dimension; - attr.pointer = CLASS_DATA (sym)->attr.pointer; + attr.pointer = CLASS_DATA (sym)->attr.class_pointer; attr.allocatable = CLASS_DATA (sym)->attr.allocatable; } } -- cgit v1.2.1