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/trans-decl.c | 38 +++++++++++++++++++++++++++++++++++++- 1 file changed, 37 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 091d3946852..d64c3fae3c9 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -980,6 +980,26 @@ gfc_add_assign_aux_vars (gfc_symbol * sym) GFC_DECL_ASSIGN_ADDR (decl) = addr; } + +static tree +add_attributes_to_decl (symbol_attribute sym_attr, tree list) +{ + unsigned id; + tree attr; + + for (id = 0; id < EXT_ATTR_NUM; id++) + if (sym_attr.ext_attr & (1 << id)) + { + attr = build_tree_list ( + get_identifier (ext_attr_list[id].middle_end_name), + NULL_TREE); + list = chainon (list, attr); + } + + return list; +} + + /* Return the decl for a gfc_symbol, create it if it doesn't already exist. */ @@ -988,6 +1008,7 @@ gfc_get_symbol_decl (gfc_symbol * sym) { tree decl; tree length = NULL_TREE; + tree attributes; int byref; gcc_assert (sym->attr.referenced @@ -1187,6 +1208,10 @@ gfc_get_symbol_decl (gfc_symbol * sym) && !sym->attr.proc_pointer) DECL_BY_REFERENCE (decl) = 1; + /* Add attributes to variables. Functions are handled elsewhere. */ + attributes = add_attributes_to_decl (sym->attr, NULL_TREE); + decl_attributes (&decl, attributes, 0); + return decl; } @@ -1223,6 +1248,7 @@ static tree get_proc_pointer_decl (gfc_symbol *sym) { tree decl; + tree attributes; decl = sym->backend_decl; if (decl) @@ -1266,6 +1292,9 @@ get_proc_pointer_decl (gfc_symbol *sym) TREE_TYPE (decl), sym->attr.dimension, sym->attr.proc_pointer); } + attributes = add_attributes_to_decl (sym->attr, NULL_TREE); + decl_attributes (&decl, attributes, 0); + return decl; } @@ -1277,6 +1306,7 @@ gfc_get_extern_function_decl (gfc_symbol * sym) { tree type; tree fndecl; + tree attributes; gfc_expr e; gfc_intrinsic_sym *isym; gfc_expr argexpr; @@ -1439,6 +1469,9 @@ gfc_get_extern_function_decl (gfc_symbol * sym) if (DECL_CONTEXT (fndecl) == NULL_TREE) pushdecl_top_level (fndecl); + attributes = add_attributes_to_decl (sym->attr, NULL_TREE); + decl_attributes (&fndecl, attributes, 0); + return fndecl; } @@ -1450,7 +1483,7 @@ gfc_get_extern_function_decl (gfc_symbol * sym) static void build_function_decl (gfc_symbol * sym) { - tree fndecl, type; + tree fndecl, type, attributes; symbol_attribute attr; tree result_decl; gfc_formal_arglist *f; @@ -1557,6 +1590,9 @@ build_function_decl (gfc_symbol * sym) TREE_SIDE_EFFECTS (fndecl) = 0; } + attributes = add_attributes_to_decl (attr, NULL_TREE); + decl_attributes (&fndecl, attributes, 0); + /* Layout the function declaration and put it in the binding level of the current function. */ pushdecl (fndecl); -- 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/trans-decl.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index d64c3fae3c9..0d6dc6de975 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1015,7 +1015,7 @@ gfc_get_symbol_decl (gfc_symbol * sym) || sym->attr.use_assoc || sym->ns->proc_name->attr.if_source == IFSRC_IFBODY); - if (sym->ns && sym->ns->proc_name->attr.function) + if (sym->ns && sym->ns->proc_name && sym->ns->proc_name->attr.function) byref = gfc_return_by_reference (sym->ns->proc_name); else byref = 0; -- cgit v1.2.1 From 389dd41bd043170e7dc7660304f14a5f16af3562 Mon Sep 17 00:00:00 2001 From: manu Date: Thu, 16 Jul 2009 22:29:52 +0000 Subject: =?UTF-8?q?2009-07-17=20=20Aldy=20Hernandez=20=20=20=09=20=20=20=20Manuel=20L=C3=B3pez-Ib=C3=A1=C3=B1ez=20=20?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit PR 40435 * tree-complex.c, tree-loop-distribution.c, tree.c, tree.h, builtins.c, fold-const.c, omp-low.c, cgraphunit.c, tree-ssa-ccp.c, tree-ssa-dom.c, gimple-low.c, expr.c, tree-ssa-ifcombine.c, c-decl.c, stor-layout.c, tree-if-conv.c, c-typeck.c, gimplify.c, calls.c, tree-sra.c, tree-mudflap.c, tree-ssa-copy.c, tree-ssa-forwprop.c, c-convert.c, c-omp.c, varasm.c, tree-inline.c, c-common.c, c-common.h, gimple.c, tree-switch-conversion.c, gimple.h, tree-cfg.c, c-parser.c, convert.c: Add location argument to fold_{unary,binary,ternary}, fold_build[123], build_call_expr, build_size_arg, build_fold_addr_expr, build_call_array, non_lvalue, size_diffop, fold_build1_initializer, fold_build2_initializer, fold_build3_initializer, fold_build_call_array, fold_build_call_array_initializer, fold_single_bit_test, omit_one_operand, omit_two_operands, invert_truthvalue, fold_truth_not_expr, build_fold_indirect_ref, fold_indirect_ref, combine_comparisons, fold_builtin_*, fold_call_expr, build_range_check, maybe_fold_offset_to_address, round_up, round_down. objc/ * objc-act.c: Add location argument to all calls to build_fold_addr_expr. testsuite/ * gcc.dg/pr36902.c: Add column info. * g++.dg/gcov/gcov-2.C: Change count for definition. cp/ * typeck.c, init.c, class.c, method.c, rtti.c, except.c, error.c, tree.c, cp-gimplify.c, cxx-pretty-print.c, pt.c, semantics.c, call.c, cvt.c, mangle.c: Add location argument to fold_{unary,binary,ternary}, fold_build[123], build_call_expr, build_size_arg, build_fold_addr_expr, build_call_array, non_lvalue, size_diffop, fold_build1_initializer, fold_build2_initializer, fold_build3_initializer, fold_build_call_array, fold_build_call_array_initializer, fold_single_bit_test, omit_one_operand, omit_two_operands, invert_truthvalue, fold_truth_not_expr, build_fold_indirect_ref, fold_indirect_ref, combine_comparisons, fold_builtin_*, fold_call_expr, build_range_check, maybe_fold_offset_to_address, round_up, round_down. fortran/ * trans-expr.c, trans-array.c, trans-openmp.c, trans-stmt.c, trans.c, trans-io.c, trans-decl.c, trans-intrinsic.c: Add location argument to fold_{unary,binary,ternary}, fold_build[123], build_call_expr, build_size_arg, build_fold_addr_expr, build_call_array, non_lvalue, size_diffop, fold_build1_initializer, fold_build2_initializer, fold_build3_initializer, fold_build_call_array, fold_build_call_array_initializer, fold_single_bit_test, omit_one_operand, omit_two_operands, invert_truthvalue, fold_truth_not_expr, build_fold_indirect_ref, fold_indirect_ref, combine_comparisons, fold_builtin_*, fold_call_expr, build_range_check, maybe_fold_offset_to_address, round_up, round_down. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149722 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 32 +++++++++++++++++++++----------- 1 file changed, 21 insertions(+), 11 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 0d6dc6de975..5ea24c54b45 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -408,7 +408,8 @@ gfc_finish_cray_pointee (tree decl, gfc_symbol *sym) /* Parameters need to be dereferenced. */ if (sym->cp_pointer->attr.dummy) - ptr_decl = build_fold_indirect_ref (ptr_decl); + ptr_decl = build_fold_indirect_ref_loc (input_location, + ptr_decl); /* Check to see if we're dealing with a variable-sized array. */ if (sym->attr.dimension @@ -422,7 +423,8 @@ gfc_finish_cray_pointee (tree decl, gfc_symbol *sym) { ptr_decl = convert (build_pointer_type (TREE_TYPE (decl)), ptr_decl); - value = build_fold_indirect_ref (ptr_decl); + value = build_fold_indirect_ref_loc (input_location, + ptr_decl); } SET_DECL_VALUE_EXPR (decl, value); @@ -1991,7 +1993,7 @@ build_entry_thunks (gfc_namespace * ns) args = nreverse (args); args = chainon (args, nreverse (string_args)); tmp = ns->proc_name->backend_decl; - tmp = build_function_call_expr (tmp, args); + tmp = build_function_call_expr (input_location, tmp, args); if (ns->proc_name->attr.mixed_entry_master) { tree union_decl, field; @@ -4012,7 +4014,8 @@ create_main_function (tree fndecl) /* Call _gfortran_set_args (argc, argv). */ TREE_USED (argc) = 1; TREE_USED (argv) = 1; - tmp = build_call_expr (gfor_fndecl_set_args, 2, argc, argv); + tmp = build_call_expr_loc (input_location, + gfor_fndecl_set_args, 2, argc, argv); gfc_add_expr_to_block (&body, tmp); /* Add a call to set_options to set up the runtime library Fortran @@ -4060,7 +4063,8 @@ create_main_function (tree fndecl) DECL_INITIAL (var) = array; var = gfc_build_addr_expr (build_pointer_type (integer_type_node), var); - tmp = build_call_expr (gfor_fndecl_set_options, 2, + tmp = build_call_expr_loc (input_location, + gfor_fndecl_set_options, 2, build_int_cst (integer_type_node, 8), var); gfc_add_expr_to_block (&body, tmp); } @@ -4069,7 +4073,8 @@ create_main_function (tree fndecl) the library will raise a FPE when needed. */ if (gfc_option.fpe != 0) { - tmp = build_call_expr (gfor_fndecl_set_fpe, 1, + tmp = build_call_expr_loc (input_location, + gfor_fndecl_set_fpe, 1, build_int_cst (integer_type_node, gfc_option.fpe)); gfc_add_expr_to_block (&body, tmp); @@ -4080,7 +4085,8 @@ create_main_function (tree fndecl) if (gfc_option.convert != GFC_CONVERT_NATIVE) { - tmp = build_call_expr (gfor_fndecl_set_convert, 1, + tmp = build_call_expr_loc (input_location, + gfor_fndecl_set_convert, 1, build_int_cst (integer_type_node, gfc_option.convert)); gfc_add_expr_to_block (&body, tmp); @@ -4091,7 +4097,8 @@ create_main_function (tree fndecl) if (gfc_option.record_marker != 0) { - tmp = build_call_expr (gfor_fndecl_set_record_marker, 1, + tmp = build_call_expr_loc (input_location, + gfor_fndecl_set_record_marker, 1, build_int_cst (integer_type_node, gfc_option.record_marker)); gfc_add_expr_to_block (&body, tmp); @@ -4099,14 +4106,16 @@ create_main_function (tree fndecl) if (gfc_option.max_subrecord_length != 0) { - tmp = build_call_expr (gfor_fndecl_set_max_subrecord_length, 1, + tmp = build_call_expr_loc (input_location, + gfor_fndecl_set_max_subrecord_length, 1, build_int_cst (integer_type_node, gfc_option.max_subrecord_length)); gfc_add_expr_to_block (&body, tmp); } /* Call MAIN__(). */ - tmp = build_call_expr (fndecl, 0); + tmp = build_call_expr_loc (input_location, + fndecl, 0); gfc_add_expr_to_block (&body, tmp); /* Mark MAIN__ as used. */ @@ -4461,7 +4470,8 @@ gfc_generate_constructors (void) for (; gfc_static_ctors; gfc_static_ctors = TREE_CHAIN (gfc_static_ctors)) { - tmp = build_call_expr (TREE_VALUE (gfc_static_ctors), 0); + tmp = build_call_expr_loc (input_location, + TREE_VALUE (gfc_static_ctors), 0); DECL_SAVED_TREE (fndecl) = build_stmt (input_location, EXPR_STMT, tmp); } -- cgit v1.2.1 From bfec3452cfb96a7546809ee1af3fffb9eba9d658 Mon Sep 17 00:00:00 2001 From: rguenth Date: Fri, 17 Jul 2009 15:49:34 +0000 Subject: 2009-07-17 Richard Guenther PR c/40401 * tree-pass.h (pass_diagnose_omp_blocks): Declare. (pass_warn_unused_result): Likewise. (TODO_set_props): Remove. * omp-low.c (diagnose_omp_structured_block_errors): Change to run as a pass. (pass_diagnose_omp_blocks): Define. * c-decl.c (pop_file_scope): Do not finalize the CU here. (c_gimple_diagnostics_recursively): Remove. (finish_function): Do not call it. (c_write_global_declarations): Continue after errors. Finalize the CU here. * c-gimplify.c (c_genericize): Do not gimplify here. * c-common.c (c_warn_unused_result): Move ... * tree-cfg.c (do_warn_unused_result): ... here. (run_warn_unused_result): New function. (gate_warn_unused_result): New function. (pass_warn_unused_result): New pass. * c-common.h (c_warn_unused_result): Remove. * flags.h (flag_warn_unused_result): Declare. * c-opts.c (c_common_init_options): Enable flag_warn_unused_result. * opts.c (flag_warn_unused_result): Initialize to false. * toplev.c (compile_file): Add comment. * omp-low.c (create_omp_child_function): Do not register the function with the frontend. (diagnose_omp_structured_block_errors): Prepare to be called as optimization pass. (gate_diagnose_omp_blocks): New function. (pass_diagnose_omp_blocks): New pass. * cgraph.h (cgraph_optimize): Remove. (cgraph_analyze_function): Likewise. * cgraph.c (cgraph_add_new_function): Gimplify C++ thunks. * cgraphunit.c (cgraph_lower_function): Lower nested functions before their parents here. (cgraph_finalize_function): Not here. (cgraph_analyze_function): Gimplify functions here. (cgraph_finalize_compilation_unit): Continue after errors. Optimize the callgraph from here. (cgraph_optimize): Make static. * langhooks.c (write_global_declarations): Finalize the CU. * gimplify.c (gimplify_asm_expr): Do not emit ASMs with errors. (gimplify_function_tree): Assert we gimplify only once. Set PROP_gimple_any property. * tree-nested.c (gimplify_all_functions): New function. (lower_nested_functions): Gimplify all nested functions. * gimple.h (diagnose_omp_structured_block_errors): Remove. * passes.c (init_optimization_passes): Add pass_warn_unused_result and pass_diagnose_omp_blocks after gimplification. Do not set TODO_set_props on all_lowering_passes. (execute_one_pass): Do not handle TODO_set_props. * Makefile.in (cgraphunit.o): Add $(TREE_DUMP_H) dependency. (gimplify.o): Add tree-pass.h dependency. * tree-inline.c (copy_statement_list): Properly copy STATEMENT_LIST. (copy_tree_body_r): Properly handle TARGET_EXPR like SAVE_EXPR. (unsave_r): Likewise. * c-omp.c (c_finish_omp_atomic): Set DECL_CONTEXT on the temporary variable. cp/ * decl.c (finish_function): Do not emit unused result warnings from here. * cp-objcp-common.h (LANG_HOOKS_POST_GIMPLIFY_PASS): Use c_warn_unused_result_pass. * semantics.c (expand_or_defer_fn): Adjust assertion about IL status. * optimize.c (clone_body): Clone in GENERIC. (maybe_clone_body): Do not clear DECL_SAVED_TREE. * decl2.c (cp_write_global_declarations): Fix body test. Do not call cgraph_optimize. * Make-lang.in (optimize.o): Add tree-iterator.h dependency. * method.c (use_thunk): Register thunk with cgraph_finalize_function. * error.c (function_category): Guard access of DECL_LANG_SPECIFIC. java/ * java-gimplify.c (java_genericize): Do not gimplify here. But replace all local references. (java_gimplify_expr): Do not replace local references here. (java_gimplify_modify_expr): Likewise. * jcf-parse.c (java_parse_file): Do not finalize the CU or optimize the cgraph here. * decl.c (java_replace_reference): Make static. (java_replace_references): New function. (end_java_method): Clear base_decl_map. * java-tree.h (java_replace_references): Declare. (java_replace_reference): Remove. ada/ * utils.c (end_subprog_body): Revert to pre-tuples state. Remove unused parameter. (gnat_gimplify_function): Do not gimplify here. Fold into its only caller and remove. (gnat_builtin_function): Adjust for end_subprog_body signature change. (gnat_write_global_declarations): Also finalize the CU. * misc.c (gnat_parse_file): Do not finalize the CU here. * trans.c (gigi): Revert to pre-tuples state. (Subprogram_Body_to_gnu): Adjust for end_subprog_body signature change. * gigi.h (end_subprog_body): Remove unused parameter. fortran/ * f95-lang.c (gfc_be_parse_file): Do not finalize the CU here. * trans-decl.c (gfc_gimplify_function): Remove. (build_entry_thunks): Do not gimplify here. (create_main_function): Likewise. (gfc_generate_function_code): Likewise. * g++.dg/rtti/crash4.C: New testcase. * g++.dg/torture/20090706-1.C: Likewise. * gcc.dg/redecl-17.c: Likewise. * gfortran.dg/missing_optional_dummy_5.f90: Adjust pattern. * gcc.dg/declspec-9.c: Expect extra error. * gcc.dg/declspec-10.c: Likewise. * gcc.dg/declspec-11.c: Likewise. * gcc.dg/redecl-10.c: Expect extra warnings. * gcc.target/i386/pr39082-1.c: Adjust diagnostic location. * gcc.target/i386/pr39545-1.c: Likewise. * g++.dg/ext/asm3.C: Expect more errors. * g++.dg/gomp/block-1.C: Likewise. * g++.dg/gomp/block-2.C: Likewise. * g++.dg/gomp/block-3.C: Likewise. * g++.dg/gomp/block-5.C: Likewise. * g++.old-deja/g++.jason/report.C: Expect extra warnings. * g++.dg/warn/unused-result1.C: XFAIL. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149750 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 31 +------------------------------ 1 file changed, 1 insertion(+), 30 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 5ea24c54b45..5133888fa13 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1839,30 +1839,6 @@ create_function_arglist (gfc_symbol * sym) DECL_ARGUMENTS (fndecl) = arglist; } -/* Convert FNDECL's code to GIMPLE and handle any nested functions. */ - -static void -gfc_gimplify_function (tree fndecl) -{ - struct cgraph_node *cgn; - - gimplify_function_tree (fndecl); - dump_function (TDI_generic, fndecl); - - /* Generate errors for structured block violations. */ - /* ??? Could be done as part of resolve_labels. */ - if (flag_openmp) - diagnose_omp_structured_block_errors (fndecl); - - /* Convert all nested functions to GIMPLE now. We do things in this order - so that items like VLA sizes are expanded properly in the context of the - correct function. */ - cgn = cgraph_node (fndecl); - for (cgn = cgn->nested; cgn; cgn = cgn->next_nested) - gfc_gimplify_function (cgn->decl); -} - - /* Do the setup necessary before generating the body of a function. */ static void @@ -2060,7 +2036,6 @@ build_entry_thunks (gfc_namespace * ns) current_function_decl = NULL_TREE; - gfc_gimplify_function (thunk_fndecl); cgraph_finalize_function (thunk_fndecl, false); /* We share the symbols in the formal argument list with other entry @@ -4142,7 +4117,6 @@ create_main_function (tree fndecl) /* Output the GENERIC tree. */ dump_function (TDI_original, ftn_main); - gfc_gimplify_function (ftn_main); cgraph_finalize_function (ftn_main, false); if (old_context) @@ -4414,10 +4388,7 @@ gfc_generate_function_code (gfc_namespace * ns) added to our parent's nested function list. */ (void) cgraph_node (fndecl); else - { - gfc_gimplify_function (fndecl); - cgraph_finalize_function (fndecl, false); - } + cgraph_finalize_function (fndecl, false); gfc_trans_use_stmts (ns); gfc_traverse_ns (ns, gfc_emit_parameter_debug_info); -- cgit v1.2.1 From 773b5eb273987c933c1921fdca22c1e60c288342 Mon Sep 17 00:00:00 2001 From: pault Date: Tue, 21 Jul 2009 04:51:30 +0000 Subject: 2009-07-21 Paul Thomas PR fortran/40726 * trans-decl.c (gfc_get_extern_function_decl): Do not set DECL_IS_MALLOC for pointer valued functions. (build_function_decl): The same. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149846 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 13 ------------- 1 file changed, 13 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 5133888fa13..fa25782b949 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1423,12 +1423,6 @@ gfc_get_extern_function_decl (gfc_symbol * sym) FUNCTION_DECL, name, type); SET_DECL_ASSEMBLER_NAME (fndecl, mangled_name); - /* If the return type is a pointer, avoid alias issues by setting - DECL_IS_MALLOC to nonzero. This means that the function should be - treated as if it were a malloc, meaning it returns a pointer that - is not an alias. */ - if (POINTER_TYPE_P (type)) - DECL_IS_MALLOC (fndecl) = 1; /* Set the context of this decl. */ if (0 && sym->ns && sym->ns->proc_name) @@ -1559,13 +1553,6 @@ build_function_decl (gfc_symbol * sym) /* Don't call layout_decl for a RESULT_DECL. layout_decl (result_decl, 0); */ - /* If the return type is a pointer, avoid alias issues by setting - DECL_IS_MALLOC to nonzero. This means that the function should be - treated as if it were a malloc, meaning it returns a pointer that - is not an alias. */ - if (POINTER_TYPE_P (type)) - DECL_IS_MALLOC (fndecl) = 1; - /* Set up all attributes for the function. */ DECL_CONTEXT (fndecl) = current_function_decl; DECL_EXTERNAL (fndecl) = 0; -- cgit v1.2.1 From 1236e28bedf61e83042a1c15a7b9ade9417f6ed8 Mon Sep 17 00:00:00 2001 From: fxcoudert Date: Wed, 22 Jul 2009 08:28:10 +0000 Subject: * trans.h (gfc_set_decl_assembler_name): New prototype. * trans-decl.c (gfc_set_decl_assembler_name): New function. (gfc_get_symbol_decl, gfc_get_extern_function_decl, build_function_decl): Use gfc_set_decl_assembler_name instead of SET_DECL_ASSEMBLER_NAME. * trans-common.c (build_common_decl): Use gfc_set_decl_assembler_name instead of SET_DECL_ASSEMBLER_NAME. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149918 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 39 ++++++++++++++++++++++++--------------- 1 file changed, 24 insertions(+), 15 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index fa25782b949..83c28cd8ebe 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -368,6 +368,14 @@ gfc_sym_mangled_function_id (gfc_symbol * sym) } +void +gfc_set_decl_assembler_name (tree decl, tree name) +{ + tree target_mangled = targetm.mangle_decl_assembler_name (decl, name); + SET_DECL_ASSEMBLER_NAME (decl, target_mangled); +} + + /* Returns true if a variable of specified size should go on the stack. */ int @@ -1111,12 +1119,16 @@ gfc_get_symbol_decl (gfc_symbol * sym) decl = build_decl (sym->declared_at.lb->location, VAR_DECL, gfc_sym_identifier (sym), gfc_sym_type (sym)); + /* Add attributes to variables. Functions are handled elsewhere. */ + attributes = add_attributes_to_decl (sym->attr, NULL_TREE); + decl_attributes (&decl, attributes, 0); + /* Symbols from modules should have their assembler names mangled. This is done here rather than in gfc_finish_var_decl because it is different for string length variables. */ if (sym->module) { - SET_DECL_ASSEMBLER_NAME (decl, gfc_sym_mangled_identifier (sym)); + gfc_set_decl_assembler_name (decl, gfc_sym_mangled_identifier (sym)); if (sym->attr.use_assoc) DECL_IGNORED_P (decl) = 1; } @@ -1162,7 +1174,7 @@ gfc_get_symbol_decl (gfc_symbol * sym) name[0] = '.'; strcpy (&name[1], IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (length))); - SET_DECL_ASSEMBLER_NAME (decl, get_identifier (name)); + gfc_set_decl_assembler_name (decl, get_identifier (name)); } gfc_finish_var_decl (length, sym); gcc_assert (!sym->value); @@ -1210,10 +1222,6 @@ gfc_get_symbol_decl (gfc_symbol * sym) && !sym->attr.proc_pointer) DECL_BY_REFERENCE (decl) = 1; - /* Add attributes to variables. Functions are handled elsewhere. */ - attributes = add_attributes_to_decl (sym->attr, NULL_TREE); - decl_attributes (&decl, attributes, 0); - return decl; } @@ -1422,7 +1430,10 @@ gfc_get_extern_function_decl (gfc_symbol * sym) fndecl = build_decl (input_location, FUNCTION_DECL, name, type); - SET_DECL_ASSEMBLER_NAME (fndecl, mangled_name); + attributes = add_attributes_to_decl (sym->attr, NULL_TREE); + decl_attributes (&fndecl, attributes, 0); + + gfc_set_decl_assembler_name (fndecl, mangled_name); /* Set the context of this decl. */ if (0 && sym->ns && sym->ns->proc_name) @@ -1465,9 +1476,6 @@ gfc_get_extern_function_decl (gfc_symbol * sym) if (DECL_CONTEXT (fndecl) == NULL_TREE) pushdecl_top_level (fndecl); - attributes = add_attributes_to_decl (sym->attr, NULL_TREE); - decl_attributes (&fndecl, attributes, 0); - return fndecl; } @@ -1501,15 +1509,18 @@ build_function_decl (gfc_symbol * sym) fndecl = build_decl (input_location, FUNCTION_DECL, gfc_sym_identifier (sym), type); + attr = sym->attr; + + attributes = add_attributes_to_decl (attr, NULL_TREE); + decl_attributes (&fndecl, attributes, 0); + /* Perform name mangling if this is a top level or module procedure. */ if (current_function_decl == NULL_TREE) - SET_DECL_ASSEMBLER_NAME (fndecl, gfc_sym_mangled_function_id (sym)); + gfc_set_decl_assembler_name (fndecl, gfc_sym_mangled_function_id (sym)); /* Figure out the return type of the declared function, and build a RESULT_DECL for it. If this is a subroutine with alternate returns, build a RESULT_DECL for it. */ - attr = sym->attr; - result_decl = NULL_TREE; /* TODO: Shouldn't this just be TREE_TYPE (TREE_TYPE (fndecl)). */ if (attr.function) @@ -1579,8 +1590,6 @@ build_function_decl (gfc_symbol * sym) TREE_SIDE_EFFECTS (fndecl) = 0; } - attributes = add_attributes_to_decl (attr, NULL_TREE); - decl_attributes (&fndecl, attributes, 0); /* Layout the function declaration and put it in the binding level of the current function. */ -- cgit v1.2.1 From d01634019b35e129453f15c3e7b1eacd0296455a Mon Sep 17 00:00:00 2001 From: pault Date: Wed, 22 Jul 2009 18:12:35 +0000 Subject: 2009-07-22 Paul Thomas PR fortran/40796 * trans-decl.c (generate_local_decl): Unreferenced result variables with allocatable components should be treated like INTENT_OUT dummy variables. 2009-07-21 Richard Guenther PR fortran/40726 Change attribution to Richi. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149952 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 83c28cd8ebe..b70d0bd235e 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3702,19 +3702,20 @@ generate_local_decl (gfc_symbol * sym) gfc_get_symbol_decl (sym); } - /* INTENT(out) dummy arguments with allocatable components are reset - by default and need to be set referenced to generate the code for - automatic lengths. */ - if (sym->attr.dummy && !sym->attr.referenced + /* INTENT(out) dummy arguments and result variables with allocatable + components are reset by default and need to be set referenced to + generate the code for nullification and automatic lengths. */ + if (!sym->attr.referenced && sym->ts.type == BT_DERIVED && sym->ts.derived->attr.alloc_comp - && sym->attr.intent == INTENT_OUT) + && ((sym->attr.dummy && sym->attr.intent == INTENT_OUT) + || + (sym->attr.result && sym != sym->result))) { sym->attr.referenced = 1; gfc_get_symbol_decl (sym); } - /* Check for dependencies in the array specification and string length, adding the necessary declarations to the function. We mark the symbol now, as well as in traverse_ns, to prevent -- cgit v1.2.1 From bb982f6666cf2bf5e343ac9b910303a97019135c Mon Sep 17 00:00:00 2001 From: rguenth Date: Sat, 25 Jul 2009 13:44:57 +0000 Subject: 2009-07-25 Richard Guenther PR fortran/40005 * trans-types.c (gfc_get_array_type_bounds): Use build_distinct_type_copy with a proper TYPE_CANONICAL and re-use the type-decl of the original type. * trans-decl.c (build_entry_thunks): Signal cgraph we may not garbage collect. (create_main_function): Likewise. (gfc_generate_function_code): Likewise. * trans-expr.c (gfc_trans_subcomponent_assign): Do not use fold_convert on record types. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@150079 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index b70d0bd235e..e4ac20f58b2 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2032,7 +2032,7 @@ build_entry_thunks (gfc_namespace * ns) current_function_decl = NULL_TREE; - cgraph_finalize_function (thunk_fndecl, false); + cgraph_finalize_function (thunk_fndecl, true); /* We share the symbols in the formal argument list with other entry points and the master function. Clear them so that they are @@ -4114,7 +4114,7 @@ create_main_function (tree fndecl) /* Output the GENERIC tree. */ dump_function (TDI_original, ftn_main); - cgraph_finalize_function (ftn_main, false); + cgraph_finalize_function (ftn_main, true); if (old_context) { @@ -4385,7 +4385,7 @@ gfc_generate_function_code (gfc_namespace * ns) added to our parent's nested function list. */ (void) cgraph_node (fndecl); else - cgraph_finalize_function (fndecl, false); + cgraph_finalize_function (fndecl, true); gfc_trans_use_stmts (ns); gfc_traverse_ns (ns, gfc_emit_parameter_debug_info); -- cgit v1.2.1 From c49db15efe1d8b2571d0c2b180338ecce415bff0 Mon Sep 17 00:00:00 2001 From: burnus Date: Mon, 27 Jul 2009 09:32:20 +0000 Subject: 2009-07-26 Tobias Burnus PR fortran/40851 * resolve.c (resolve_symbol): Do not initialize pointer * derived-types. * trans-decl.c (init_intent_out_dt): Ditto. (generate_local_decl): No need to set attr.referenced for DT pointers. 2009-07-26 Tobias Burnus PR fortran/40851 * gfortran.dg/derived_init_3.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@150108 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index e4ac20f58b2..65a6ac5cca9 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2958,7 +2958,8 @@ init_intent_out_dt (gfc_symbol * proc_sym, tree body) gfc_init_block (&fnblock); for (f = proc_sym->formal; f; f = f->next) if (f->sym && f->sym->attr.intent == INTENT_OUT - && f->sym->ts.type == BT_DERIVED) + && !f->sym->attr.pointer + && f->sym->ts.type == BT_DERIVED) { if (f->sym->ts.derived->attr.alloc_comp) { @@ -3708,6 +3709,7 @@ generate_local_decl (gfc_symbol * sym) if (!sym->attr.referenced && sym->ts.type == BT_DERIVED && sym->ts.derived->attr.alloc_comp + && !sym->attr.pointer && ((sym->attr.dummy && sym->attr.intent == INTENT_OUT) || (sym->attr.result && sym != sym->result))) -- cgit v1.2.1 From 296db1d1352c448ad503a4be634f31cc8d784055 Mon Sep 17 00:00:00 2001 From: burnus Date: Wed, 29 Jul 2009 14:44:51 +0000 Subject: 2009-07-29 Tobias Burnus PR fortran/40898 * trans-types.c (gfc_get_function_type): Do not add hidden string-length argument for BIND(C) procedures. * trans-decl.c (create_function_arglist): Skip over nonexisting string-length arguments for BIND(C) procedures. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@150216 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 65a6ac5cca9..783c8f8308e 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1724,7 +1724,8 @@ create_function_arglist (gfc_symbol * sym) type = TREE_VALUE (typelist); - if (f->sym->ts.type == BT_CHARACTER) + if (f->sym->ts.type == BT_CHARACTER + && (!sym->attr.is_bind_c || sym->attr.entry_master)) { tree len_type = TREE_VALUE (hidden_typelist); tree length = NULL_TREE; -- 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/trans-decl.c | 47 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 783c8f8308e..70b78ed9705 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1098,6 +1098,32 @@ gfc_get_symbol_decl (gfc_symbol * sym) if (sym->backend_decl) return sym->backend_decl; + /* If use associated and whole file compilation, use the module + declaration. This is only needed for intrinsic types because + they are substituted for one another during optimization. */ + if (gfc_option.flag_whole_file + && sym->attr.flavor == FL_VARIABLE + && sym->ts.type != BT_DERIVED + && sym->attr.use_assoc + && sym->module) + { + gfc_gsymbol *gsym; + + gsym = gfc_find_gsymbol (gfc_gsym_root, sym->module); + if (gsym && gsym->ns && gsym->type == GSYM_MODULE) + { + gfc_symbol *s; + s = NULL; + gfc_find_symbol (sym->name, gsym->ns, 0, &s); + if (s && s->backend_decl) + { + if (sym->ts.type == BT_CHARACTER) + sym->ts.cl->backend_decl = s->ts.cl->backend_decl; + return s->backend_decl; + } + } + } + /* Catch function declarations. Only used for actual parameters and procedure pointers. */ if (sym->attr.flavor == FL_PROCEDURE) @@ -1341,6 +1367,7 @@ gfc_get_extern_function_decl (gfc_symbol * sym) gsym = gfc_find_gsymbol (gfc_gsym_root, sym->name); if (gfc_option.flag_whole_file + && !sym->attr.use_assoc && !sym->backend_decl && gsym && gsym->ns && ((gsym->type == GSYM_SUBROUTINE) || (gsym->type == GSYM_FUNCTION)) @@ -1371,6 +1398,26 @@ gfc_get_extern_function_decl (gfc_symbol * sym) return sym->backend_decl; } + /* See if this is a module procedure from the same file. If so, + return the backend_decl. */ + if (sym->module) + gsym = gfc_find_gsymbol (gfc_gsym_root, sym->module); + + if (gfc_option.flag_whole_file + && gsym && gsym->ns + && gsym->type == GSYM_MODULE) + { + gfc_symbol *s; + + s = NULL; + gfc_find_symbol (sym->name, gsym->ns, 0, &s); + if (s && s->backend_decl) + { + sym->backend_decl = s->backend_decl; + return sym->backend_decl; + } + } + if (sym->attr.intrinsic) { /* Call the resolution function to get the actual name. This is -- 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/trans-decl.c | 146 +++++++++++++++++++++++------------------------ 1 file changed, 73 insertions(+), 73 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 70b78ed9705..ceabbbe0b98 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -796,7 +796,7 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy) /* Do we know the element size? */ known_size = sym->ts.type != BT_CHARACTER - || INTEGER_CST_P (sym->ts.cl->backend_decl); + || INTEGER_CST_P (sym->ts.u.cl->backend_decl); if (known_size && !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type))) { @@ -928,10 +928,10 @@ gfc_nonlocal_dummy_array_decl (gfc_symbol *sym) static tree gfc_create_string_length (gfc_symbol * sym) { - gcc_assert (sym->ts.cl); - gfc_conv_const_charlen (sym->ts.cl); + gcc_assert (sym->ts.u.cl); + gfc_conv_const_charlen (sym->ts.u.cl); - if (sym->ts.cl->backend_decl == NULL_TREE) + if (sym->ts.u.cl->backend_decl == NULL_TREE) { tree length; char name[GFC_MAX_MANGLED_SYMBOL_LEN + 2]; @@ -947,11 +947,11 @@ gfc_create_string_length (gfc_symbol * sym) if (sym->ns->proc_name->tlink != NULL) gfc_defer_symbol_init (sym); - sym->ts.cl->backend_decl = length; + sym->ts.u.cl->backend_decl = length; } - gcc_assert (sym->ts.cl->backend_decl != NULL_TREE); - return sym->ts.cl->backend_decl; + gcc_assert (sym->ts.u.cl->backend_decl != NULL_TREE); + return sym->ts.u.cl->backend_decl; } /* If a variable is assigned a label, we add another two auxiliary @@ -1050,10 +1050,10 @@ gfc_get_symbol_decl (gfc_symbol * sym) /* Create a character length variable. */ if (sym->ts.type == BT_CHARACTER) { - if (sym->ts.cl->backend_decl == NULL_TREE) + if (sym->ts.u.cl->backend_decl == NULL_TREE) length = gfc_create_string_length (sym); else - length = sym->ts.cl->backend_decl; + length = sym->ts.u.cl->backend_decl; if (TREE_CODE (length) == VAR_DECL && DECL_CONTEXT (length) == NULL_TREE) { @@ -1118,7 +1118,7 @@ gfc_get_symbol_decl (gfc_symbol * sym) if (s && s->backend_decl) { if (sym->ts.type == BT_CHARACTER) - sym->ts.cl->backend_decl = s->ts.cl->backend_decl; + sym->ts.u.cl->backend_decl = s->ts.u.cl->backend_decl; return s->backend_decl; } } @@ -1171,7 +1171,7 @@ gfc_get_symbol_decl (gfc_symbol * sym) GFC_DECL_PACKED_ARRAY (decl) = 1; } - if (sym->ts.type == BT_DERIVED && sym->ts.derived->attr.alloc_comp) + if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.alloc_comp) gfc_defer_symbol_init (sym); /* This applies a derived type default initializer. */ else if (sym->ts.type == BT_DERIVED @@ -1696,9 +1696,9 @@ create_function_arglist (gfc_symbol * sym) PARM_DECL, get_identifier (".__result"), len_type); - if (!sym->ts.cl->length) + if (!sym->ts.u.cl->length) { - sym->ts.cl->backend_decl = length; + sym->ts.u.cl->backend_decl = length; TREE_USED (length) = 1; } gcc_assert (TREE_CODE (length) == PARM_DECL); @@ -1707,13 +1707,13 @@ create_function_arglist (gfc_symbol * sym) TREE_READONLY (length) = 1; DECL_ARTIFICIAL (length) = 1; gfc_finish_decl (length); - if (sym->ts.cl->backend_decl == NULL - || sym->ts.cl->backend_decl == length) + if (sym->ts.u.cl->backend_decl == NULL + || sym->ts.u.cl->backend_decl == length) { gfc_symbol *arg; tree backend_decl; - if (sym->ts.cl->backend_decl == NULL) + if (sym->ts.u.cl->backend_decl == NULL) { tree len = build_decl (input_location, VAR_DECL, @@ -1721,7 +1721,7 @@ create_function_arglist (gfc_symbol * sym) gfc_charlen_type_node); DECL_ARTIFICIAL (len) = 1; TREE_USED (len) = 1; - sym->ts.cl->backend_decl = len; + sym->ts.u.cl->backend_decl = len; } /* Make sure PARM_DECL type doesn't point to incomplete type. */ @@ -1791,38 +1791,38 @@ create_function_arglist (gfc_symbol * sym) gfc_finish_decl (length); /* Remember the passed value. */ - if (f->sym->ts.cl->passed_length != NULL) + if (f->sym->ts.u.cl->passed_length != NULL) { /* This can happen if the same type is used for multiple arguments. We need to copy cl as otherwise cl->passed_length gets overwritten. */ gfc_charlen *cl, *cl2; - cl = f->sym->ts.cl; - f->sym->ts.cl = gfc_get_charlen(); - f->sym->ts.cl->length = cl->length; - f->sym->ts.cl->backend_decl = cl->backend_decl; - f->sym->ts.cl->length_from_typespec = cl->length_from_typespec; - f->sym->ts.cl->resolved = cl->resolved; - cl2 = f->sym->ts.cl->next; - f->sym->ts.cl->next = cl; + cl = f->sym->ts.u.cl; + f->sym->ts.u.cl = gfc_get_charlen(); + f->sym->ts.u.cl->length = cl->length; + f->sym->ts.u.cl->backend_decl = cl->backend_decl; + f->sym->ts.u.cl->length_from_typespec = cl->length_from_typespec; + f->sym->ts.u.cl->resolved = cl->resolved; + cl2 = f->sym->ts.u.cl->next; + f->sym->ts.u.cl->next = cl; cl->next = cl2; } - f->sym->ts.cl->passed_length = length; + f->sym->ts.u.cl->passed_length = length; /* Use the passed value for assumed length variables. */ - if (!f->sym->ts.cl->length) + if (!f->sym->ts.u.cl->length) { TREE_USED (length) = 1; - gcc_assert (!f->sym->ts.cl->backend_decl); - f->sym->ts.cl->backend_decl = length; + gcc_assert (!f->sym->ts.u.cl->backend_decl); + f->sym->ts.u.cl->backend_decl = length; } hidden_typelist = TREE_CHAIN (hidden_typelist); - if (f->sym->ts.cl->backend_decl == NULL - || f->sym->ts.cl->backend_decl == length) + if (f->sym->ts.u.cl->backend_decl == NULL + || f->sym->ts.u.cl->backend_decl == length) { - if (f->sym->ts.cl->backend_decl == NULL) + if (f->sym->ts.u.cl->backend_decl == NULL) gfc_create_string_length (f->sym); /* Make sure PARM_DECL type doesn't point to incomplete type. */ @@ -1993,7 +1993,7 @@ build_entry_thunks (gfc_namespace * ns) args); if (formal->sym->ts.type == BT_CHARACTER) { - tmp = thunk_formal->sym->ts.cl->backend_decl; + tmp = thunk_formal->sym->ts.u.cl->backend_decl; string_args = tree_cons (NULL_TREE, tmp, string_args); } } @@ -2090,15 +2090,15 @@ build_entry_thunks (gfc_namespace * ns) { formal->sym->backend_decl = NULL_TREE; if (formal->sym->ts.type == BT_CHARACTER) - formal->sym->ts.cl->backend_decl = NULL_TREE; + formal->sym->ts.u.cl->backend_decl = NULL_TREE; } if (thunk_sym->attr.function) { if (thunk_sym->ts.type == BT_CHARACTER) - thunk_sym->ts.cl->backend_decl = NULL_TREE; + thunk_sym->ts.u.cl->backend_decl = NULL_TREE; if (thunk_sym->result->ts.type == BT_CHARACTER) - thunk_sym->result->ts.cl->backend_decl = NULL_TREE; + thunk_sym->result->ts.u.cl->backend_decl = NULL_TREE; } } @@ -2207,10 +2207,10 @@ gfc_get_fake_result_decl (gfc_symbol * sym, int parent_flag) if (sym->ts.type == BT_CHARACTER) { - if (sym->ts.cl->backend_decl == NULL_TREE) + if (sym->ts.u.cl->backend_decl == NULL_TREE) length = gfc_create_string_length (sym); else - length = sym->ts.cl->backend_decl; + length = sym->ts.u.cl->backend_decl; if (TREE_CODE (length) == VAR_DECL && DECL_CONTEXT (length) == NULL_TREE) gfc_add_decl_to_function (length); @@ -2816,12 +2816,12 @@ gfc_trans_auto_character_variable (gfc_symbol * sym, tree fnbody) tree tmp; gcc_assert (sym->backend_decl); - gcc_assert (sym->ts.cl && sym->ts.cl->length); + gcc_assert (sym->ts.u.cl && sym->ts.u.cl->length); gfc_start_block (&body); /* Evaluate the string length expression. */ - gfc_conv_string_length (sym->ts.cl, NULL, &body); + gfc_conv_string_length (sym->ts.u.cl, NULL, &body); gfc_trans_vla_type_sizes (sym, &body); @@ -3009,9 +3009,9 @@ init_intent_out_dt (gfc_symbol * proc_sym, tree body) && !f->sym->attr.pointer && f->sym->ts.type == BT_DERIVED) { - if (f->sym->ts.derived->attr.alloc_comp) + if (f->sym->ts.u.derived->attr.alloc_comp) { - tmp = gfc_deallocate_alloc_comp (f->sym->ts.derived, + tmp = gfc_deallocate_alloc_comp (f->sym->ts.u.derived, f->sym->backend_decl, f->sym->as ? f->sym->as->rank : 0); @@ -3022,7 +3022,7 @@ init_intent_out_dt (gfc_symbol * proc_sym, tree body) gfc_add_expr_to_block (&fnblock, tmp); } - if (!f->sym->ts.derived->attr.alloc_comp + if (!f->sym->ts.u.derived->attr.alloc_comp && f->sym->value) body = gfc_init_default_dt (f->sym, body); } @@ -3073,14 +3073,14 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) /* An automatic character length, pointer array result. */ if (proc_sym->ts.type == BT_CHARACTER - && TREE_CODE (proc_sym->ts.cl->backend_decl) == VAR_DECL) - fnbody = gfc_trans_dummy_character (proc_sym, proc_sym->ts.cl, + && TREE_CODE (proc_sym->ts.u.cl->backend_decl) == VAR_DECL) + fnbody = gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, fnbody); } else if (proc_sym->ts.type == BT_CHARACTER) { - if (TREE_CODE (proc_sym->ts.cl->backend_decl) == VAR_DECL) - fnbody = gfc_trans_dummy_character (proc_sym, proc_sym->ts.cl, + if (TREE_CODE (proc_sym->ts.u.cl->backend_decl) == VAR_DECL) + fnbody = gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, fnbody); } else @@ -3096,7 +3096,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink) { bool sym_has_alloc_comp = (sym->ts.type == BT_DERIVED) - && sym->ts.derived->attr.alloc_comp; + && sym->ts.u.derived->attr.alloc_comp; if (sym->attr.dimension) { switch (sym->as->type) @@ -3170,7 +3170,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) gfc_get_backend_locus (&loc); gfc_set_backend_locus (&sym->declared_at); if (sym->attr.dummy || sym->attr.result) - fnbody = gfc_trans_dummy_character (sym, sym->ts.cl, fnbody); + fnbody = gfc_trans_dummy_character (sym, sym->ts.u.cl, fnbody); else fnbody = gfc_trans_auto_character_variable (sym, fnbody); gfc_set_backend_locus (&loc); @@ -3197,8 +3197,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) { if (f->sym && f->sym->tlink == NULL && f->sym->ts.type == BT_CHARACTER) { - gcc_assert (f->sym->ts.cl->backend_decl != NULL); - if (TREE_CODE (f->sym->ts.cl->backend_decl) == PARM_DECL) + gcc_assert (f->sym->ts.u.cl->backend_decl != NULL); + if (TREE_CODE (f->sym->ts.u.cl->backend_decl) == PARM_DECL) gfc_trans_vla_type_sizes (f->sym, &body); } } @@ -3206,8 +3206,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) if (gfc_return_by_reference (proc_sym) && proc_sym->ts.type == BT_CHARACTER && current_fake_result_decl != NULL) { - gcc_assert (proc_sym->ts.cl->backend_decl != NULL); - if (TREE_CODE (proc_sym->ts.cl->backend_decl) == PARM_DECL) + gcc_assert (proc_sym->ts.u.cl->backend_decl != NULL); + if (TREE_CODE (proc_sym->ts.u.cl->backend_decl) == PARM_DECL) gfc_trans_vla_type_sizes (proc_sym, &body); } @@ -3381,7 +3381,7 @@ gfc_create_module_variable (gfc_symbol * sym) { tree length; - length = sym->ts.cl->backend_decl; + length = sym->ts.u.cl->backend_decl; if (!INTEGER_CST_P (length)) { pushdecl (length); @@ -3511,7 +3511,7 @@ check_constant_initializer (gfc_expr *expr, gfc_typespec *ts, bool array, case BT_DERIVED: if (expr->expr_type != EXPR_STRUCTURE) return false; - cm = expr->ts.derived->components; + cm = expr->ts.u.derived->components; for (c = expr->value.constructor; c; c = c->next, cm = cm->next) { if (!c->expr || cm->attr.allocatable) @@ -3557,12 +3557,12 @@ gfc_emit_parameter_debug_info (gfc_symbol *sym) if (sym->ts.type == BT_CHARACTER) { - gfc_conv_const_charlen (sym->ts.cl); - if (sym->ts.cl->backend_decl == NULL - || TREE_CODE (sym->ts.cl->backend_decl) != INTEGER_CST) + gfc_conv_const_charlen (sym->ts.u.cl); + if (sym->ts.u.cl->backend_decl == NULL + || TREE_CODE (sym->ts.u.cl->backend_decl) != INTEGER_CST) return; } - else if (sym->ts.type == BT_DERIVED && sym->ts.derived->attr.alloc_comp) + else if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.alloc_comp) return; if (sym->as) @@ -3690,10 +3690,10 @@ generate_dependency_declarations (gfc_symbol *sym) int i; if (sym->ts.type == BT_CHARACTER - && sym->ts.cl - && sym->ts.cl->length - && sym->ts.cl->length->expr_type != EXPR_CONSTANT) - generate_expr_decls (sym, sym->ts.cl->length); + && sym->ts.u.cl + && sym->ts.u.cl->length + && sym->ts.u.cl->length->expr_type != EXPR_CONSTANT) + generate_expr_decls (sym, sym->ts.u.cl->length); if (sym->as && sym->as->rank) { @@ -3744,8 +3744,8 @@ generate_local_decl (gfc_symbol * sym) warning if requested. */ if (sym->attr.dummy && !sym->attr.referenced && sym->ts.type == BT_CHARACTER - && sym->ts.cl->backend_decl != NULL - && TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL) + && sym->ts.u.cl->backend_decl != NULL + && TREE_CODE (sym->ts.u.cl->backend_decl) == VAR_DECL) { sym->attr.referenced = 1; gfc_get_symbol_decl (sym); @@ -3756,7 +3756,7 @@ generate_local_decl (gfc_symbol * sym) generate the code for nullification and automatic lengths. */ if (!sym->attr.referenced && sym->ts.type == BT_DERIVED - && sym->ts.derived->attr.alloc_comp + && sym->ts.u.derived->attr.alloc_comp && !sym->attr.pointer && ((sym->attr.dummy && sym->attr.intent == INTENT_OUT) || @@ -3887,7 +3887,7 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym) const char *message; fsym = formal->sym; - cl = fsym->ts.cl; + cl = fsym->ts.u.cl; gcc_assert (cl); gcc_assert (cl->passed_length != NULL_TREE); @@ -4224,10 +4224,10 @@ gfc_generate_function_code (gfc_namespace * ns) gfc_entry_list *el; tree backend_decl; - gfc_conv_const_charlen (ns->proc_name->ts.cl); - backend_decl = ns->proc_name->result->ts.cl->backend_decl; + gfc_conv_const_charlen (ns->proc_name->ts.u.cl); + backend_decl = ns->proc_name->result->ts.u.cl->backend_decl; for (el = ns->entries; el; el = el->next) - el->sym->result->ts.cl->backend_decl = backend_decl; + el->sym->result->ts.u.cl->backend_decl = backend_decl; } /* Translate COMMON blocks. */ @@ -4328,11 +4328,11 @@ gfc_generate_function_code (gfc_namespace * ns) if (result != NULL_TREE && sym->attr.function && sym->ts.type == BT_DERIVED - && sym->ts.derived->attr.alloc_comp + && sym->ts.u.derived->attr.alloc_comp && !sym->attr.pointer) { rank = sym->as ? sym->as->rank : 0; - tmp2 = gfc_nullify_alloc_comp (sym->ts.derived, result, rank); + tmp2 = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank); gfc_add_expr_to_block (&block, tmp2); } -- cgit v1.2.1 From d270ce529b4bdd51b952f8ed87746b9e77ada4c2 Mon Sep 17 00:00:00 2001 From: janus Date: Mon, 17 Aug 2009 09:11:00 +0000 Subject: 2009-08-17 Janus Weil PR fortran/40877 * array.c (gfc_resolve_character_array_constructor): Add NULL argument to gfc_new_charlen. * decl.c (add_init_expr_to_sym,variable_decl,match_char_spec, gfc_match_implicit): Ditto. * expr.c (simplify_const_ref): Fix memory leak. (gfc_simplify_expr): Add NULL argument to gfc_new_charlen. * gfortran.h (gfc_new_charlen): Modified prototype. * iresolve.c (check_charlen_present,gfc_resolve_char_achar): Add NULL argument to gfc_new_charlen. * module.c (mio_charlen): Ditto. * resolve.c (gfc_resolve_substring_charlen, gfc_resolve_character_operator,fixup_charlen): Ditto. (resolve_fl_derived,resolve_symbol): Add argument to gfc_charlen. * symbol.c (gfc_new_charlen): Add argument 'old_cl' (to make a copy of an existing charlen). (gfc_set_default_type,generate_isocbinding_symbol): Fix memory leak. (gfc_copy_formal_args_intr): Add NULL argument to gfc_new_charlen. * trans-decl.c (create_function_arglist): Fix memory leak. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@150823 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 11 +---------- 1 file changed, 1 insertion(+), 10 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index ceabbbe0b98..3cc790381ae 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1796,16 +1796,7 @@ create_function_arglist (gfc_symbol * sym) /* This can happen if the same type is used for multiple arguments. We need to copy cl as otherwise cl->passed_length gets overwritten. */ - gfc_charlen *cl, *cl2; - cl = f->sym->ts.u.cl; - f->sym->ts.u.cl = gfc_get_charlen(); - f->sym->ts.u.cl->length = cl->length; - f->sym->ts.u.cl->backend_decl = cl->backend_decl; - f->sym->ts.u.cl->length_from_typespec = cl->length_from_typespec; - f->sym->ts.u.cl->resolved = cl->resolved; - cl2 = f->sym->ts.u.cl->next; - f->sym->ts.u.cl->next = cl; - cl->next = cl2; + f->sym->ts.u.cl = gfc_new_charlen (f->sym->ns, f->sym->ts.u.cl); } f->sym->ts.u.cl->passed_length = length; -- cgit v1.2.1 From 857c96ba039adcf47a0f63eed47ecc9f312d3f36 Mon Sep 17 00:00:00 2001 From: pault Date: Mon, 17 Aug 2009 20:17:12 +0000 Subject: 2008-08-17 Paul Thomas PR fortran/41062 * trans-decl.c (gfc_trans_use_stmts): Keep going through use list if symbol is not use associated. 2008-08-17 Paul Thomas PR fortran/41062 * gfortran.dg/use_only_4.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@150858 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 3cc790381ae..7fb571f5e57 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3426,7 +3426,13 @@ gfc_trans_use_stmts (gfc_namespace * ns) st = gfc_find_symtree (ns->sym_root, rent->local_name[0] ? rent->local_name : rent->use_name); - gcc_assert (st && st->n.sym->attr.use_assoc); + gcc_assert (st); + + /* Sometimes, generic interfaces wind up being over-ruled by a + local symbol (see PR41062). */ + if (!st->n.sym->attr.use_assoc) + continue; + if (st->n.sym->backend_decl && DECL_P (st->n.sym->backend_decl) && st->n.sym->module -- cgit v1.2.1 From e1b3b79beacf0e6747eb7e6a1055d3cd0a436327 Mon Sep 17 00:00:00 2001 From: matz Date: Wed, 19 Aug 2009 10:17:33 +0000 Subject: * tree-ssa-structalias.c (create_variable_info_for): Also mark first field in a struct. (intra_create_variable_infos): Don't deal with flag_argument_noalias. fortran/ * trans-expr.c (gfc_conv_substring): Don't evaluate casted decl early, change order of length calculation to (end - start) + 1. (gfc_get_interface_mapping_array): Adjust call to gfc_get_nodesc_array_type. * trans-array.c (gfc_trans_create_temp_array, gfc_build_constant_array_constructor, gfc_conv_expr_descriptor): Ditto. * trans-stmt.c (gfc_trans_pointer_assign_need_temp): Ditto. * trans.c (gfc_add_modify): Assignment between base type and nontarget type are equal enough. (gfc_call_malloc): Use prvoid_type_node for return value of __builtin_malloc. (gfc_allocate_with_status): Ditto. * trans-types.c (gfc_array_descriptor_base): Double size of this array. (gfc_init_types): Build prvoid_type_node. (gfc_build_array_type): New bool parameter "restricted". (gfc_get_nodesc_array_type): Ditto, build restrict qualified pointers, if it's true. (gfc_get_array_descriptor_base): Ditto. (gfc_get_array_type_bounds): Ditto. (gfc_sym_type): Use symbol attributes to feed calls to above functions. (gfc_get_derived_type): Ditto. * trans.h (struct lang_type): Add nontarget_type member. * trans-types.h (prvoid_type_node): Declare. (gfc_get_array_type_bounds, gfc_get_nodesc_array_type): Declare new parameter. * trans-decl.c (gfc_finish_var_decl): Give scalars that can't be aliased a type with a different alias set than the base type. (gfc_build_dummy_array_decl): Adjust call to gfc_get_nodesc_array_type. testsuite/ * gfortran.dg/vect/vect-gems.f90: New test. * gcc.dg/tree-ssa/alias-1.c: Remove, it checks something broken. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@150934 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 26 +++++++++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 7fb571f5e57..6a4c3e45cc9 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -578,6 +578,29 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) if (sym->attr.threadprivate && (TREE_STATIC (decl) || DECL_EXTERNAL (decl))) DECL_TLS_MODEL (decl) = decl_default_tls_model (decl); + + if (!sym->attr.target + && !sym->attr.pointer + && !sym->attr.proc_pointer + /* For now, don't bother with aggregate types. We would need + to adjust DECL_CONTEXT of all field decls. */ + && !AGGREGATE_TYPE_P (TREE_TYPE (decl))) + { + tree type = TREE_TYPE (decl); + if (!TYPE_LANG_SPECIFIC (type)) + TYPE_LANG_SPECIFIC (type) = (struct lang_type *) + ggc_alloc_cleared (sizeof (struct lang_type)); + if (!TYPE_LANG_SPECIFIC (type)->nontarget_type) + { + alias_set_type set = new_alias_set (); + type = build_distinct_type_copy (type); + TYPE_ALIAS_SET (type) = set; + TYPE_LANG_SPECIFIC (type)->nontarget_type = type; + } + else + type = TYPE_LANG_SPECIFIC (type)->nontarget_type; + TREE_TYPE (decl) = type; + } } @@ -840,7 +863,8 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy) } type = gfc_typenode_for_spec (&sym->ts); - type = gfc_get_nodesc_array_type (type, sym->as, packed); + type = gfc_get_nodesc_array_type (type, sym->as, packed, + !sym->attr.target); } else { -- cgit v1.2.1 From 8bb76364adb500f539b7bbd329b83e4602bf839b Mon Sep 17 00:00:00 2001 From: matz Date: Wed, 16 Sep 2009 16:12:18 +0000 Subject: PR fortran/41212 * tree.h (struct tree_decl_common): Add decl_restricted_flag, shorten decl_common_unused. (DECL_RESTRICTED_P): New accessor. * tree-ssa-alias.c (ptr_deref_may_alias_decl_p): Use it to disambiguate marked decls and restrict pointers. fortran/ * trans.h (struct lang_type): Remove nontarget_type member. * trans.c (gfc_add_modify): Don't access it. * trans-decl.c (gfc_finish_var_decl): Don't allocate and set it, instead set DECL_RESTRICTED_P on affected decls. testsuite/ * gfortran.dg/pr41212.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@151761 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 22 ++-------------------- 1 file changed, 2 insertions(+), 20 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 6a4c3e45cc9..4e72a23bd5c 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -581,26 +581,8 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) if (!sym->attr.target && !sym->attr.pointer - && !sym->attr.proc_pointer - /* For now, don't bother with aggregate types. We would need - to adjust DECL_CONTEXT of all field decls. */ - && !AGGREGATE_TYPE_P (TREE_TYPE (decl))) - { - tree type = TREE_TYPE (decl); - if (!TYPE_LANG_SPECIFIC (type)) - TYPE_LANG_SPECIFIC (type) = (struct lang_type *) - ggc_alloc_cleared (sizeof (struct lang_type)); - if (!TYPE_LANG_SPECIFIC (type)->nontarget_type) - { - alias_set_type set = new_alias_set (); - type = build_distinct_type_copy (type); - TYPE_ALIAS_SET (type) = set; - TYPE_LANG_SPECIFIC (type)->nontarget_type = type; - } - else - type = TYPE_LANG_SPECIFIC (type)->nontarget_type; - TREE_TYPE (decl) = type; - } + && !sym->attr.proc_pointer) + DECL_RESTRICTED_P (decl) = 1; } -- 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/trans-decl.c | 45 +++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 43 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 4e72a23bd5c..3d6a5e2221c 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -64,6 +64,10 @@ static GTY(()) tree saved_parent_function_decls; static struct pointer_set_t *nonlocal_dummy_decl_pset; static GTY(()) tree nonlocal_dummy_decls; +/* Holds the variable DECLs that are locals. */ + +static GTY(()) tree saved_local_decls; + /* The namespace of the module we're currently generating. Only used while outputting decls for module variables. Do not rely on this being set. */ @@ -180,6 +184,16 @@ gfc_add_decl_to_function (tree decl) saved_function_decls = decl; } +static void +add_decl_as_local (tree decl) +{ + gcc_assert (decl); + TREE_USED (decl) = 1; + DECL_CONTEXT (decl) = current_function_decl; + TREE_CHAIN (decl) = saved_local_decls; + saved_local_decls = decl; +} + /* Build a backend label declaration. Set TREE_USED for named labels. The context of the label is always the current_function_decl. All @@ -504,8 +518,11 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) if (current_function_decl != NULL_TREE) { if (sym->ns->proc_name->backend_decl == current_function_decl - || sym->result == sym) + || sym->result == sym) gfc_add_decl_to_function (decl); + else if (sym->ns->proc_name->attr.flavor == FL_LABEL) + /* This is a BLOCK construct. */ + add_decl_as_local (decl); else gfc_add_decl_to_parent_function (decl); } @@ -3036,7 +3053,7 @@ init_intent_out_dt (gfc_symbol * proc_sym, tree body) Initialization and possibly repacking of dummy arrays. Initialization of ASSIGN statement auxiliary variable. */ -static tree +tree gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) { locus loc; @@ -4552,4 +4569,28 @@ gfc_generate_block_data (gfc_namespace * ns) } +/* Process the local variables of a BLOCK construct. */ + +void +gfc_process_block_locals (gfc_namespace* ns) +{ + tree decl; + + gcc_assert (saved_local_decls == NULL_TREE); + generate_local_vars (ns); + + decl = saved_local_decls; + while (decl) + { + tree next; + + next = TREE_CHAIN (decl); + TREE_CHAIN (decl) = NULL_TREE; + pushdecl (decl); + decl = next; + } + saved_local_decls = NULL_TREE; +} + + #include "gt-fortran-trans-decl.h" -- cgit v1.2.1 From c38054a8342f5a4986bd11c16147aa6edae63bab Mon Sep 17 00:00:00 2001 From: burnus Date: Fri, 2 Oct 2009 16:25:50 +0000 Subject: 2009-10-02 Tobias Burnus PR fortran/41479 * trans-decl.c (gfc_init_default_dt): Check for presence of the argument only if it is optional or in entry master. (init_intent_out_dt): Ditto; call gfc_init_default_dt for all derived types with initializers. 2009-10-02 Tobias Burnus PR fortran/41479 * gfortran.dg/intent_out_5.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@152407 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 3d6a5e2221c..ee38efbe27c 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2991,7 +2991,8 @@ gfc_init_default_dt (gfc_symbol * sym, tree body) gfc_set_sym_referenced (sym); e = gfc_lval_expr_from_sym (sym); tmp = gfc_trans_assignment (e, sym->value, false); - if (sym->attr.dummy) + if (sym->attr.dummy && (sym->attr.optional + || sym->ns->proc_name->attr.entry_master)) { present = gfc_conv_expr_present (sym); tmp = build3 (COND_EXPR, TREE_TYPE (tmp), present, @@ -3023,21 +3024,23 @@ init_intent_out_dt (gfc_symbol * proc_sym, tree body) && !f->sym->attr.pointer && f->sym->ts.type == BT_DERIVED) { - if (f->sym->ts.u.derived->attr.alloc_comp) + if (f->sym->ts.u.derived->attr.alloc_comp && !f->sym->value) { tmp = gfc_deallocate_alloc_comp (f->sym->ts.u.derived, f->sym->backend_decl, f->sym->as ? f->sym->as->rank : 0); - present = gfc_conv_expr_present (f->sym); - tmp = build3 (COND_EXPR, TREE_TYPE (tmp), present, - tmp, build_empty_stmt (input_location)); + if (f->sym->attr.optional + || f->sym->ns->proc_name->attr.entry_master) + { + present = gfc_conv_expr_present (f->sym); + tmp = build3 (COND_EXPR, TREE_TYPE (tmp), present, + tmp, build_empty_stmt (input_location)); + } gfc_add_expr_to_block (&fnblock, tmp); } - - if (!f->sym->ts.u.derived->attr.alloc_comp - && f->sym->value) + else if (f->sym->value) body = gfc_init_default_dt (f->sym, body); } -- 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/trans-decl.c | 59 +++++++++++++++++++++++++++++++++++++----------- 1 file changed, 46 insertions(+), 13 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index ee38efbe27c..8812675990f 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1187,22 +1187,23 @@ gfc_get_symbol_decl (gfc_symbol * sym) /* Create variables to hold the non-constant bits of array info. */ gfc_build_qualified_array (decl, sym); - /* Remember this variable for allocation/cleanup. */ - gfc_defer_symbol_init (sym); - if ((sym->attr.allocatable || !sym->attr.dummy) && !sym->attr.pointer) GFC_DECL_PACKED_ARRAY (decl) = 1; } - if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.alloc_comp) - gfc_defer_symbol_init (sym); - /* This applies a derived type default initializer. */ - else if (sym->ts.type == BT_DERIVED - && sym->attr.save == SAVE_NONE - && !sym->attr.data - && !sym->attr.allocatable - && (sym->value && !sym->ns->proc_name->attr.is_main_program) - && !sym->attr.use_assoc) + /* Remember this variable for allocation/cleanup. */ + if (sym->attr.dimension || sym->attr.allocatable + || (sym->ts.type == BT_CLASS && + (sym->ts.u.derived->components->attr.dimension + || sym->ts.u.derived->components->attr.allocatable)) + || (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.alloc_comp) + /* This applies a derived type default initializer. */ + || (sym->ts.type == BT_DERIVED + && sym->attr.save == SAVE_NONE + && !sym->attr.data + && !sym->attr.allocatable + && (sym->value && !sym->ns->proc_name->attr.is_main_program) + && !sym->attr.use_assoc)) gfc_defer_symbol_init (sym); gfc_finish_var_decl (decl, sym); @@ -3054,7 +3055,8 @@ init_intent_out_dt (gfc_symbol * proc_sym, tree body) Allocation and initialization of array variables. Allocation of character string variables. Initialization and possibly repacking of dummy arrays. - Initialization of ASSIGN statement auxiliary variable. */ + Initialization of ASSIGN statement auxiliary variable. + Automatic deallocation. */ tree gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) @@ -3182,6 +3184,37 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) } else if (sym_has_alloc_comp) fnbody = gfc_trans_deferred_array (sym, fnbody); + else if (sym->attr.allocatable + || (sym->ts.type == BT_CLASS + && sym->ts.u.derived->components->attr.allocatable)) + { + /* Automatic deallocatation of allocatable scalars. */ + tree tmp; + gfc_expr *e; + gfc_se se; + stmtblock_t block; + + e = gfc_lval_expr_from_sym (sym); + if (sym->ts.type == BT_CLASS) + gfc_add_component_ref (e, "$data"); + + gfc_init_se (&se, NULL); + se.want_pointer = 1; + gfc_conv_expr (&se, e); + gfc_free_expr (e); + + gfc_start_block (&block); + gfc_add_expr_to_block (&block, fnbody); + + tmp = gfc_deallocate_with_status (se.expr, NULL_TREE, true, NULL); + gfc_add_expr_to_block (&block, tmp); + + tmp = fold_build2 (MODIFY_EXPR, void_type_node, + se.expr, build_int_cst (TREE_TYPE (se.expr), 0)); + gfc_add_expr_to_block (&block, tmp); + + fnbody = gfc_finish_block (&block); + } else if (sym->ts.type == BT_CHARACTER) { gfc_get_backend_locus (&loc); -- cgit v1.2.1 From 5176859a917209dc5320a6f25a1cc5badb3a4320 Mon Sep 17 00:00:00 2001 From: burnus Date: Sun, 1 Nov 2009 17:46:50 +0000 Subject: 2009-11-01 Tobias Burnus PR fortran/41872 * trans-decl.c (gfc_trans_deferred_vars): Do not nullify autodeallocated allocatable scalars at the end of scope. (gfc_generate_function_code): Fix indention. * trans-expr.c (gfc_conv_procedure_call): For allocatable scalars, fix calling by reference and autodeallocating of intent out variables. 2009-11-01 Tobias Burnus PR fortran/41872 * gfortran.dg/allocatable_scalar_4.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@153795 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 16 ++++++---------- 1 file changed, 6 insertions(+), 10 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 8812675990f..8ac6b9acc19 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3193,7 +3193,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) gfc_expr *e; gfc_se se; stmtblock_t block; - + e = gfc_lval_expr_from_sym (sym); if (sym->ts.type == BT_CLASS) gfc_add_component_ref (e, "$data"); @@ -3206,13 +3206,9 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) gfc_start_block (&block); gfc_add_expr_to_block (&block, fnbody); + /* Note: Nullifying is not needed. */ tmp = gfc_deallocate_with_status (se.expr, NULL_TREE, true, NULL); gfc_add_expr_to_block (&block, tmp); - - tmp = fold_build2 (MODIFY_EXPR, void_type_node, - se.expr, build_int_cst (TREE_TYPE (se.expr), 0)); - gfc_add_expr_to_block (&block, tmp); - fnbody = gfc_finish_block (&block); } else if (sym->ts.type == BT_CHARACTER) @@ -4396,10 +4392,10 @@ gfc_generate_function_code (gfc_namespace * ns) /* Reset recursion-check variable. */ if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !is_recursive) - { - gfc_add_modify (&block, recurcheckvar, boolean_false_node); - recurcheckvar = NULL; - } + { + gfc_add_modify (&block, recurcheckvar, boolean_false_node); + recurcheckvar = NULL; + } if (result == NULL_TREE) { -- cgit v1.2.1 From 7c0ca46e388feaf0a07c46ff999ea9355ba9f4a8 Mon Sep 17 00:00:00 2001 From: kargl Date: Thu, 5 Nov 2009 20:57:12 +0000 Subject: 2009-11-03 Steven G. Kargl PR fortran/41918 * fortran/trans-decl.c: Silence intent(out) warning for derived type dummy arguments with default initialization. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@153952 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 8ac6b9acc19..200c3f5654c 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3776,8 +3776,12 @@ generate_local_decl (gfc_symbol * sym) else if (warn_unused_variable && sym->attr.dummy && sym->attr.intent == INTENT_OUT) - gfc_warning ("Dummy argument '%s' at %L was declared INTENT(OUT) but was not set", - sym->name, &sym->declared_at); + { + if (!(sym->ts.type == BT_DERIVED + && sym->ts.u.derived->components->initializer)) + gfc_warning ("Dummy argument '%s' at %L was declared INTENT(OUT) " + "but was not set", sym->name, &sym->declared_at); + } /* Specific warning for unused dummy arguments. */ else if (warn_unused_variable && sym->attr.dummy) gfc_warning ("Unused dummy argument '%s' at %L", sym->name, -- cgit v1.2.1 From bdfbc762ef80b1196e214ed9c90e9f57a11e264b Mon Sep 17 00:00:00 2001 From: janus Date: Mon, 30 Nov 2009 20:43:06 +0000 Subject: merge from fortran-dev branch: gcc/fortran/ 2009-11-30 Janus Weil PR fortran/42053 * resolve.c (resolve_select_type): Check for duplicate CLASS IS blocks. 2009-11-30 Janus Weil PR fortran/41631 * decl.c (gfc_match_derived_decl): Set extension level. * gfortran.h (symbol_attribute): Expand 'extension' bit field to 8 bit. * iresolve.c (gfc_resolve_extends_type_of): Return value of 'is_extension_of' has kind=4. * match.c (select_type_set_tmp,gfc_match_class_is): Create temporary for CLASS IS blocks. * module.c (MOD_VERSION): Bump module version. (ab_attribute,attr_bits): Remove AB_EXTENSION. (mio_symbol_attribute): Handle expanded 'extension' field. * resolve.c (resolve_select_type): Implement CLASS IS blocks. (resolve_fl_variable_derived): Show correct type name. * symbol.c (gfc_build_class_symbol): Set extension level. 2009-11-30 Janus Weil * intrinsic.h (gfc_resolve_extends_type_of): Add prototype. * intrinsic.c (add_functions): Use 'gfc_resolve_extends_type_of'. * iresolve.c (gfc_resolve_extends_type_of): New function, which replaces the call to EXTENDS_TYPE_OF by the library function 'is_extension_of' and modifies the arguments. * trans-intrinsic.c (gfc_conv_extends_type_of): Removed. (gfc_conv_intrinsic_function): FOR EXTENDS_TYPE_OF, don't call gfc_conv_extends_type_of but gfc_conv_intrinsic_funcall. 2009-11-30 Paul Thomas Janus Weil * decl.c (encapsulate_class_symbol): Replaced by 'gfc_build_class_symbol'. (build_sym,build_struct): Call 'gfc_build_class_symbol'. (gfc_match_derived_decl): Replace vindex by hash_value. * dump-parse-tree.c (show_symbol): Replace vindex by hash_value. * gfortran.h (symbol_attribute): Add field 'vtab'. (gfc_symbol): Replace vindex by hash_value. (gfc_class_esym_list): Ditto. (gfc_get_derived_type,gfc_build_class_symbol,gfc_find_derived_vtab): New prototypes. * module.c (mio_symbol): Replace vindex by hash_value. * resolve.c (vindex_expr): Rename to 'hash_value_expr'. (resolve_class_compcall,resolve_class_typebound_call): Renamed 'vindex_expr'. (resolve_select_type): Replace $vindex by $vptr->$hash. * symbol.c (gfc_add_save): Handle vtab symbols. (gfc_type_compatible): Rewrite. (gfc_build_class_symbol): New function which replaces 'encapsulate_class_symbol'. (gfc_find_derived_vtab): New function to set up a vtab symbol for a derived type. * trans-decl.c (gfc_create_module_variable): Handle vtab symbols. * trans-expr.c (select_class_proc): Replace vindex by hash_value. (gfc_conv_derived_to_class): New function to construct a temporary CLASS variable from a derived type expression. (gfc_conv_procedure_call): Call 'gfc_conv_derived_to_class'. (gfc_conv_structure): Initialize the $extends and $size fields of vtab symbols. (gfc_trans_class_assign): Replace $vindex by $vptr. Remove the $size assignment. * trans-intrinsic.c (gfc_conv_same_type_as): Replace $vindex by $vptr->$hash, and replace vindex by hash_value. * trans-stmt.c (gfc_trans_allocate): Insert $vptr references, replace $vindex by $vptr. Remove the $size assignment. * trans-types.c (gfc_get_derived_type): Make it non-static. gcc/testsuite/ 2009-11-30 Janus Weil PR fortran/42053 * gfortran.dg/select_type_9.f03: New. 2009-11-30 Janus Weil PR fortran/41631 * gfortran.dg/extends_type_of_1.f03: Fix invalid test case. * gfortran.dg/module_md5_1.f90: Adjusted MD5 sum. * gfortran.dg/select_type_1.f03: Remove FIXMEs. * gfortran.dg/select_type_2.f03: Ditto. * gfortran.dg/select_type_8.f03: New test. 2009-11-30 Janus Weil * gfortran.dg/extends_type_of_1.f03: New test. * gfortran.dg/same_type_as_1.f03: Extended. 2009-11-30 Paul Thomas * gfortran.dg/class_4c.f03: Add dg-additional-sources. * gfortran.dg/class_4d.f03: Rename module. Cleanup modules. libgfortran/ 2009-11-30 Janus Weil * gfortran.map: Add _gfortran_is_extension_of. * Makefile.am: Add intrinsics/extends_type_of.c. * Makefile.in: Regenerated. * intrinsics/extends_type_of.c: New file. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@154840 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 200c3f5654c..2e3fedd0ed3 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3405,7 +3405,7 @@ gfc_create_module_variable (gfc_symbol * sym) && (sym->equiv_built || sym->attr.in_equivalence)) return; - if (sym->backend_decl) + if (sym->backend_decl && !sym->attr.vtab) internal_error ("backend decl for module variable %s already exists", sym->name); -- cgit v1.2.1 From ef00cabe36cd1dd66cd2f3b3ecff02b5afcfb428 Mon Sep 17 00:00:00 2001 From: janus Date: Tue, 29 Dec 2009 19:29:54 +0000 Subject: gcc/fortran/ 2009-12-29 Janus Weil PR fortran/42517 * invoke.texi: Document the interference of -fcheck=recursion and -fopenmp. * trans-decl.c (gfc_generate_function_code): Disable -fcheck=recursion when used with -fopenmp. gcc/testsuite/ 2009-12-29 Janus Weil PR fortran/42517 * gfortran.dg/gomp/recursion1.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@155506 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 2e3fedd0ed3..9a01dbab32c 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -4318,7 +4318,8 @@ gfc_generate_function_code (gfc_namespace * ns) is_recursive = sym->attr.recursive || (sym->attr.entry_master && sym->ns->entries->sym->attr.recursive); - if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !is_recursive) + if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !is_recursive + && !gfc_option.flag_openmp) { char * msg; @@ -4395,7 +4396,8 @@ gfc_generate_function_code (gfc_namespace * ns) gfc_add_expr_to_block (&block, tmp); /* Reset recursion-check variable. */ - if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !is_recursive) + if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !is_recursive + && !gfc_option.flag_openmp) { gfc_add_modify (&block, recurcheckvar, boolean_false_node); recurcheckvar = NULL; @@ -4426,7 +4428,8 @@ gfc_generate_function_code (gfc_namespace * ns) { gfc_add_expr_to_block (&block, tmp); /* Reset recursion-check variable. */ - if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !is_recursive) + if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !is_recursive + && !gfc_option.flag_openmp) { gfc_add_modify (&block, recurcheckvar, boolean_false_node); recurcheckvar = NULL; -- cgit v1.2.1 From 531692793cdfeb07aeac29c3daf772a401bc01d9 Mon Sep 17 00:00:00 2001 From: burnus Date: Mon, 4 Jan 2010 07:30:49 +0000 Subject: 2009-01-04 Tobias Burnus PR fortran/41872 * trans-expr.c (gfc_conv_procedure_call): Add indirect ref for functions returning allocatable scalars. * trans-stmt.c (gfc_trans_allocate): Emmit error when reallocating an allocatable scalar. * trans.c (gfc_allocate_with_status): Fix pseudocode syntax in comment. * trans-decl.c (gfc_trans_deferred_vars): Nullify local allocatable scalars. (gfc_generate_function_code): Nullify result variable for allocatable scalars. PR fortran/40849 * module.c (gfc_use_module): Fix warning string to allow for translation. PR fortran/42517 * invoke.texi (-fcheck=recursion): Mention that the checking is also disabled for -frecursive. * trans-decl.c (gfc_generate_function_code): Disable -fcheck=recursion when -frecursive is used. * intrinsic.texi (iso_c_binding): Improve wording. 2009-01-04 Tobias Burnus PR fortran/41872 * gfortran.dg/allocatable_scalar_5.f90: New test. * gfortran.dg/allocatable_scalar_6.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@155606 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 9a01dbab32c..f93cc9f2cae 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3188,7 +3188,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) || (sym->ts.type == BT_CLASS && sym->ts.u.derived->components->attr.allocatable)) { - /* Automatic deallocatation of allocatable scalars. */ + /* Nullify and automatic deallocatation of allocatable scalars. */ tree tmp; gfc_expr *e; gfc_se se; @@ -3203,10 +3203,13 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) gfc_conv_expr (&se, e); gfc_free_expr (e); + /* Nullify when entering the scope. */ gfc_start_block (&block); + gfc_add_modify (&block, se.expr, fold_convert (TREE_TYPE (se.expr), + null_pointer_node)); gfc_add_expr_to_block (&block, fnbody); - /* Note: Nullifying is not needed. */ + /* Deallocate when leaving the scope. Nullifying is not needed. */ tmp = gfc_deallocate_with_status (se.expr, NULL_TREE, true, NULL); gfc_add_expr_to_block (&block, tmp); fnbody = gfc_finish_block (&block); @@ -4319,7 +4322,7 @@ gfc_generate_function_code (gfc_namespace * ns) || (sym->attr.entry_master && sym->ns->entries->sym->attr.recursive); if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !is_recursive - && !gfc_option.flag_openmp) + && !gfc_option.flag_recursive) { char * msg; @@ -4384,13 +4387,18 @@ gfc_generate_function_code (gfc_namespace * ns) result = sym->result->backend_decl; if (result != NULL_TREE && sym->attr.function - && sym->ts.type == BT_DERIVED - && sym->ts.u.derived->attr.alloc_comp - && !sym->attr.pointer) + && !sym->attr.pointer) { - rank = sym->as ? sym->as->rank : 0; - tmp2 = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank); - gfc_add_expr_to_block (&block, tmp2); + if (sym->ts.type == BT_DERIVED + && sym->ts.u.derived->attr.alloc_comp) + { + rank = sym->as ? sym->as->rank : 0; + tmp2 = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank); + gfc_add_expr_to_block (&block, tmp2); + } + else if (sym->attr.allocatable && sym->attr.dimension == 0) + gfc_add_modify (&block, result, fold_convert (TREE_TYPE (result), + null_pointer_node)); } gfc_add_expr_to_block (&block, tmp); -- cgit v1.2.1 From ea657963cde8b9b63750cf761de3da15b7b0ab44 Mon Sep 17 00:00:00 2001 From: burnus Date: Mon, 4 Jan 2010 07:38:12 +0000 Subject: 2010-01-04 Tobias Burnus * trans-decl.c (gfc_trans_deferred_vars): Fix spelling. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@155607 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index f93cc9f2cae..ce33b2abc19 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -537,7 +537,7 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) gfortran would typically put them in either the BSS or initialized data segments, and only mark them as common if they were part of common blocks. However, if they are not put - into common space, then C cannot initialize global fortran + into common space, then C cannot initialize global Fortran variables that it interoperates with and the draft says that either Fortran or C should be able to initialize it (but not both, of course.) (J3/04-007, section 15.3). */ @@ -3188,7 +3188,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) || (sym->ts.type == BT_CLASS && sym->ts.u.derived->components->attr.allocatable)) { - /* Nullify and automatic deallocatation of allocatable scalars. */ + /* Nullify and automatic deallocation of allocatable scalars. */ tree tmp; gfc_expr *e; gfc_se se; -- cgit v1.2.1 From 908e997339dbab1973cc1d82446b1d6abcdd1397 Mon Sep 17 00:00:00 2001 From: burnus Date: Thu, 7 Jan 2010 08:09:51 +0000 Subject: 2010-01-07 Tobias Burnus PR fortran/41872 * trans-decl.c (gfc_trans_deferred_vars): Don't initialize allocatable scalars with SAVE attribute. 2010-01-07 Tobias Burnus PR fortran/41872 * gfortran.dg/allocatable_scalar_7.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@155687 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 57 +++++++++++++++++++++++++++--------------------- 1 file changed, 32 insertions(+), 25 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index ce33b2abc19..cf9bef31d93 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3188,31 +3188,38 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) || (sym->ts.type == BT_CLASS && sym->ts.u.derived->components->attr.allocatable)) { - /* Nullify and automatic deallocation of allocatable scalars. */ - tree tmp; - gfc_expr *e; - gfc_se se; - stmtblock_t block; - - e = gfc_lval_expr_from_sym (sym); - if (sym->ts.type == BT_CLASS) - gfc_add_component_ref (e, "$data"); - - gfc_init_se (&se, NULL); - se.want_pointer = 1; - gfc_conv_expr (&se, e); - gfc_free_expr (e); - - /* Nullify when entering the scope. */ - gfc_start_block (&block); - gfc_add_modify (&block, se.expr, fold_convert (TREE_TYPE (se.expr), - null_pointer_node)); - gfc_add_expr_to_block (&block, fnbody); - - /* Deallocate when leaving the scope. Nullifying is not needed. */ - tmp = gfc_deallocate_with_status (se.expr, NULL_TREE, true, NULL); - gfc_add_expr_to_block (&block, tmp); - fnbody = gfc_finish_block (&block); + if (!sym->attr.save) + { + /* Nullify and automatic deallocation of allocatable + scalars. */ + tree tmp; + gfc_expr *e; + gfc_se se; + stmtblock_t block; + + e = gfc_lval_expr_from_sym (sym); + if (sym->ts.type == BT_CLASS) + gfc_add_component_ref (e, "$data"); + + gfc_init_se (&se, NULL); + se.want_pointer = 1; + gfc_conv_expr (&se, e); + gfc_free_expr (e); + + /* Nullify when entering the scope. */ + gfc_start_block (&block); + gfc_add_modify (&block, se.expr, + fold_convert (TREE_TYPE (se.expr), + null_pointer_node)); + gfc_add_expr_to_block (&block, fnbody); + + /* Deallocate when leaving the scope. Nullifying is not + needed. */ + tmp = gfc_deallocate_with_status (se.expr, NULL_TREE, true, + NULL); + gfc_add_expr_to_block (&block, tmp); + fnbody = gfc_finish_block (&block); + } } else if (sym->ts.type == BT_CHARACTER) { -- cgit v1.2.1 From 9c2eafdb502b2e6de358e9a36514e76518cb9aa3 Mon Sep 17 00:00:00 2001 From: burnus Date: Thu, 7 Jan 2010 08:12:10 +0000 Subject: 2010-01-07 Tobias Burnus PR fortran/42597 * trans-decl.c (get_proc_pointer_decl): Fix call to gfc_conv_initializer for array-valued proc-pointer funcs. 2010-01-07 Tobias Burnus PR fortran/42597 * gfortran.dg/proc_ptr_26.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@155688 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index cf9bef31d93..612c6f61296 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1349,7 +1349,9 @@ get_proc_pointer_decl (gfc_symbol *sym) { /* Add static initializer. */ DECL_INITIAL (decl) = gfc_conv_initializer (sym->value, &sym->ts, - TREE_TYPE (decl), sym->attr.dimension, sym->attr.proc_pointer); + TREE_TYPE (decl), + sym->attr.proc_pointer ? false : sym->attr.dimension, + sym->attr.proc_pointer); } attributes = add_attributes_to_decl (sym->attr, NULL_TREE); -- cgit v1.2.1 From 5fa0fdc2ffb6ad0bb91d325d6c3f847357f55ca3 Mon Sep 17 00:00:00 2001 From: pault Date: Tue, 19 Jan 2010 19:46:59 +0000 Subject: 2010-01-19 Paul Thomas PR fortran/42783 * trans-decl.c (add_argument_checking): Do not use the backend decl directly to test for the presence of an optional dummy argument. Use gfc_conv_expr_present, remembering to set the symbol referenced. PR fortran/42772 * trans-decl.c (gfc_generate_function_code): Small white space changes. If 'recurcheckvar' is NULL do not try to reset it. 2010-01-19 Paul Thomas PR fortran/42783 * gfortran.dg/bounds_check_15.f90 : New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@156046 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 39 +++++++++++++++++++++++---------------- 1 file changed, 23 insertions(+), 16 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 612c6f61296..062310af6af 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3999,8 +3999,9 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym) cl->passed_length, fold_convert (gfc_charlen_type_node, integer_zero_node)); - not_absent = fold_build2 (NE_EXPR, boolean_type_node, - fsym->backend_decl, null_pointer_node); + /* The symbol needs to be referenced for gfc_get_symbol_decl. */ + fsym->attr.referenced = 1; + not_absent = gfc_conv_expr_present (fsym); absent_failed = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, not_0length, not_absent); @@ -4256,7 +4257,7 @@ gfc_generate_function_code (gfc_namespace * ns) stmtblock_t block; stmtblock_t body; tree result; - tree recurcheckvar = NULL; + tree recurcheckvar = NULL_TREE; gfc_symbol *sym; int rank; bool is_recursive; @@ -4330,8 +4331,9 @@ gfc_generate_function_code (gfc_namespace * ns) is_recursive = sym->attr.recursive || (sym->attr.entry_master && sym->ns->entries->sym->attr.recursive); - if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !is_recursive - && !gfc_option.flag_recursive) + if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) + && !is_recursive + && !gfc_option.flag_recursive) { char * msg; @@ -4348,7 +4350,7 @@ gfc_generate_function_code (gfc_namespace * ns) } if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node - && sym->attr.subroutine) + && sym->attr.subroutine) { tree alternate_return; alternate_return = gfc_get_fake_result_decl (sym, 0); @@ -4395,8 +4397,9 @@ gfc_generate_function_code (gfc_namespace * ns) else result = sym->result->backend_decl; - if (result != NULL_TREE && sym->attr.function - && !sym->attr.pointer) + if (result != NULL_TREE + && sym->attr.function + && !sym->attr.pointer) { if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.alloc_comp) @@ -4413,8 +4416,10 @@ gfc_generate_function_code (gfc_namespace * ns) gfc_add_expr_to_block (&block, tmp); /* Reset recursion-check variable. */ - if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !is_recursive - && !gfc_option.flag_openmp) + if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) + && !is_recursive + && !gfc_option.flag_openmp + && recurcheckvar != NULL_TREE) { gfc_add_modify (&block, recurcheckvar, boolean_false_node); recurcheckvar = NULL; @@ -4445,12 +4450,14 @@ gfc_generate_function_code (gfc_namespace * ns) { gfc_add_expr_to_block (&block, tmp); /* Reset recursion-check variable. */ - if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !is_recursive - && !gfc_option.flag_openmp) - { - gfc_add_modify (&block, recurcheckvar, boolean_false_node); - recurcheckvar = NULL; - } + if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) + && !is_recursive + && !gfc_option.flag_openmp + && recurcheckvar != NULL_TREE) + { + gfc_add_modify (&block, recurcheckvar, boolean_false_node); + recurcheckvar = NULL_TREE; + } } -- cgit v1.2.1 From c1630d65d745a592779683d793933220559986d9 Mon Sep 17 00:00:00 2001 From: burnus Date: Wed, 10 Feb 2010 16:43:22 +0000 Subject: 2010-02-10 Tobias Burnus PR fortran/43015 * trans-decl.c (gfc_generate_function_code): Only check actual-vs.-dummy character bounds if not bind(C). 2010-02-10 Tobias Burnus PR fortran/43015 * gfortran.dg/bind_c_usage_20.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@156663 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 062310af6af..34e153ae77b 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1,5 +1,5 @@ /* Backend function setup - Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 + Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. Contributed by Paul Brook @@ -4367,7 +4367,7 @@ gfc_generate_function_code (gfc_namespace * ns) /* If bounds-checking is enabled, generate code to check passed in actual arguments against the expected dummy argument attributes (e.g. string lengths). */ - if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) + if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) && !sym->attr.is_bind_c) add_argument_checking (&body, sym); tmp = gfc_trans_code (ns->code); -- cgit v1.2.1 From 452695a8da676319b005b0fdfafc623139ea2f83 Mon Sep 17 00:00:00 2001 From: burnus Date: Wed, 17 Mar 2010 09:53:40 +0000 Subject: 2010-03-17 Tobias Burnus PR fortran/43331 * trans-array.c (gfc_conv_array_index_offset,gfc_conv_array_ref, gfc_conv_ss_startstride): Remove no-longer-needed cp_was_assumed check. * decl.c (gfc_match_derived_decl): Don't mark assumed-size Cray pointees as having explizit size. * expr.c (gfc_check_assign): Remove now unreachable Cray pointee check. * trans-types.c (gfc_is_nodesc_array): Add cp_was_assumed to * assert. (gfc_sym_type): Don't mark Cray pointees as restricted pointers. * resolve.c (resolve_symbol): Handle cp_was_assumed. * trans-decl.c (gfc_trans_deferred_vars): Ditto. (gfc_finish_var_decl): Don't mark Cray pointees as restricted pointers. 2010-03-17 Tobias Burnus PR fortran/43331 * gfortran.dg/cray_pointers_1.f90: Update dg-error message. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@157512 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 34e153ae77b..6f5f7796da8 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -598,6 +598,7 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) if (!sym->attr.target && !sym->attr.pointer + && !sym->attr.cray_pointee && !sym->attr.proc_pointer) DECL_RESTRICTED_P (decl) = 1; } @@ -3159,10 +3160,11 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) case AS_ASSUMED_SIZE: /* Must be a dummy parameter. */ - gcc_assert (sym->attr.dummy); + gcc_assert (sym->attr.dummy || sym->as->cp_was_assumed); /* We should always pass assumed size arrays the g77 way. */ - fnbody = gfc_trans_g77_array (sym, fnbody); + if (sym->attr.dummy) + fnbody = gfc_trans_g77_array (sym, fnbody); break; case AS_ASSUMED_SHAPE: -- cgit v1.2.1 From 9f1470cb512f9df42903dbb77aad2d3990dca6fc Mon Sep 17 00:00:00 2001 From: pault Date: Sat, 20 Mar 2010 16:01:17 +0000 Subject: 2010-03-20 Paul Thomas PR fortran/43450 * trans-decl.c (gfc_create_module_variable): With -fwhole-file do not assert the context of derived types. 2010-03-20 Paul Thomas PR fortran/43450 * gfortran.dg/whole_file_15.f90 : New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@157595 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 6f5f7796da8..3dc070cdc6b 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3382,11 +3382,16 @@ gfc_create_module_variable (gfc_symbol * sym) { decl = sym->backend_decl; gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE); - gcc_assert (TYPE_CONTEXT (decl) == NULL_TREE - || TYPE_CONTEXT (decl) == sym->ns->proc_name->backend_decl); - gcc_assert (DECL_CONTEXT (TYPE_STUB_DECL (decl)) == NULL_TREE - || DECL_CONTEXT (TYPE_STUB_DECL (decl)) - == sym->ns->proc_name->backend_decl); + + /* -fwhole-file mixes up the contexts so these asserts are unnecessary. */ + if (!(gfc_option.flag_whole_file && sym->attr.use_assoc)) + { + gcc_assert (TYPE_CONTEXT (decl) == NULL_TREE + || TYPE_CONTEXT (decl) == sym->ns->proc_name->backend_decl); + gcc_assert (DECL_CONTEXT (TYPE_STUB_DECL (decl)) == NULL_TREE + || DECL_CONTEXT (TYPE_STUB_DECL (decl)) + == sym->ns->proc_name->backend_decl); + } TYPE_CONTEXT (decl) = sym->ns->proc_name->backend_decl; DECL_CONTEXT (TYPE_STUB_DECL (decl)) = sym->ns->proc_name->backend_decl; gfc_module_add_decl (cur_module, TYPE_STUB_DECL (decl)); -- cgit v1.2.1 From a545a8f8abd6e1cd14a105138a3f34b986cab285 Mon Sep 17 00:00:00 2001 From: burnus Date: Tue, 6 Apr 2010 12:46:19 +0000 Subject: 2010-04-06 Tobias Burnus PR fortran/43178 * trans-array.c (gfc_conv_expr_descriptor): Update gfc_trans_scalar_assign call. (has_default_initializer): New function. (gfc_trans_deferred_array): Nullify less often. * trans-expr.c (gfc_conv_subref_array_arg, gfc_trans_subcomponent_assign): Update call to gfc_trans_scalar_assign. (gfc_trans_scalar_assign): Add parameter and pass it on. (gfc_trans_assignment_1): Optionally, do not dealloc before assignment. * trans-openmp.c (gfc_trans_omp_array_reduction): Update call to gfc_trans_scalar_assign. * trans-decl.c (gfc_get_symbol_decl): Do not always apply initializer to static variables. (gfc_init_default_dt): Add dealloc parameter and pass it on. * trans-stmt.c (forall_make_variable_temp, generate_loop_for_temp_to_lhs, generate_loop_for_rhs_to_temp, gfc_trans_forall_1, gfc_trans_where_assign, gfc_trans_where_3 gfc_trans_allocate): Update gfc_trans_assignment call. * trans.h (gfc_trans_scalar_assign, gfc_init_default_dt, gfc_init_default_dt, gfc_trans_assignment): Add bool dealloc parameter to prototype. 2010-04-06 Tobias Burnus PR fortran/43178 * gfortran.dg/alloc_comp_basics_1.f90: Update * scan-tree-dump-times. * gfortran.dg/alloc_comp_constructor_1.f90: Ditto. * gfortran.dg/auto_dealloc_1.f90: Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@157993 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 3dc070cdc6b..b2078640669 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1258,9 +1258,15 @@ gfc_get_symbol_decl (gfc_symbol * sym) if (sym->attr.assign) gfc_add_assign_aux_vars (sym); - if (TREE_STATIC (decl) && !sym->attr.use_assoc) + if (TREE_STATIC (decl) && !sym->attr.use_assoc + && (sym->attr.save || sym->ns->proc_name->attr.is_main_program + || gfc_option.flag_max_stack_var_size == 0 + || sym->attr.data || sym->ns->proc_name->attr.flavor == FL_MODULE)) { - /* Add static initializer. */ + /* Add static initializer. For procedures, it is only needed if + SAVE is specified otherwise they need to be reinitialized + every time the procedure is entered. The TREE_STATIC is + in this case due to -fmax-stack-var-size=. */ DECL_INITIAL (decl) = gfc_conv_initializer (sym->value, &sym->ts, TREE_TYPE (decl), sym->attr.dimension, sym->attr.pointer || sym->attr.allocatable); @@ -2981,9 +2987,10 @@ gfc_trans_vla_type_sizes (gfc_symbol *sym, stmtblock_t *body) /* Initialize a derived type by building an lvalue from the symbol - and using trans_assignment to do the work. */ + and using trans_assignment to do the work. Set dealloc to false + if no deallocation prior the assignment is needed. */ tree -gfc_init_default_dt (gfc_symbol * sym, tree body) +gfc_init_default_dt (gfc_symbol * sym, tree body, bool dealloc) { stmtblock_t fnblock; gfc_expr *e; @@ -2994,7 +3001,7 @@ gfc_init_default_dt (gfc_symbol * sym, tree body) gcc_assert (!sym->attr.allocatable); gfc_set_sym_referenced (sym); e = gfc_lval_expr_from_sym (sym); - tmp = gfc_trans_assignment (e, sym->value, false); + tmp = gfc_trans_assignment (e, sym->value, false, dealloc); if (sym->attr.dummy && (sym->attr.optional || sym->ns->proc_name->attr.entry_master)) { @@ -3045,7 +3052,7 @@ init_intent_out_dt (gfc_symbol * proc_sym, tree body) gfc_add_expr_to_block (&fnblock, tmp); } else if (f->sym->value) - body = gfc_init_default_dt (f->sym, body); + body = gfc_init_default_dt (f->sym, body, true); } gfc_add_expr_to_block (&fnblock, body); @@ -3148,7 +3155,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) && sym->value && !sym->attr.data && sym->attr.save == SAVE_NONE) - fnbody = gfc_init_default_dt (sym, fnbody); + fnbody = gfc_init_default_dt (sym, fnbody, false); gfc_get_backend_locus (&loc); gfc_set_backend_locus (&sym->declared_at); @@ -3246,7 +3253,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) && sym->value && !sym->attr.data && sym->attr.save == SAVE_NONE) - fnbody = gfc_init_default_dt (sym, fnbody); + fnbody = gfc_init_default_dt (sym, fnbody, false); else gcc_unreachable (); } -- 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/trans-decl.c | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index b2078640669..53c4b475add 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -85,6 +85,7 @@ tree gfor_fndecl_pause_numeric; tree gfor_fndecl_pause_string; tree gfor_fndecl_stop_numeric; tree gfor_fndecl_stop_string; +tree gfor_fndecl_error_stop_string; tree gfor_fndecl_runtime_error; tree gfor_fndecl_runtime_error_at; tree gfor_fndecl_runtime_warning_at; @@ -2725,6 +2726,13 @@ gfc_build_builtin_function_decls (void) /* Stop doesn't return. */ TREE_THIS_VOLATILE (gfor_fndecl_stop_string) = 1; + gfor_fndecl_error_stop_string = + gfc_build_library_function_decl (get_identifier (PREFIX("error_stop_string")), + void_type_node, 2, pchar_type_node, + gfc_int4_type_node); + /* ERROR STOP doesn't return. */ + TREE_THIS_VOLATILE (gfor_fndecl_error_stop_string) = 1; + gfor_fndecl_pause_numeric = gfc_build_library_function_decl (get_identifier (PREFIX("pause_numeric")), void_type_node, 1, gfc_int4_type_node); -- 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/trans-decl.c | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 53c4b475add..658aadb4087 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -38,6 +38,7 @@ along with GCC; see the file COPYING3. If not see #include "debug.h" #include "gfortran.h" #include "pointer-set.h" +#include "constructor.h" #include "trans.h" #include "trans-types.h" #include "trans-array.h" @@ -3578,7 +3579,8 @@ check_constant_initializer (gfc_expr *expr, gfc_typespec *ts, bool array, return check_constant_initializer (expr, ts, false, false); else if (expr->expr_type != EXPR_ARRAY) return false; - for (c = expr->value.constructor; c; c = c->next) + for (c = gfc_constructor_first (expr->value.constructor); + c; c = gfc_constructor_next (c)) { if (c->iterator) return false; @@ -3598,7 +3600,8 @@ check_constant_initializer (gfc_expr *expr, gfc_typespec *ts, bool array, if (expr->expr_type != EXPR_STRUCTURE) return false; cm = expr->ts.u.derived->components; - for (c = expr->value.constructor; c; c = c->next, cm = cm->next) + for (c = gfc_constructor_first (expr->value.constructor); + c; c = gfc_constructor_next (c), cm = cm->next) { if (!c->expr || cm->attr.allocatable) continue; -- cgit v1.2.1 From 3c8f1d7e570808ef93a234698c8a6f963b4b8b30 Mon Sep 17 00:00:00 2001 From: jakub Date: Thu, 15 Apr 2010 08:53:41 +0000 Subject: * trans-decl.c (gfc_build_qualified_array): Clear DECL_IGNORED_P on VAR_DECL LBOUND and/or UBOUND, even for -O1. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158366 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 658aadb4087..9e79a9adfab 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -775,16 +775,15 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym) GFC_TYPE_ARRAY_LBOUND (type, dim), GFC_TYPE_ARRAY_UBOUND (type, dim)); gtype = build_array_type (gtype, rtype); - /* Ensure the bound variables aren't optimized out at -O0. */ - if (!optimize) - { - if (GFC_TYPE_ARRAY_LBOUND (type, dim) - && TREE_CODE (GFC_TYPE_ARRAY_LBOUND (type, dim)) == VAR_DECL) - DECL_IGNORED_P (GFC_TYPE_ARRAY_LBOUND (type, dim)) = 0; - if (GFC_TYPE_ARRAY_UBOUND (type, dim) - && TREE_CODE (GFC_TYPE_ARRAY_UBOUND (type, dim)) == VAR_DECL) - DECL_IGNORED_P (GFC_TYPE_ARRAY_UBOUND (type, dim)) = 0; - } + /* Ensure the bound variables aren't optimized out at -O0. + For -O1 and above they often will be optimized out, but + can be tracked by VTA. */ + if (GFC_TYPE_ARRAY_LBOUND (type, dim) + && TREE_CODE (GFC_TYPE_ARRAY_LBOUND (type, dim)) == VAR_DECL) + DECL_IGNORED_P (GFC_TYPE_ARRAY_LBOUND (type, dim)) = 0; + if (GFC_TYPE_ARRAY_UBOUND (type, dim) + && TREE_CODE (GFC_TYPE_ARRAY_UBOUND (type, dim)) == VAR_DECL) + DECL_IGNORED_P (GFC_TYPE_ARRAY_UBOUND (type, dim)) = 0; } TYPE_NAME (type) = type_decl = build_decl (input_location, TYPE_DECL, NULL, gtype); -- cgit v1.2.1 From 7130ec9df4fcfe8a0c1f6d3a10cfb46770cc622d Mon Sep 17 00:00:00 2001 From: jakub Date: Fri, 16 Apr 2010 21:44:48 +0000 Subject: * trans-decl.c (gfc_build_qualified_array): Ensure ubound.N and lbound.N artificial variable names don't appear in debug info. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158451 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 35 +++++++++++++++++++++++++---------- 1 file changed, 25 insertions(+), 10 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 9e79a9adfab..2545ad2a320 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -771,19 +771,34 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym) for (dim = sym->as->rank - 1; dim >= 0; dim--) { - rtype = build_range_type (gfc_array_index_type, - GFC_TYPE_ARRAY_LBOUND (type, dim), - GFC_TYPE_ARRAY_UBOUND (type, dim)); + tree lbound, ubound; + lbound = GFC_TYPE_ARRAY_LBOUND (type, dim); + ubound = GFC_TYPE_ARRAY_UBOUND (type, dim); + rtype = build_range_type (gfc_array_index_type, lbound, ubound); gtype = build_array_type (gtype, rtype); /* Ensure the bound variables aren't optimized out at -O0. For -O1 and above they often will be optimized out, but - can be tracked by VTA. */ - if (GFC_TYPE_ARRAY_LBOUND (type, dim) - && TREE_CODE (GFC_TYPE_ARRAY_LBOUND (type, dim)) == VAR_DECL) - DECL_IGNORED_P (GFC_TYPE_ARRAY_LBOUND (type, dim)) = 0; - if (GFC_TYPE_ARRAY_UBOUND (type, dim) - && TREE_CODE (GFC_TYPE_ARRAY_UBOUND (type, dim)) == VAR_DECL) - DECL_IGNORED_P (GFC_TYPE_ARRAY_UBOUND (type, dim)) = 0; + can be tracked by VTA. Also clear the artificial + lbound.N or ubound.N DECL_NAME, so that it doesn't end up + in debug info. */ + if (lbound && TREE_CODE (lbound) == VAR_DECL + && DECL_ARTIFICIAL (lbound) && DECL_IGNORED_P (lbound)) + { + if (DECL_NAME (lbound) + && strstr (IDENTIFIER_POINTER (DECL_NAME (lbound)), + "lbound") != 0) + DECL_NAME (lbound) = NULL_TREE; + DECL_IGNORED_P (lbound) = 0; + } + if (ubound && TREE_CODE (ubound) == VAR_DECL + && DECL_ARTIFICIAL (ubound) && DECL_IGNORED_P (ubound)) + { + if (DECL_NAME (ubound) + && strstr (IDENTIFIER_POINTER (DECL_NAME (ubound)), + "ubound") != 0) + DECL_NAME (ubound) = NULL_TREE; + DECL_IGNORED_P (ubound) = 0; + } } TYPE_NAME (type) = type_decl = build_decl (input_location, TYPE_DECL, NULL, gtype); -- cgit v1.2.1 From cf4b41d8941566369379a8bcf992411b11748fbb Mon Sep 17 00:00:00 2001 From: pault Date: Tue, 20 Apr 2010 19:07:14 +0000 Subject: 2010-04-20 Paul Thomas PR fortran/43227 * resolve.c (resolve_fl_derived): If a component character length has not been resolved, do so now. (resolve_symbol): The same as above for a symbol character length. * trans-decl.c (gfc_create_module_variable): A 'length' decl is not needed for a character valued, procedure pointer. PR fortran/43266 * resolve.c (ensure_not_abstract_walker): If 'overriding' is not found, return FAILURE rather than ICEing. 2010-04-20 Paul Thomas PR fortran/43227 * gfortran.dg/proc_decl_23.f90: New test. PR fortran/43266 * gfortran.dg/abstract_type_6.f03: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158570 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 2545ad2a320..11a75b46033 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3477,7 +3477,8 @@ gfc_create_module_variable (gfc_symbol * sym) tree length; length = sym->ts.u.cl->backend_decl; - if (!INTEGER_CST_P (length)) + gcc_assert (length || sym->attr.proc_pointer); + if (length && !INTEGER_CST_P (length)) { pushdecl (length); rest_of_decl_compilation (length, 1, 0); -- 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/trans-decl.c | 9 +++++++++ 1 file changed, 9 insertions(+) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 11a75b46033..2ad4e737259 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1070,6 +1070,15 @@ gfc_get_symbol_decl (gfc_symbol * sym) else byref = 0; + /* Make sure that the vtab for the declared type is completed. */ + if (sym->ts.type == BT_CLASS) + { + gfc_component *c = gfc_find_component (sym->ts.u.derived, + "$data", true, true); + if (!c->ts.u.derived->backend_decl) + gfc_find_derived_vtab (c->ts.u.derived, true); + } + if ((sym->attr.dummy && ! sym->attr.function) || (sym->attr.result && byref)) { /* Return via extra parameter. */ -- cgit v1.2.1 From 8ce860079ffd104495b86756bd5c7729e69ff06f Mon Sep 17 00:00:00 2001 From: rguenth Date: Mon, 10 May 2010 09:43:17 +0000 Subject: 2010-05-10 Richard Guenther * c-common.c (struct c_common_attributes): Add fnspec attribute. (handle_fnspec_attribute): New function. * gimple.h (gimple_call_return_flags): Declare. (gimple_call_arg_flags): Likewise. * gimple.c (gimple_call_arg_flags): New function. (gimple_call_return_flags): Likewise. * tree.h (EAF_DIRECT, EAF_NOCLOBBER, EAF_NOESCAPE, EAF_UNUSED): New argument flags. (ERF_RETURN_ARG_MASK, ERF_RETURNS_ARG, ERF_NOALIAS): New function return value flags. * tree-ssa-alias.c (ref_maybe_used_by_call_p_1): Skip unused args. * tree-ssa-structalias.c (make_constraint_from_heapvar): Split main work to ... (make_heapvar_for): ... this new function. (handle_rhs_call): Handle fnspec attribute argument specifiers. (handle_lhs_call): Likewise. (find_func_aliases): Adjust. fortran/ * trans-decl.c (gfc_build_library_function_decl): Split out worker to ... (build_library_function_decl_1): ... this new function. Set a fnspec attribute if a specification was provided. (gfc_build_library_function_decl_with_spec): New function. (gfc_build_intrinsic_function_decls): Annotate internal_pack and internal_unpack. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159215 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 58 ++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 46 insertions(+), 12 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 2ad4e737259..64d87caa073 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2317,22 +2317,19 @@ gfc_get_fake_result_decl (gfc_symbol * sym, int parent_flag) /* Builds a function decl. The remaining parameters are the types of the function arguments. Negative nargs indicates a varargs function. */ -tree -gfc_build_library_function_decl (tree name, tree rettype, int nargs, ...) +static tree +build_library_function_decl_1 (tree name, const char *spec, + tree rettype, int nargs, va_list p) { tree arglist; tree argtype; tree fntype; tree fndecl; - va_list p; int n; /* Library functions must be declared with global scope. */ gcc_assert (current_function_decl == NULL_TREE); - va_start (p, nargs); - - /* Create a list of the argument types. */ for (arglist = NULL_TREE, n = abs (nargs); n > 0; n--) { @@ -2348,6 +2345,14 @@ gfc_build_library_function_decl (tree name, tree rettype, int nargs, ...) /* Build the function type and decl. */ fntype = build_function_type (rettype, arglist); + if (spec) + { + tree attr_args = build_tree_list (NULL_TREE, + build_string (strlen (spec), spec)); + tree attrs = tree_cons (get_identifier ("fn spec"), + attr_args, TYPE_ATTRIBUTES (fntype)); + fntype = build_type_attribute_variant (fntype, attrs); + } fndecl = build_decl (input_location, FUNCTION_DECL, name, fntype); @@ -2355,8 +2360,6 @@ gfc_build_library_function_decl (tree name, tree rettype, int nargs, ...) DECL_EXTERNAL (fndecl) = 1; TREE_PUBLIC (fndecl) = 1; - va_end (p); - pushdecl (fndecl); rest_of_decl_compilation (fndecl, 1, 0); @@ -2364,6 +2367,37 @@ gfc_build_library_function_decl (tree name, tree rettype, int nargs, ...) return fndecl; } +/* Builds a function decl. The remaining parameters are the types of the + function arguments. Negative nargs indicates a varargs function. */ + +tree +gfc_build_library_function_decl (tree name, tree rettype, int nargs, ...) +{ + tree ret; + va_list args; + va_start (args, nargs); + ret = build_library_function_decl_1 (name, NULL, rettype, nargs, args); + va_end (args); + return ret; +} + +/* Builds a function decl. The remaining parameters are the types of the + function arguments. Negative nargs indicates a varargs function. + The SPEC parameter specifies the function argument and return type + specification according to the fnspec function type attribute. */ + +static tree +gfc_build_library_function_decl_with_spec (tree name, const char *spec, + tree rettype, int nargs, ...) +{ + tree ret; + va_list args; + va_start (args, nargs); + ret = build_library_function_decl_1 (name, spec, rettype, nargs, args); + va_end (args); + return ret; +} + static void gfc_build_intrinsic_function_decls (void) { @@ -2821,12 +2855,12 @@ gfc_build_builtin_function_decls (void) gfc_build_library_function_decl (get_identifier (PREFIX("set_max_subrecord_length")), void_type_node, 1, integer_type_node); - gfor_fndecl_in_pack = gfc_build_library_function_decl ( - get_identifier (PREFIX("internal_pack")), + gfor_fndecl_in_pack = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("internal_pack")), ".r", pvoid_type_node, 1, pvoid_type_node); - gfor_fndecl_in_unpack = gfc_build_library_function_decl ( - get_identifier (PREFIX("internal_unpack")), + gfor_fndecl_in_unpack = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("internal_unpack")), ".wR", void_type_node, 2, pvoid_type_node, pvoid_type_node); gfor_fndecl_associated = -- cgit v1.2.1 From 1e71b3148ebeba9ec268faca94fd38ba6827e988 Mon Sep 17 00:00:00 2001 From: jakub Date: Fri, 14 May 2010 07:40:06 +0000 Subject: * trans.c (trans_code): Set backend locus early. * trans-decl.c (gfc_get_fake_result_decl): Use source location of the function instead of current input_location. * gfortran.dg/gomp/pr44036-1.f90: Adjust. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159388 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 64d87caa073..4f0256ae87b 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2283,11 +2283,11 @@ gfc_get_fake_result_decl (gfc_symbol * sym, int parent_flag) IDENTIFIER_POINTER (DECL_NAME (this_function_decl))); if (!sym->attr.mixed_entry_master && sym->attr.function) - decl = build_decl (input_location, + decl = build_decl (DECL_SOURCE_LOCATION (this_function_decl), VAR_DECL, get_identifier (name), gfc_sym_type (sym)); else - decl = build_decl (input_location, + decl = build_decl (DECL_SOURCE_LOCATION (this_function_decl), VAR_DECL, get_identifier (name), TREE_TYPE (TREE_TYPE (this_function_decl))); DECL_ARTIFICIAL (decl) = 1; -- cgit v1.2.1 From fabc1fc908262e3106beb0c472fa4da03b792680 Mon Sep 17 00:00:00 2001 From: janus Date: Sat, 15 May 2010 22:03:09 +0000 Subject: 2010-05-15 Janus Weil PR fortran/44154 PR fortran/42647 * trans-decl.c (gfc_trans_deferred_vars): Modify ordering of if branches. 2010-05-15 Janus Weil PR fortran/44154 PR fortran/42647 * gfortran.dg/allocatable_scalar_9.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159445 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 4f0256ae87b..56c88bc69f8 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3259,8 +3259,6 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) if (sym_has_alloc_comp && !seen_trans_deferred_array) fnbody = gfc_trans_deferred_array (sym, fnbody); } - else if (sym_has_alloc_comp) - fnbody = gfc_trans_deferred_array (sym, fnbody); else if (sym->attr.allocatable || (sym->ts.type == BT_CLASS && sym->ts.u.derived->components->attr.allocatable)) @@ -3298,6 +3296,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) fnbody = gfc_finish_block (&block); } } + else if (sym_has_alloc_comp) + fnbody = gfc_trans_deferred_array (sym, fnbody); else if (sym->ts.type == BT_CHARACTER) { gfc_get_backend_locus (&loc); -- cgit v1.2.1 From 4bdd2942b4a54fdd15e155ceb4520e591eb34078 Mon Sep 17 00:00:00 2001 From: rguenth Date: Sun, 16 May 2010 14:47:38 +0000 Subject: 2010-05-16 Richard Guenther * lto-symtab.c (lto_symtab_entry_hash): Use IDENTIFIER_HASH_VALUE. * optabs.c (libfunc_decl_hash): Likewise. * varasm.c (emutls_decl): Likewise. fortran/ * trans-decl.c (module_htab_decls_hash): Use IDENTIFIER_HASH_VALUE. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159455 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 56c88bc69f8..3216f68b59d 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3374,7 +3374,7 @@ module_htab_decls_hash (const void *x) const_tree n = DECL_NAME (t); if (n == NULL_TREE) n = TYPE_NAME (TREE_TYPE (t)); - return htab_hash_string (IDENTIFIER_POINTER (n)); + return IDENTIFIER_HASH_VALUE (n); } static int -- cgit v1.2.1 From 8f1e8e0eecae09729d72f118b6f58cda1d8d0813 Mon Sep 17 00:00:00 2001 From: rguenth Date: Sun, 16 May 2010 17:27:09 +0000 Subject: 2010-05-16 Richard Guenther * trans-decl.c (module_htab_decls_hash): Revert last change. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159462 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 3216f68b59d..56c88bc69f8 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3374,7 +3374,7 @@ module_htab_decls_hash (const void *x) const_tree n = DECL_NAME (t); if (n == NULL_TREE) n = TYPE_NAME (TREE_TYPE (t)); - return IDENTIFIER_HASH_VALUE (n); + return htab_hash_string (IDENTIFIER_POINTER (n)); } static int -- cgit v1.2.1 From 06f13dc11eae7a9ff64a9412af722a4945f30482 Mon Sep 17 00:00:00 2001 From: froydnj Date: Mon, 17 May 2010 16:03:46 +0000 Subject: * trans-array.c (gfc_trans_array_constructor_value): Use build_constructor instead of build_constructor_from_list. (gfc_build_constant_array_constructor): Likewise. * trans-decl.c (create_main_function): Likewise. * trans-stmt.c (gfc_trans_character_select): Likewise. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159490 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 45 ++++++++++++++++++++++++++------------------- 1 file changed, 26 insertions(+), 19 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 56c88bc69f8..7facc8dd192 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -4196,6 +4196,7 @@ create_main_function (tree fndecl) language standard parameters. */ { tree array_type, array, var; + VEC(constructor_elt,gc) *v = NULL; /* Passing a new option to the library requires four modifications: + add it to the tree_cons list below @@ -4204,28 +4205,34 @@ create_main_function (tree fndecl) gfor_fndecl_set_options + modify the library (runtime/compile_options.c)! */ - array = tree_cons (NULL_TREE, build_int_cst (integer_type_node, - gfc_option.warn_std), NULL_TREE); - array = tree_cons (NULL_TREE, build_int_cst (integer_type_node, - gfc_option.allow_std), array); - array = tree_cons (NULL_TREE, build_int_cst (integer_type_node, pedantic), - array); - array = tree_cons (NULL_TREE, build_int_cst (integer_type_node, - gfc_option.flag_dump_core), array); - array = tree_cons (NULL_TREE, build_int_cst (integer_type_node, - gfc_option.flag_backtrace), array); - array = tree_cons (NULL_TREE, build_int_cst (integer_type_node, - gfc_option.flag_sign_zero), array); - - array = tree_cons (NULL_TREE, build_int_cst (integer_type_node, - (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)), array); - - array = tree_cons (NULL_TREE, build_int_cst (integer_type_node, - gfc_option.flag_range_check), array); + CONSTRUCTOR_APPEND_ELT (v, NULL_TREE, + build_int_cst (integer_type_node, + gfc_option.warn_std)); + CONSTRUCTOR_APPEND_ELT (v, NULL_TREE, + build_int_cst (integer_type_node, + gfc_option.allow_std)); + CONSTRUCTOR_APPEND_ELT (v, NULL_TREE, + build_int_cst (integer_type_node, pedantic)); + CONSTRUCTOR_APPEND_ELT (v, NULL_TREE, + build_int_cst (integer_type_node, + gfc_option.flag_dump_core)); + CONSTRUCTOR_APPEND_ELT (v, NULL_TREE, + build_int_cst (integer_type_node, + gfc_option.flag_backtrace)); + CONSTRUCTOR_APPEND_ELT (v, NULL_TREE, + build_int_cst (integer_type_node, + gfc_option.flag_sign_zero)); + CONSTRUCTOR_APPEND_ELT (v, NULL_TREE, + build_int_cst (integer_type_node, + (gfc_option.rtcheck + & GFC_RTCHECK_BOUNDS))); + CONSTRUCTOR_APPEND_ELT (v, NULL_TREE, + build_int_cst (integer_type_node, + gfc_option.flag_range_check)); array_type = build_array_type (integer_type_node, build_index_type (build_int_cst (NULL_TREE, 7))); - array = build_constructor_from_list (array_type, nreverse (array)); + array = build_constructor (array_type, v); TREE_CONSTANT (array) = 1; TREE_STATIC (array) = 1; -- cgit v1.2.1 From e1036019ffb87690c22208ec7bab1f17c23e9c65 Mon Sep 17 00:00:00 2001 From: froydnj Date: Mon, 17 May 2010 16:09:35 +0000 Subject: gcc/ * tree.c (build_function_type_list_1): Remove bogus assert condition. gcc/fortran/ * trans-types.c (gfc_init_types): Use build_function_type_list. (gfc_get_ppc_type): Likewise. * trans-decl.c (gfc_generate_constructors): Likewise. * f95-lang.c (build_builtin_fntypes): Likewise. (gfc_init_builtin_functions): Likewise. (DEF_FUNCTION_TYPE_0): Likewise. (DEF_FUNCTION_TYPE_1): Likewise. (DEF_FUNCTION_TYPE_2): Likewise. (DEF_FUNCTION_TYPE_3): Likewise. (DEF_FUNCTION_TYPE_4): Likewise. (DEF_FUNCTION_TYPE_5): Likewise. (DEF_FUNCTION_TYPE_6): Likewise. (DEF_FUNCTION_TYPE_7): Likewise. Use ARG7. (DEF_FUNCTION_TYPE_VAR_0): Use build_varags_function_type_list. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159491 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 7facc8dd192..e24390bbb8d 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -4633,8 +4633,7 @@ gfc_generate_constructors (void) return; fnname = get_file_function_name ("I"); - type = build_function_type (void_type_node, - gfc_chainon_list (NULL_TREE, void_type_node)); + type = build_function_type_list (void_type_node, NULL_TREE); fndecl = build_decl (input_location, FUNCTION_DECL, fnname, type); -- cgit v1.2.1 From 0826251092361171d72575cd36d4578e22cf9e9e Mon Sep 17 00:00:00 2001 From: dfranke Date: Wed, 19 May 2010 13:07:25 +0000 Subject: gcc/fortran/: 2010-05-19 Daniel Franke PR fortran/42360 * gfortran.h (gfc_has_default_initializer): New. * expr.c (gfc_has_default_initializer): New. * resolve.c (has_default_initializer): Removed, use gfc_has_default_initializer() instead. Updated all callers. * trans-array.c (has_default_initializer): Removed, use gfc_has_default_initializer() instead. Updated all callers. * trans-decl.c (generate_local_decl): Do not check the first component only to check for initializers, but use gfc_has_default_initializer() instead. gcc/testsuite/: 2010-05-19 Daniel Franke PR fortran/42360 * gfortran.dg/warn_intent_out_not_set.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159562 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index e24390bbb8d..c523a5c575c 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3872,10 +3872,14 @@ generate_local_decl (gfc_symbol * sym) && sym->attr.dummy && sym->attr.intent == INTENT_OUT) { - if (!(sym->ts.type == BT_DERIVED - && sym->ts.u.derived->components->initializer)) + if (sym->ts.type != BT_DERIVED) gfc_warning ("Dummy argument '%s' at %L was declared INTENT(OUT) " "but was not set", sym->name, &sym->declared_at); + else if (!gfc_has_default_initializer (sym->ts.u.derived)) + gfc_warning ("Derived-type dummy argument '%s' at %L was " + "declared INTENT(OUT) but was not set and does " + "not have a default initializer", + sym->name, &sym->declared_at); } /* Specific warning for unused dummy arguments. */ else if (warn_unused_variable && sym->attr.dummy) -- cgit v1.2.1 From 070cc7908ad9a33d66643c48beba23f9cb8e6b63 Mon Sep 17 00:00:00 2001 From: jvdelisle Date: Thu, 20 May 2010 04:44:11 +0000 Subject: 2010-05-19 Jerry DeLisle PR fortran/43851 * runtime/stop.c (error_stop_numeric): New function and updated comment. Add declaration for stop_numeric and remove declaration for stop_string. (stop_string): Use for blank STOP. (stop_numeric): Remove use of special -1 stop code. * runtime/pause.c (do_pause): Use stop_string for blank stop. (pause_numeric): Remove use of special -1 pause code. * gfortran.map: Add new symbol to run-time library. * libgfortran.h: Move declaration for stop_string to here to make function visible for do_pause. Remove declaration for stop_numeric. 2010-05-19 Jerry DeLisle PR fortran/43851 * trans-stmt.c (gfc_trans_stop): Add generation of call to gfortran_error_stop_numeric. Fix up some whitespace. Use stop_string for blank STOP, handling a null expression. (gfc_trans_pause): Use pause_string for blank PAUSE. * trans.h: Add external function declaration for error_stop_numeric. * trans-decl.c (gfc_build_builtin_function_decls): Add the building of the declaration for the library call. Adjust whitespaces. * match.c (gfc_match_stopcode): Remove use of the actual stop code to signal no stop code. Match the expression following the stop and pass that to the translators. Remove the old use of digit matching. Add checks that the stop_code expression is INTEGER or CHARACTER, constant, and if CHARACTER, default character KIND. 2010-05-19 Jerry DeLisle PR fortran/43851 * gfortran.dg/label_1.f90: Update test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159609 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index c523a5c575c..fa826799c55 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -86,6 +86,7 @@ tree gfor_fndecl_pause_numeric; tree gfor_fndecl_pause_string; tree gfor_fndecl_stop_numeric; tree gfor_fndecl_stop_string; +tree gfor_fndecl_error_stop_numeric; tree gfor_fndecl_error_stop_string; tree gfor_fndecl_runtime_error; tree gfor_fndecl_runtime_error_at; @@ -2774,23 +2775,33 @@ gfc_build_builtin_function_decls (void) gfor_fndecl_stop_numeric = gfc_build_library_function_decl (get_identifier (PREFIX("stop_numeric")), void_type_node, 1, gfc_int4_type_node); - /* Stop doesn't return. */ + /* STOP doesn't return. */ TREE_THIS_VOLATILE (gfor_fndecl_stop_numeric) = 1; + gfor_fndecl_stop_string = gfc_build_library_function_decl (get_identifier (PREFIX("stop_string")), void_type_node, 2, pchar_type_node, - gfc_int4_type_node); - /* Stop doesn't return. */ + gfc_int4_type_node); + /* STOP doesn't return. */ TREE_THIS_VOLATILE (gfor_fndecl_stop_string) = 1; + + gfor_fndecl_error_stop_numeric = + gfc_build_library_function_decl (get_identifier (PREFIX("error_stop_numeric")), + void_type_node, 1, gfc_int4_type_node); + /* ERROR STOP doesn't return. */ + TREE_THIS_VOLATILE (gfor_fndecl_error_stop_numeric) = 1; + + gfor_fndecl_error_stop_string = gfc_build_library_function_decl (get_identifier (PREFIX("error_stop_string")), void_type_node, 2, pchar_type_node, - gfc_int4_type_node); + gfc_int4_type_node); /* ERROR STOP doesn't return. */ TREE_THIS_VOLATILE (gfor_fndecl_error_stop_string) = 1; + gfor_fndecl_pause_numeric = gfc_build_library_function_decl (get_identifier (PREFIX("pause_numeric")), void_type_node, 1, gfc_int4_type_node); @@ -2798,7 +2809,7 @@ gfc_build_builtin_function_decls (void) gfor_fndecl_pause_string = gfc_build_library_function_decl (get_identifier (PREFIX("pause_string")), void_type_node, 2, pchar_type_node, - gfc_int4_type_node); + gfc_int4_type_node); gfor_fndecl_runtime_error = gfc_build_library_function_decl (get_identifier (PREFIX("runtime_error")), -- cgit v1.2.1 From 989adef3b44d84f7b46c259ba46911460de87c51 Mon Sep 17 00:00:00 2001 From: steven Date: Thu, 20 May 2010 20:57:45 +0000 Subject: * trans-expr.c: Do not include convert.h, ggc.h, real.h, and gimple.h. (gfc_conv_string_tmp): Do not assert type comparibilty. * trans-array.c: Do not include gimple.h, ggc.h, and real.h. (gfc_conv_expr_descriptor): Remove assert. * trans-common.c: Clarify why rtl.h and tm.h are included. * trans-openmp.c: Do not include ggc.h and real.h. Explain why gimple.h is included. * trans-const.c: Do not include ggc.h. * trans-stmt.c: Do not include gimple.h, ggc.h, and real.h. * trans.c: Do not include ggc.h and real.h. Explain why gimple.h is included. * trans-types.c: Do not include tm.h. Explain why langhooks.h and dwarf2out.h are included. * trans-io.c: Do not include gimple.h and real.h. * trans-decl.c: Explain why gimple.h, tm.h, and rtl.h are included. * trans-intrinsic.c: Do not include gimple.h. Explain why tm.h is included. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159640 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index fa826799c55..5afc5f46c5a 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -26,11 +26,11 @@ along with GCC; see the file COPYING3. If not see #include "coretypes.h" #include "tree.h" #include "tree-dump.h" -#include "gimple.h" +#include "gimple.h" /* For create_tmp_var_raw. */ #include "ggc.h" #include "toplev.h" -#include "tm.h" -#include "rtl.h" +#include "tm.h" /* For rtl.h. */ +#include "rtl.h" /* For decl_default_tls_model. */ #include "target.h" #include "function.h" #include "flags.h" -- cgit v1.2.1 From 4acad347aaba2c76346dfd1de7f34fb2056a15e2 Mon Sep 17 00:00:00 2001 From: dfranke Date: Thu, 20 May 2010 21:49:07 +0000 Subject: gcc/fortran/: 2010-05-20 Daniel Franke PR fortran/38407 * lang.opt (Wunused-dummy-argument): New option. * gfortran.h (gfc_option_t): Add warn_unused_dummy_argument. * options.c (gfc_init_options): Disable warn_unused_dummy_argument. (set_Wall): Enable warn_unused_dummy_argument. (gfc_handle_option): Set warn_unused_dummy_argument according to command line. * trans-decl.c (generate_local_decl): Separate warnings about unused variables and unused dummy arguments. * invoke.texi: Documented new option. gcc/testsuite/: 2010-05-20 Daniel Franke PR fortran/38407 * warn_unused_dummy_argument_1.f90: New. * warn_unused_dummy_argument_2.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159641 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 37 +++++++++++++++++++++---------------- 1 file changed, 21 insertions(+), 16 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 5afc5f46c5a..5bafdcc32cc 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3878,24 +3878,29 @@ generate_local_decl (gfc_symbol * sym) if (sym->attr.referenced) gfc_get_symbol_decl (sym); - /* INTENT(out) dummy arguments are likely meant to be set. */ - else if (warn_unused_variable - && sym->attr.dummy - && sym->attr.intent == INTENT_OUT) + + /* Warnings for unused dummy arguments. */ + else if (sym->attr.dummy) { - if (sym->ts.type != BT_DERIVED) - gfc_warning ("Dummy argument '%s' at %L was declared INTENT(OUT) " - "but was not set", sym->name, &sym->declared_at); - else if (!gfc_has_default_initializer (sym->ts.u.derived)) - gfc_warning ("Derived-type dummy argument '%s' at %L was " - "declared INTENT(OUT) but was not set and does " - "not have a default initializer", - sym->name, &sym->declared_at); + /* INTENT(out) dummy arguments are likely meant to be set. */ + if (gfc_option.warn_unused_dummy_argument + && sym->attr.intent == INTENT_OUT) + { + if (sym->ts.type != BT_DERIVED) + gfc_warning ("Dummy argument '%s' at %L was declared " + "INTENT(OUT) but was not set", sym->name, + &sym->declared_at); + else if (!gfc_has_default_initializer (sym->ts.u.derived)) + gfc_warning ("Derived-type dummy argument '%s' at %L was " + "declared INTENT(OUT) but was not set and " + "does not have a default initializer", + sym->name, &sym->declared_at); + } + else if (gfc_option.warn_unused_dummy_argument) + gfc_warning ("Unused dummy argument '%s' at %L", sym->name, + &sym->declared_at); } - /* Specific warning for unused dummy arguments. */ - else if (warn_unused_variable && sym->attr.dummy) - gfc_warning ("Unused dummy argument '%s' at %L", sym->name, - &sym->declared_at); + /* Warn for unused variables, but not if they're inside a common block or are use-associated. */ else if (warn_unused_variable -- 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/trans-decl.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 5bafdcc32cc..2eabfccd095 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -28,7 +28,7 @@ along with GCC; see the file COPYING3. If not see #include "tree-dump.h" #include "gimple.h" /* For create_tmp_var_raw. */ #include "ggc.h" -#include "toplev.h" +#include "toplev.h" /* For announce_function/internal_error. */ #include "tm.h" /* For rtl.h. */ #include "rtl.h" /* For decl_default_tls_model. */ #include "target.h" -- cgit v1.2.1 From cb4070e00ced433c22465def62435fa9eee5a16e Mon Sep 17 00:00:00 2001 From: steven Date: Wed, 26 May 2010 08:36:49 +0000 Subject: gcc/ChangeLog: * rtl.h (decl_default_tls_model): Move prototype from here... * output.h: ...to here. * c-decl.c: Do not include rtl.h. * c-pragma.c: Likewise. * c-parser.c: Likewise. * c-gimplify.c: Likewise. And also not hard-reg-set. * c-common.c: Do not include rtl.h. Include tm_p.h and add a FIXME note for it. Add a FIXME note for expr.h. * config/i386/i386-protos.h (ix86_enum_va_list, ix86_fn_abi_va_list, ix86_canonical_va_list_type): Make visible even if RTX_CODE is not defined. cp/ChangeLog: * decl.c: Do not include rtl.h * semantics.c: Likewise. ada/ChangeLog: * gcc-interface/utils.c: Do not include rtl.h. fortran/ChangeLog: * trans-common.c: Do not include rtl.h, include output.h instead. * trans-decl.c: Likewise. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159856 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 2eabfccd095..a6029770810 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -24,13 +24,13 @@ along with GCC; see the file COPYING3. If not see #include "config.h" #include "system.h" #include "coretypes.h" +#include "tm.h" #include "tree.h" #include "tree-dump.h" #include "gimple.h" /* For create_tmp_var_raw. */ #include "ggc.h" #include "toplev.h" /* For announce_function/internal_error. */ -#include "tm.h" /* For rtl.h. */ -#include "rtl.h" /* For decl_default_tls_model. */ +#include "output.h" /* For decl_default_tls_model. */ #include "target.h" #include "function.h" #include "flags.h" -- 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/trans-decl.c | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index a6029770810..224474aeff2 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1074,8 +1074,7 @@ gfc_get_symbol_decl (gfc_symbol * sym) /* Make sure that the vtab for the declared type is completed. */ if (sym->ts.type == BT_CLASS) { - gfc_component *c = gfc_find_component (sym->ts.u.derived, - "$data", true, true); + gfc_component *c = CLASS_DATA (sym); if (!c->ts.u.derived->backend_decl) gfc_find_derived_vtab (c->ts.u.derived, true); } @@ -1221,8 +1220,8 @@ gfc_get_symbol_decl (gfc_symbol * sym) /* Remember this variable for allocation/cleanup. */ if (sym->attr.dimension || sym->attr.allocatable || (sym->ts.type == BT_CLASS && - (sym->ts.u.derived->components->attr.dimension - || sym->ts.u.derived->components->attr.allocatable)) + (CLASS_DATA (sym)->attr.dimension + || CLASS_DATA (sym)->attr.allocatable)) || (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.alloc_comp) /* This applies a derived type default initializer. */ || (sym->ts.type == BT_DERIVED @@ -3272,7 +3271,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) } else if (sym->attr.allocatable || (sym->ts.type == BT_CLASS - && sym->ts.u.derived->components->attr.allocatable)) + && CLASS_DATA (sym)->attr.allocatable)) { if (!sym->attr.save) { -- cgit v1.2.1 From ba72912a012b97cad825eebee3f5f22253d0afe4 Mon Sep 17 00:00:00 2001 From: lauras Date: Tue, 8 Jun 2010 07:25:24 +0000 Subject: gcc/ada: 2010-06-08 Laurynas Biveinis * gcc-interface/utils.c (init_gnat_to_gnu): Use typed GC allocation. (init_dummy_type): Likewise. (gnat_pushlevel): Likewise. * gcc-interface/trans.c (Attribute_to_gnu): Likewise. (Subprogram_Body_to_gnu): Likewise. (Compilation_Unit_to_gnu): Likewise. (start_stmt_group): Likewise. (extract_encoding): Likewise. (decode_name): Likewise. * gcc-interface/misc.c (gnat_printable_name): Likewise. * gcc-interface/decl.c (annotate_value): Likewise. * gcc-interface/ada-tree.h (struct lang_type): Add variable_size GTY option. (struct lang_decl): Likewise. (SET_TYPE_LANG_SPECIFIC): Use typed GC allocation. (SET_DECL_LANG_SPECIFIC): Likewise. gcc/c-family: 2010-06-08 Laurynas Biveinis * c-pragma.c (push_alignment): Use typed GC allocation. (handle_pragma_push_options): Likewise. * c-common.c (parse_optimize_options): Likewise. * c-common.h (struct sorted_fields_type): Add variable_size GTY option. gcc/cp: 2010-06-08 Laurynas Biveinis * typeck2.c (abstract_virtuals_error): Likewise. * pt.c (maybe_process_partial_specialization): Likewise. (register_specialization): Likewise. (add_pending_template): Likewise. (lookup_template_class): Likewise. (push_tinst_level): Likewise. * parser.c (cp_lexer_new_main): Likewise. (cp_lexer_new_from_tokens): Likewise. (cp_token_cache_new): Likewise. (cp_parser_context_new): Likewise. (cp_parser_new): Likewise. (cp_parser_nested_name_specifier_opt): Likewise. (cp_parser_template_id): Likewise. * name-lookup.c (binding_entry_make): Likewise. (binding_table_construct): Likewise. (binding_table_new): Likewise. (cxx_binding_make): Likewise. (pushdecl_maybe_friend): Likewise. (begin_scope): Likewise. (push_to_top_level): Likewise. * lex.c (init_reswords): Likewise. (retrofit_lang_decl): Likewise. (cxx_dup_lang_specific_decl): Likewise. (copy_lang_type): Likewise. (cxx_make_type): Likewise. * decl.c (make_label_decl): Likewise. (check_goto): Likewise. (start_preparsed_function): Likewise. (save_function_data): Likewise. * cp-tree.h (TYPE_SET_PTRMEMFUNC_TYPE): Likewise. * cp-objcp-common.c (decl_shadowed_for_var_insert): Likewise. * class.c (finish_struct_1): Likewise. * cp-tree.h (struct lang_type): Add variable_size GTY option. (struct lang_decl): Likewise. * parser.c (cp_parser_new): Update comment to not reference ggc_alloc. gcc/fortran: 2010-06-08 Laurynas Biveinis * trans-types.c (gfc_get_nodesc_array_type): Use typed GC allocation. (gfc_get_array_type_bounds): Likewise. * trans-decl.c (gfc_allocate_lang_decl): Likewise. (gfc_find_module): Likewise. * f95-lang.c (pushlevel): Likewise. * trans.h (struct lang_type): Add variable_size GTY option. (struct lang_decl): Likewise. gcc/java: 2010-06-08 Laurynas Biveinis * jcf-reader.c (jcf_parse_constant_pool): Use typed GC allocation. * jcf-parse.c (java_parse_file): Likewise. (process_zip_dir): Likewise. * java-tree.h (MAYBE_CREATE_VAR_LANG_DECL_SPECIFIC): Likewise. (MAYBE_CREATE_TYPE_TYPE_LANG_SPECIFIC): Likewise. * expr.c (add_type_assertion): Likewise. * decl.c (make_binding_level): Likewise. (java_dup_lang_specific_decl): Likewise. * constants.c (set_constant_entry): Likewise. (cpool_for_class): Likewise. * class.c (add_method_1): Likewise. (java_treetreehash_new): Likewise. * java-tree.h (struct lang_type): Add variable_size GTY option. (struct lang_decl): Likewise. * jch.h (struct cpool_entry): Likewise. * java-tree.h (java_treetreehash_create): Remove parameter ggc. * except.c (prepare_eh_table_type): Update java_treetreehash_create call. * class.c (add_method_1): Update java_treetreehash_create call. (java_treetreehash_create): Remove parameter gc. Use htab_create_ggc. gcc/lto: 2010-06-08 Laurynas Biveinis * lto.c (lto_read_in_decl_state): Use typed GC allocation. (lto_file_read): Likewise. (new_partition): Likewise. (read_cgraph_and_symbols): Likewise. gcc/objc: 2010-06-08 Laurynas Biveinis * objc-act.h (ALLOC_OBJC_TYPE_LANG_SPECIFIC): Use typed GC allocation. * objc-act.c (objc_volatilize_decl): Likewise. (objc_build_string_object): Likewise. (hash_init): Likewise. (hash_enter): Likewise. (hash_add_attr): Likewise. (add_class): Likewise. (start_class): Likewise. gcc/objcp: 2010-06-08 Laurynas Biveinis * objcp-decl.h (ALLOC_OBJC_TYPE_LANG_SPECIFIC): Use typed GC allocation. gcc: 2010-06-08 Laurynas Biveinis * doc/tm.texi (Per-Function Data): Do not reference ggc_alloc. * doc/gty.texi (GTY Options): Document typed GC allocation and variable_size GTY option. * ggc-internal.h: New. * ggc.h: Update copyright year. (digit_string): Move to stringpool.c. (ggc_mark_stringpool, ggc_purge_stringpool, ggc_mark_roots) (gt_pch_save_stringpool, gt_pch_fixup_stringpool) (gt_pach_restore_stringpool, gt_pch_p_S, gt_pch_note_object) (init_ggc_pch, ggc_pch_count_object, ggc_pch_total_size) (ggc_pch_this_base, ggc_pch_alloc_object, ggc_pch_prepare_write) (ggc_pch_write_object, ggc_pch_finish, ggc_pch_read) (ggc_force_collect, ggc_get_size, ggc_statistics) (ggc_print_common_statistics): Move to ggc-internal.h. (digit_vector, new_ggc_zone, destroy_ggc_zone, ggc_alloc_stat) (ggc_alloc, ggc_alloc_cleared, ggc_realloc, ggc_calloc, GGC_NEW) (GGC_CNEW, GGC_NEWVEC, GGC_CNEWVEC, GGC_NEWVAR, ggc_alloc_rtvec) (ggc_alloc_tree, gt_pch_save, ggc_min_expand_heuristic) (ggc_min_heapsize_heuristic, ggc_alloc_zone) (ggc_alloc_zone_pass_stat): Remove. (ggc_internal_alloc_stat, ggc_internal_alloc) (ggc_internal_cleared_alloc_stat): New. (GGC_RESIZEVEC, GGC_RESIZEVAR): Redefine. (ggc_internal_vec_alloc_stat) (ggc_internal_cleared_vec_alloc_stat) (ggc_internal_vec_alloc_stat, ggc_internal_cleared_vec_alloc) (ggc_alloc_atomic_stat, ggc_alloc_atomic) (ggc_alloc_cleared_atomic, ggc_cleared_alloc_htab_ignore_args) (ggc_cleared_alloc_ptr_array_two_args): New. (htab_create_ggc, splay_tree_new_ggc): Redefine. (ggc_splay_alloc): Change the type of the first argument to enum gt_types_enum. (ggc_alloc_string): Make macro. (ggc_alloc_string_stat): New. (ggc_strdup): Redefine. (rtl_zone, tree_zone, tree_id_zone): Declare unconditionally. (ggc_alloc_rtvec_sized): New. (ggc_alloc_zone_stat): Rename to ggc_internal_alloc_zone_stat. (ggc_internal_alloc_zone_pass_stat, ggc_internal_alloc_zone_stat) (ggc_internal_cleared_alloc_zone_stat) (ggc_internal_zone_alloc_stat) (ggc_internal_zone_cleared_alloc_stat) (ggc_internal_zone_vec_alloc_stat) (ggc_alloc_zone_rtx_def_stat) (ggc_alloc_zone_tree_node_stat) (ggc_alloc_zone_cleared_tree_node_stat) (ggc_alloc_cleared_gimple_statement_d_stat): New. * ggc-common.c: Include ggc-internal.h. (ggc_internal_cleared_alloc_stat): Rename from ggc_alloc_cleared_stat. (ggc_realloc_stat): Use ggc_internal_alloc_stat. (ggc_calloc): Remove. (ggc_cleared_alloc_htab_ignore_args): New. (ggc_cleared_alloc_ptr_array_two_args): New. (ggc_splay_alloc): Add obj_type parameter. (init_ggc_heuristics): Formatting fixes. * ggc-none.c: Update copyright year. (ggc_alloc_stat): Rename to ggc_alloc_stat. (ggc_alloc_cleared_stat): Rename to ggc_internal_cleared_alloc_stat. (struct alloc_zone, rtl_zone, tree_zone, tree_id_zone): New. * ggc-page.c: Update copyright year. Include ggc-internal.h. Remove references to ggc_alloc in comments. (ggc_alloc_typed_stat): Call ggc_internal_alloc_stat. (ggc_alloc_stat): Rename to ggc_internal_alloc_stat. (new_ggc_zone, destroy_ggc_zone): Remove. (struct alloc_zone, rtl_zone, tree_zone, tree_id_zone): New. * ggc-zone.c: Include ggc-internal.h. Remove references to ggc_alloc in comments. (ggc_alloc_zone_stat): ggc_internal_alloc_zone_stat. (ggc_internal_alloc_zone_pass_stat): New. (ggc_internal_cleared_alloc_zone_stat): New. (ggc_alloc_typed_stat): Use ggc_internal_alloc_zone_pass_stat. (ggc_alloc_stat): Rename ggc_internal_alloc_stat. (new_ggc_zone, destroy_ggc_zone): Remove. * stringpool.c: Update copyright year. Include ggc-internal.h (digit_vector): Make static. (digit_string): Moved from ggc.h. (stringpool_ggc_alloc): Use ggc_alloc_atomic. (ggc_alloc_string): Rename to ggc_alloc_string_stat. * Makefile.in (GGC_INTERNAL_H): New. (ggc_common.o, ggc-page.o, ggc-zone.o, stringpool.o): Add $(GGC_INTERNAL_H) to dependencies. * gentype.c: Update copyright year. (walk_type): Accept variable_size GTY option. (USED_BY_TYPED_GC_P): New macro. (write_enum_defn): Use USED_BY_TYPED_GC_P. Do not output whitespace at the end of strings. (get_type_specifier, variable_size_p): New functions. (alloc_quantity, alloc_zone): New enums. (write_typed_alloc_def): New function. (write_typed_struct_alloc_def): Likewise. (write_typed_typed_typedef_alloc_def): Likewise. (write_typed_alloc_defns): Likewise. (output_typename, write_splay_tree_allocator_def): Likewise. (write_splay_tree_allocators): Likewise. (main): Call write_typed_alloc_defns and write_splay_tree_allocators. * lto-streamer.h (lto_file_decl_data_ptr): New. * passes.c (order): Define using cgraph_node_ptr. * strinpool.c (struct string_pool_data): Declare nested_ptr using ht_identifier_ptr. * gimple.h (union gimple_statement_d): Likewise. * rtl.h (struct rtx_def): Likewise. (struct rtvec_def): Likewise. * tree.h (union tree_node): Likewise. * tree-ssa-operands.h (struct ssa_operand_memory_d): Likewise. * cfgloop.c (record_loop_exits): Use htab_create_ggc. * tree-scalar-evolution.c (scev_initialize): Likewise. * alias.c (record_alias_subset): Update splay_tree_new_ggc call. * dwarf2asm.c (dw2_force_const_mem): Likewise. * omp-low.c (lower_omp_critical): Likewise. * bitmap.h (struct bitmap_head_def): Update comment to not reference ggc_alloc. * config/pa/pa.c (get_deferred_label): Use GGC_RESIZEVEC. * ira.c (fix_reg_equiv_init): Use GGC_RESIZEVEC. * ipa-prop.c (duplicate_ggc_array): Rename to duplicate_ipa_jump_func_array. Use typed GC allocation. (ipa_edge_duplication_hook): Call duplicate_ipa_jump_func_array. * gimple.c (gimple_alloc_stat): Use ggc_alloc_cleared_gimple_statement_d_stat. * varasm.c (create_block_symbol): Use ggc_alloc_zone_rtx_def. * tree.c (make_node_stat): Use ggc_alloc_zone_cleared_tree_node_stat. (make_tree_vec_stat): Likewise. (build_vl_exp_stat): Likewise. (copy_node_stat): Use ggc_alloc_zone_tree_node_stat. (make_tree_binfo_stat): Likewise. (tree_cons_stat): Likewise. * rtl.c (rtx_alloc_stat): Use ggc_alloc_zone_rtx_def_stat. (shallow_copy_rtx_stat): Likewise. (make_node_stat): Likewise. * lto-symtab.c: Fix comment. * tree-cfg.c (create_bb): Update comment to not reference ggc_alloc_cleared. * tree-ssa-structalias.c (struct heapvar_for_stmt): Fix param_is value. * varpool.c (varpool_node): Use typed GC allocation. (varpool_extra_name_alias): Likewise. * varasm.c (emutls_decl): Likewise. (get_unnamed_section): Likewise. (get_noswitch_section): Likewise. (get_section): Likewise. (get_block_for_section): Likewise. (build_constant_desc): Likewise. (create_constant_pool): Likewise. (force_const_mem): Likewise. * tree.c (build_vl_exp_stat): Likewise. (build_real): Likewise. (build_string): Likewise. (decl_debug_expr_insert): Likewise. (decl_value_expr_insert): Likewise. (type_hash_add): Likewise. (build_omp_clause): Likewise. * tree-ssanames.c (duplicate_ssa_name_ptr_info): Likewise. * tree-ssa.c (init_tree_ssa): Likewise. * tree-ssa-structalias.c (heapvar_insert): Likewise. * tree-ssa-operands.c (ssa_operand_alloc): Likewise. * tree-ssa-loop-niter.c (record_estimate): Likewise. * tree-ssa-alias.c (get_ptr_info): Likewise. * tree-scalar-evolution.c (new_scev_info_str): Likewise. * tree-phinodes.c (allocate_phi_node): Likewise. * tree-iterator.c (tsi_link_before): Likewise. (tsi_link_after): Likewise. * tree-eh.c (add_stmt_to_eh_lp_fn): Likewise. * tree-dfa.c (create_var_ann): Likewise. * tree-cfg.c (create_bb): Likewise. * toplev.c (alloc_for_identifier_to_locale): Likewise. (general_init): Likewise. * stringpool.c (stringpool_ggc_alloc): Likewise. (gt_pch_save_stringpool): Likewise. * sese.c (if_region_set_false_region): Likewise. * passes.c (do_per_function_toporder): Likewise. * optabs.c (set_optab_libfunc): Likewise. (set_conv_libfunc): Likewise. * lto-symtab.c (lto_symtab_register_decl): Likewise. * lto-streamer-in.c (lto_input_eh_catch_list): Likewise. (input_eh_region): Likewise. (input_eh_lp): Likewise. (make_new_block): Likewise. (unpack_ts_real_cst_value_fields): Likewise. * lto-section-in.c (lto_new_in_decl_state): Likewise. * lto-cgraph.c (input_node_opt_summary): Likewise. * loop-init.c (loop_optimizer_init): Likewise. * lambda.h (lambda_vector_new): Likewise. * lambda-code.c (replace_uses_equiv_to_x_with_y): Likewise. * ira.c (update_equiv_regs): Likewise. * ipa.c (cgraph_node_set_new): Likewise. (cgraph_node_set_add): Likewise. (varpool_node_set_new): Likewise. (varpool_node_set_add): Likewise. * ipa-prop.c (ipa_compute_jump_functions_for_edge): Likewise. (duplicate_ipa_jump_func_array): Likewise. (ipa_read_node_info): Likewise. * ipa-cp.c (ipcp_create_replace_map): Likewise. * integrate.c (get_hard_reg_initial_val): Likewise. * gimple.c (gimple_alloc_stat): Likewise. (gimple_build_omp_for): Likewise. (gimple_seq_alloc): Likewise. (gimple_copy): Likewise. * gimple-iterator.c (gsi_insert_before_without_update): Likewise. (gsi_insert_after_without_update): Likewise. * function.c (add_frame_space): Likewise. (insert_temp_slot_address): Likewise. (assign_stack_temp_for_type): Likewise. (allocate_struct_function): Likewise. (types_used_by_var_decl_insert): Likewise. * except.c (init_eh_for_function): Likewise. (gen_eh_region): Likewise. (gen_eh_region_catch): Likewise. (gen_eh_landing_pad): Likewise. (add_call_site): Likewise. * emit-rtl.c (get_mem_attrs): Likewise. (get_reg_attrs): Likewise. (start_sequence): Likewise. (init_emit): Likewise. * dwarf2out.c (new_cfi): Likewise. (queue_reg_save): Likewise. (dwarf2out_frame_init): Likewise. (new_loc_descr): Likewise. (find_AT_string): Likewise. (new_die): Likewise. (add_var_loc_to_decl): Likewise. (clone_die): Likewise. (clone_as_declaration): Likewise. (break_out_comdat_types): Likewise. (new_loc_list): Likewise. (loc_descriptor): Likewise. (add_loc_descr_to_each): Likewise. (add_const_value_attribute): Likewise. (tree_add_const_value_attribute): Likewise. (add_comp_dir_attribute): Likewise. (add_name_and_src_coords_attributes): Likewise. (lookup_filename): Likewise. (store_vcall_insn): Likewise. (dwarf2out_init): Likewise. * dbxout.c (dbxout_init): Likewise. * config/xtensa/xtensa.c (xtensa_init_machine_status): Likewise. * config/sparc/sparc.c (sparc_init_machine_status): Likewise. * config/score/score7.c (score7_output_external): Likewise. * config/score/score3.c (score3_output_external): Likewise. * config/s390/s390.c (s390_init_machine_status): Likewise. * config/rs6000/rs6000.c (builtin_function_type): Likewise. (rs6000_init_machine_status): Likewise. (output_toc): Likewise. * config/pa/pa.c (pa_init_machine_status): Likewise. (get_deferred_plabel): Likewise. * config/moxie/moxie.c (moxie_init_machine_status): Likewise. * config/mmix/mmix.c (mmix_init_machine_status): Likewise. * config/mips/mips.c (mflip_mips16_use_mips16_p): Likewise. * config/mep/mep.c (mep_init_machine_status): Likewise. (mep_note_pragma_flag): Likewise. * config/m32c/m32c.c (m32c_init_machine_status): Likewise. * config/iq2000/iq2000.c (iq2000_init_machine_status): Likewise. * config/ia64/ia64.c (ia64_init_machine_status): Likewise. * config/i386/winnt.c (i386_pe_record_external_function): Likewise. (i386_pe_maybe_record_exported_symbol): Likewise. * config/i386/i386.c (get_dllimport_decl): Likewise. (ix86_init_machine_status): Likewise. (assign_386_stack_local): Likewise. * config/frv/frv.c (frv_init_machine_status): Likewise. * config/darwin.c (machopic_indirection_name): Likewise. * config/cris/cris.c (cris_init_machine_status): Likewise. * config/bfin/bfin.c (bfin_init_machine_status): Likewise. * config/avr/avr.c (avr_init_machine_status): Likewise. * config/arm/arm.c (arm_init_machine_status): Likewise. * config/alpha/alpha.c (alpha_init_machine_status): Likewise. (alpha_need_linkage): Likewise. (alpha_use_linkage): Likewise. * cgraph.c (cgraph_allocate_node): Likewise. (cgraph_create_edge_1): Likewise. (cgraph_create_indirect_edge): Likewise. (cgraph_add_asm_node): Likewise. * cfgrtl.c (init_rtl_bb_info): Likewise. * cfgloop.c (alloc_loop): Likewise. (rescan_loop_exit): Likewise. * cfg.c (init_flow): Likewise. (alloc_block): Likewise. (unchecked_make_edge): Likewise. * c-parser.c (c_parse_init): Likewise. (c_parse_file): Likewise. * c-decl.c (bind): Likewise. (record_inline_static): Likewise. (push_scope): Likewise. (make_label): Likewise. (lookup_label_for_goto): Likewise. (finish_struct): Likewise. (finish_enum): Likewise. (c_push_function_context): Likewise. * bitmap.c (bitmap_element_allocate): Likewise. (bitmap_gc_alloc_stat): Likewise. * alias.c (record_alias_subset): Likewise. (init_alias_analysis): Likewise. include: 2010-06-08 Laurynas Biveinis * splay-tree.h: Update copyright years. (splay_tree_s): Document fields. (splay_tree_new_typed_alloc): New. * hashtab.h: Update copyright years. (htab_create_typed_alloc): New. libcpp: 2010-06-08 Laurynas Biveinis * include/symtab.h (ht_identifier_ptr): New. libiberty: 2010-06-08 Laurynas Biveinis * splay-tree.c: Update copyright years. (splay_tree_new_typed_alloc): New. (splay_tree_new_with_allocator): Use it. * hashtab.c: Update copyright years. (htab_create_typed_alloc): New. (htab_create_alloc): Use it. * functions.texi: Regenerate. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@160425 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 224474aeff2..7ebdac4d1cf 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -612,8 +612,8 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) void gfc_allocate_lang_decl (tree decl) { - DECL_LANG_SPECIFIC (decl) = (struct lang_decl *) - ggc_alloc_cleared (sizeof (struct lang_decl)); + DECL_LANG_SPECIFIC (decl) = ggc_alloc_cleared_lang_decl(sizeof + (struct lang_decl)); } /* Remember a symbol to generate initialization/cleanup code at function @@ -3410,7 +3410,7 @@ gfc_find_module (const char *name) htab_hash_string (name), INSERT); if (*slot == NULL) { - struct module_htab_entry *entry = GGC_CNEW (struct module_htab_entry); + struct module_htab_entry *entry = ggc_alloc_cleared_module_htab_entry (); entry->name = gfc_get_string (name); entry->decls = htab_create_ggc (10, module_htab_decls_hash, -- cgit v1.2.1 From 185bc3c7f58b86019c45d63fbac99e89b0246682 Mon Sep 17 00:00:00 2001 From: fxcoudert Date: Sat, 12 Jun 2010 06:57:22 +0000 Subject: * trans-decl.c (gfc_build_intrinsic_function_decls): Fix return type. * trans-intrinsic.c (gfc_conv_intrinsic_fdate): Fix argument type. (gfc_conv_intrinsic_ttynam): Likewise. (gfc_conv_intrinsic_trim): Likewise. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@160648 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 7ebdac4d1cf..972d843b97d 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2424,26 +2424,26 @@ gfc_build_intrinsic_function_decls (void) gfor_fndecl_string_len_trim = gfc_build_library_function_decl (get_identifier (PREFIX("string_len_trim")), - gfc_int4_type_node, 2, + gfc_charlen_type_node, 2, gfc_charlen_type_node, pchar1_type_node); gfor_fndecl_string_index = gfc_build_library_function_decl (get_identifier (PREFIX("string_index")), - gfc_int4_type_node, 5, + gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar1_type_node, gfc_charlen_type_node, pchar1_type_node, gfc_logical4_type_node); gfor_fndecl_string_scan = gfc_build_library_function_decl (get_identifier (PREFIX("string_scan")), - gfc_int4_type_node, 5, + gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar1_type_node, gfc_charlen_type_node, pchar1_type_node, gfc_logical4_type_node); gfor_fndecl_string_verify = gfc_build_library_function_decl (get_identifier (PREFIX("string_verify")), - gfc_int4_type_node, 5, + gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar1_type_node, gfc_charlen_type_node, pchar1_type_node, gfc_logical4_type_node); -- 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/trans-decl.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 972d843b97d..d75a195924c 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1213,7 +1213,8 @@ gfc_get_symbol_decl (gfc_symbol * sym) /* Create variables to hold the non-constant bits of array info. */ gfc_build_qualified_array (decl, sym); - if ((sym->attr.allocatable || !sym->attr.dummy) && !sym->attr.pointer) + if (sym->attr.contiguous + || ((sym->attr.allocatable || !sym->attr.dummy) && !sym->attr.pointer)) GFC_DECL_PACKED_ARRAY (decl) = 1; } -- cgit v1.2.1 From 1011a9ca98952b1fff364a3350b9372a7ef340b0 Mon Sep 17 00:00:00 2001 From: burnus Date: Fri, 25 Jun 2010 19:40:37 +0000 Subject: 2010-06-25 Tobias Burnus * intrinsic.h (gfc_check_selected_real_kind, gfc_simplify_selected_real_kind): Update prototypes. * intrinsic.c (add_functions): Add radix support to selected_real_kind. * check.c (gfc_check_selected_real_kind): Ditto. * simplify.c (gfc_simplify_selected_real_kind): Ditto. * trans-decl.c (gfc_build_intrinsic_function_decls): Change call from selected_real_kind to selected_real_kind2008. * intrinsic.texi (SELECTED_REAL_KIND): Update for radix. (PRECISION, RANGE, RADIX): Add cross @refs. 2010-06-25 Tobias Burnus * intrinsics/selected_real_kind.f90 (_gfortran_selected_real_kind2008): Add function. (_gfortran_selected_real_kind): Stub which calls _gfortran_selected_real_kind2008. * gfortran.map (GFORTRAN_1.4): Add _gfortran_selected_real_kind2008. * mk-srk-inc.sh: Save also RADIX. 2010-06-25 Tobias Burnus * selected_real_kind_2.f90: New. * selected_real_kind_3.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@161411 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index d75a195924c..1c7226c41e6 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2612,9 +2612,10 @@ gfc_build_intrinsic_function_decls (void) gfor_fndecl_sr_kind = gfc_build_library_function_decl (get_identifier - (PREFIX("selected_real_kind")), - gfc_int4_type_node, 2, - pvoid_type_node, pvoid_type_node); + (PREFIX("selected_real_kind2008")), + gfc_int4_type_node, 3, + pvoid_type_node, pvoid_type_node, + pvoid_type_node); /* Power functions. */ { -- cgit v1.2.1 From 7cbc820e16a5c752351dd7db7150b2f128bc21e1 Mon Sep 17 00:00:00 2001 From: burnus Date: Tue, 6 Jul 2010 19:57:29 +0000 Subject: 2010-07-06 Tobias Burnus * trans-decl.c: Include diagnostic-core.h besides toplev.h. * trans-intrinsic.c: Ditto. * trans-types.c: Ditto. * convert.c: Include diagnostic-core.h instead of toplev.h. * options.c: Ditto. * trans-array.c: Ditto. * trans-const.c: Ditto. * trans-expr.c: Ditto. * trans-io.c: Ditto. * trans-openmp.c: Ditto. * trans.c: Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@161885 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 1c7226c41e6..1331148dddb 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -29,7 +29,8 @@ along with GCC; see the file COPYING3. If not see #include "tree-dump.h" #include "gimple.h" /* For create_tmp_var_raw. */ #include "ggc.h" -#include "toplev.h" /* For announce_function/internal_error. */ +#include "diagnostic-core.h" /* For internal_error. */ +#include "toplev.h" /* For announce_function. */ #include "output.h" /* For decl_default_tls_model. */ #include "target.h" #include "function.h" -- cgit v1.2.1 From 09276310eee7ca1b0205abdb47fc612bec7ba51d Mon Sep 17 00:00:00 2001 From: janus Date: Tue, 13 Jul 2010 06:57:17 +0000 Subject: 2010-07-13 Janus Weil PR fortran/44434 PR fortran/44565 PR fortran/43945 PR fortran/44869 * gfortran.h (gfc_find_derived_vtab): Modified prototype. * class.c (gfc_build_class_symbol): Modified call to 'gfc_find_derived_vtab'. (add_proc_component): Removed, moved code into 'add_proc_comp'. (add_proc_comps): Renamed to 'add_proc_comp', removed treatment of generics. (add_procs_to_declared_vtab1): Removed unnecessary argument 'resolved'. Removed treatment of generics. (copy_vtab_proc_comps): Removed unnecessary argument 'resolved'. Call 'add_proc_comp' instead of duplicating code. (add_procs_to_declared_vtab): Removed unnecessary arguments 'resolved' and 'declared'. (add_generic_specifics,add_generics_to_declared_vtab): Removed. (gfc_find_derived_vtab): Removed unnecessary argument 'resolved'. Removed treatment of generics. * iresolve.c (gfc_resolve_extends_type_of): Modified call to 'gfc_find_derived_vtab'. * resolve.c (resolve_typebound_function,resolve_typebound_subroutine): Removed treatment of generics. (resolve_select_type,resolve_fl_derived): Modified call to 'gfc_find_derived_vtab'. * trans-decl.c (gfc_get_symbol_decl): Ditto. * trans-expr.c (gfc_conv_derived_to_class,gfc_trans_class_assign): Ditto. * trans-stmt.c (gfc_trans_allocate): Ditto. 2010-07-13 Janus Weil PR fortran/44434 PR fortran/44565 PR fortran/43945 PR fortran/44869 * gfortran.dg/dynamic_dispatch_1.f03: Fixed invalid test case. * gfortran.dg/dynamic_dispatch_2.f03: Ditto. * gfortran.dg/dynamic_dispatch_3.f03: Ditto. * gfortran.dh/typebound_call_16.f03: New. * gfortran.dg/typebound_generic_6.f03: New. * gfortran.dg/typebound_generic_7.f03: New. * gfortran.dg/typebound_generic_8.f03: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@162125 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 1331148dddb..5fee6e23cfc 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1077,7 +1077,7 @@ gfc_get_symbol_decl (gfc_symbol * sym) { gfc_component *c = CLASS_DATA (sym); if (!c->ts.u.derived->backend_decl) - gfc_find_derived_vtab (c->ts.u.derived, true); + gfc_find_derived_vtab (c->ts.u.derived); } if ((sym->attr.dummy && ! sym->attr.function) || (sym->attr.result && byref)) -- cgit v1.2.1 From 241ecdc7d585892a1ee85b5827a1028a86a32528 Mon Sep 17 00:00:00 2001 From: burnus Date: Tue, 13 Jul 2010 13:20:52 +0000 Subject: 2010-07-13 Daniel Franke Tobias Burnus PR fortran/43665 * trans-decl.c (gfc_build_intrinsic_function_decls): Add noclobber/noescape annotations to function calls. (gfc_build_builtin_function_decls): Likewise. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@162140 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 549 +++++++++++++++++++++-------------------------- 1 file changed, 240 insertions(+), 309 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 5fee6e23cfc..0473d4c01ca 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2411,212 +2411,161 @@ gfc_build_intrinsic_function_decls (void) tree pchar4_type_node = gfc_get_pchar_type (4); /* String functions. */ - gfor_fndecl_compare_string = - gfc_build_library_function_decl (get_identifier (PREFIX("compare_string")), - integer_type_node, 4, - gfc_charlen_type_node, pchar1_type_node, - gfc_charlen_type_node, pchar1_type_node); - - gfor_fndecl_concat_string = - gfc_build_library_function_decl (get_identifier (PREFIX("concat_string")), - void_type_node, 6, - gfc_charlen_type_node, pchar1_type_node, - gfc_charlen_type_node, pchar1_type_node, - gfc_charlen_type_node, pchar1_type_node); - - gfor_fndecl_string_len_trim = - gfc_build_library_function_decl (get_identifier (PREFIX("string_len_trim")), - gfc_charlen_type_node, 2, - gfc_charlen_type_node, pchar1_type_node); - - gfor_fndecl_string_index = - gfc_build_library_function_decl (get_identifier (PREFIX("string_index")), - gfc_charlen_type_node, 5, - gfc_charlen_type_node, pchar1_type_node, - gfc_charlen_type_node, pchar1_type_node, - gfc_logical4_type_node); - - gfor_fndecl_string_scan = - gfc_build_library_function_decl (get_identifier (PREFIX("string_scan")), - gfc_charlen_type_node, 5, - gfc_charlen_type_node, pchar1_type_node, - gfc_charlen_type_node, pchar1_type_node, - gfc_logical4_type_node); - - gfor_fndecl_string_verify = - gfc_build_library_function_decl (get_identifier (PREFIX("string_verify")), - gfc_charlen_type_node, 5, - gfc_charlen_type_node, pchar1_type_node, - gfc_charlen_type_node, pchar1_type_node, - gfc_logical4_type_node); - - gfor_fndecl_string_trim = - gfc_build_library_function_decl (get_identifier (PREFIX("string_trim")), - void_type_node, 4, - build_pointer_type (gfc_charlen_type_node), - build_pointer_type (pchar1_type_node), - gfc_charlen_type_node, pchar1_type_node); - - gfor_fndecl_string_minmax = - gfc_build_library_function_decl (get_identifier (PREFIX("string_minmax")), - void_type_node, -4, - build_pointer_type (gfc_charlen_type_node), - build_pointer_type (pchar1_type_node), - integer_type_node, integer_type_node); - - gfor_fndecl_adjustl = - gfc_build_library_function_decl (get_identifier (PREFIX("adjustl")), - void_type_node, 3, pchar1_type_node, - gfc_charlen_type_node, pchar1_type_node); - - gfor_fndecl_adjustr = - gfc_build_library_function_decl (get_identifier (PREFIX("adjustr")), - void_type_node, 3, pchar1_type_node, - gfc_charlen_type_node, pchar1_type_node); - - gfor_fndecl_select_string = - gfc_build_library_function_decl (get_identifier (PREFIX("select_string")), - integer_type_node, 4, pvoid_type_node, - integer_type_node, pchar1_type_node, - gfc_charlen_type_node); - - gfor_fndecl_compare_string_char4 = - gfc_build_library_function_decl (get_identifier - (PREFIX("compare_string_char4")), - integer_type_node, 4, - gfc_charlen_type_node, pchar4_type_node, - gfc_charlen_type_node, pchar4_type_node); - - gfor_fndecl_concat_string_char4 = - gfc_build_library_function_decl (get_identifier - (PREFIX("concat_string_char4")), - void_type_node, 6, - gfc_charlen_type_node, pchar4_type_node, - gfc_charlen_type_node, pchar4_type_node, - gfc_charlen_type_node, pchar4_type_node); - - gfor_fndecl_string_len_trim_char4 = - gfc_build_library_function_decl (get_identifier - (PREFIX("string_len_trim_char4")), - gfc_charlen_type_node, 2, - gfc_charlen_type_node, pchar4_type_node); - - gfor_fndecl_string_index_char4 = - gfc_build_library_function_decl (get_identifier - (PREFIX("string_index_char4")), - gfc_charlen_type_node, 5, - gfc_charlen_type_node, pchar4_type_node, - gfc_charlen_type_node, pchar4_type_node, - gfc_logical4_type_node); - - gfor_fndecl_string_scan_char4 = - gfc_build_library_function_decl (get_identifier - (PREFIX("string_scan_char4")), - gfc_charlen_type_node, 5, - gfc_charlen_type_node, pchar4_type_node, - gfc_charlen_type_node, pchar4_type_node, - gfc_logical4_type_node); - - gfor_fndecl_string_verify_char4 = - gfc_build_library_function_decl (get_identifier - (PREFIX("string_verify_char4")), - gfc_charlen_type_node, 5, - gfc_charlen_type_node, pchar4_type_node, - gfc_charlen_type_node, pchar4_type_node, - gfc_logical4_type_node); - - gfor_fndecl_string_trim_char4 = - gfc_build_library_function_decl (get_identifier - (PREFIX("string_trim_char4")), - void_type_node, 4, - build_pointer_type (gfc_charlen_type_node), - build_pointer_type (pchar4_type_node), - gfc_charlen_type_node, pchar4_type_node); - - gfor_fndecl_string_minmax_char4 = - gfc_build_library_function_decl (get_identifier - (PREFIX("string_minmax_char4")), - void_type_node, -4, - build_pointer_type (gfc_charlen_type_node), - build_pointer_type (pchar4_type_node), - integer_type_node, integer_type_node); - - gfor_fndecl_adjustl_char4 = - gfc_build_library_function_decl (get_identifier (PREFIX("adjustl_char4")), - void_type_node, 3, pchar4_type_node, - gfc_charlen_type_node, pchar4_type_node); - - gfor_fndecl_adjustr_char4 = - gfc_build_library_function_decl (get_identifier (PREFIX("adjustr_char4")), - void_type_node, 3, pchar4_type_node, - gfc_charlen_type_node, pchar4_type_node); - - gfor_fndecl_select_string_char4 = - gfc_build_library_function_decl (get_identifier - (PREFIX("select_string_char4")), - integer_type_node, 4, pvoid_type_node, - integer_type_node, pvoid_type_node, - gfc_charlen_type_node); + gfor_fndecl_compare_string = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("compare_string")), "..R.R", + integer_type_node, 4, gfc_charlen_type_node, pchar1_type_node, + gfc_charlen_type_node, pchar1_type_node); + + gfor_fndecl_concat_string = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("concat_string")), "..W.R.R", + void_type_node, 6, gfc_charlen_type_node, pchar1_type_node, + gfc_charlen_type_node, pchar1_type_node, + gfc_charlen_type_node, pchar1_type_node); + + gfor_fndecl_string_len_trim = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("string_len_trim")), "..R", + gfc_charlen_type_node, 2, gfc_charlen_type_node, pchar1_type_node); + + gfor_fndecl_string_index = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("string_index")), "..R.R.", + gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar1_type_node, + gfc_charlen_type_node, pchar1_type_node, gfc_logical4_type_node); + + gfor_fndecl_string_scan = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("string_scan")), "..R.R.", + gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar1_type_node, + gfc_charlen_type_node, pchar1_type_node, gfc_logical4_type_node); + + gfor_fndecl_string_verify = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("string_verify")), "..R.R.", + gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar1_type_node, + gfc_charlen_type_node, pchar1_type_node, gfc_logical4_type_node); + + gfor_fndecl_string_trim = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("string_trim")), ".Ww.R", + void_type_node, 4, build_pointer_type (gfc_charlen_type_node), + build_pointer_type (pchar1_type_node), gfc_charlen_type_node, + pchar1_type_node); + + gfor_fndecl_string_minmax = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("string_minmax")), ".Ww.R", + void_type_node, -4, build_pointer_type (gfc_charlen_type_node), + build_pointer_type (pchar1_type_node), integer_type_node, + integer_type_node); + + gfor_fndecl_adjustl = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("adjustl")), ".W.R", + void_type_node, 3, pchar1_type_node, gfc_charlen_type_node, + pchar1_type_node); + + gfor_fndecl_adjustr = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("adjustr")), ".W.R", + void_type_node, 3, pchar1_type_node, gfc_charlen_type_node, + pchar1_type_node); + + gfor_fndecl_select_string = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("select_string")), ".R.R.", + integer_type_node, 4, pvoid_type_node, integer_type_node, + pchar1_type_node, gfc_charlen_type_node); + + gfor_fndecl_compare_string_char4 = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("compare_string_char4")), "..R.R", + integer_type_node, 4, gfc_charlen_type_node, pchar4_type_node, + gfc_charlen_type_node, pchar4_type_node); + + gfor_fndecl_concat_string_char4 = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("concat_string_char4")), "..W.R.R", + void_type_node, 6, gfc_charlen_type_node, pchar4_type_node, + gfc_charlen_type_node, pchar4_type_node, gfc_charlen_type_node, + pchar4_type_node); + + gfor_fndecl_string_len_trim_char4 = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("string_len_trim_char4")), "..R", + gfc_charlen_type_node, 2, gfc_charlen_type_node, pchar4_type_node); + + gfor_fndecl_string_index_char4 = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("string_index_char4")), "..R.R.", + gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar4_type_node, + gfc_charlen_type_node, pchar4_type_node, gfc_logical4_type_node); + + gfor_fndecl_string_scan_char4 = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("string_scan_char4")), "..R.R.", + gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar4_type_node, + gfc_charlen_type_node, pchar4_type_node, gfc_logical4_type_node); + + gfor_fndecl_string_verify_char4 = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("string_verify_char4")), "..R.R.", + gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar4_type_node, + gfc_charlen_type_node, pchar4_type_node, gfc_logical4_type_node); + + gfor_fndecl_string_trim_char4 = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("string_trim_char4")), ".Ww.R", + void_type_node, 4, build_pointer_type (gfc_charlen_type_node), + build_pointer_type (pchar4_type_node), gfc_charlen_type_node, + pchar4_type_node); + + gfor_fndecl_string_minmax_char4 = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("string_minmax_char4")), ".Ww.R", + void_type_node, -4, build_pointer_type (gfc_charlen_type_node), + build_pointer_type (pchar4_type_node), integer_type_node, + integer_type_node); + + gfor_fndecl_adjustl_char4 = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("adjustl_char4")), ".W.R", + void_type_node, 3, pchar4_type_node, gfc_charlen_type_node, + pchar4_type_node); + + gfor_fndecl_adjustr_char4 = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("adjustr_char4")), ".W.R", + void_type_node, 3, pchar4_type_node, gfc_charlen_type_node, + pchar4_type_node); + + gfor_fndecl_select_string_char4 = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("select_string_char4")), ".R.R.", + integer_type_node, 4, pvoid_type_node, integer_type_node, + pvoid_type_node, gfc_charlen_type_node); /* Conversion between character kinds. */ - gfor_fndecl_convert_char1_to_char4 = - gfc_build_library_function_decl (get_identifier - (PREFIX("convert_char1_to_char4")), - void_type_node, 3, - build_pointer_type (pchar4_type_node), - gfc_charlen_type_node, pchar1_type_node); + gfor_fndecl_convert_char1_to_char4 = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("convert_char1_to_char4")), ".w.R", + void_type_node, 3, build_pointer_type (pchar4_type_node), + gfc_charlen_type_node, pchar1_type_node); - gfor_fndecl_convert_char4_to_char1 = - gfc_build_library_function_decl (get_identifier - (PREFIX("convert_char4_to_char1")), - void_type_node, 3, - build_pointer_type (pchar1_type_node), - gfc_charlen_type_node, pchar4_type_node); + gfor_fndecl_convert_char4_to_char1 = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("convert_char4_to_char1")), ".w.R", + void_type_node, 3, build_pointer_type (pchar1_type_node), + gfc_charlen_type_node, pchar4_type_node); /* Misc. functions. */ - gfor_fndecl_ttynam = - gfc_build_library_function_decl (get_identifier (PREFIX("ttynam")), - void_type_node, - 3, - pchar_type_node, - gfc_charlen_type_node, - integer_type_node); - - gfor_fndecl_fdate = - gfc_build_library_function_decl (get_identifier (PREFIX("fdate")), - void_type_node, - 2, - pchar_type_node, - gfc_charlen_type_node); - - gfor_fndecl_ctime = - gfc_build_library_function_decl (get_identifier (PREFIX("ctime")), - void_type_node, - 3, - pchar_type_node, - gfc_charlen_type_node, - gfc_int8_type_node); - - gfor_fndecl_sc_kind = - gfc_build_library_function_decl (get_identifier - (PREFIX("selected_char_kind")), - gfc_int4_type_node, 2, - gfc_charlen_type_node, pchar_type_node); - - gfor_fndecl_si_kind = - gfc_build_library_function_decl (get_identifier - (PREFIX("selected_int_kind")), - gfc_int4_type_node, 1, pvoid_type_node); - - gfor_fndecl_sr_kind = - gfc_build_library_function_decl (get_identifier - (PREFIX("selected_real_kind2008")), - gfc_int4_type_node, 3, - pvoid_type_node, pvoid_type_node, - pvoid_type_node); + gfor_fndecl_ttynam = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("ttynam")), ".W", + void_type_node, 3, pchar_type_node, gfc_charlen_type_node, + integer_type_node); + + gfor_fndecl_fdate = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("fdate")), ".W", + void_type_node, 2, pchar_type_node, gfc_charlen_type_node); + + gfor_fndecl_ctime = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("ctime")), ".W", + void_type_node, 3, pchar_type_node, gfc_charlen_type_node, + gfc_int8_type_node); + + gfor_fndecl_sc_kind = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("selected_char_kind")), "..R", + gfc_int4_type_node, 2, gfc_charlen_type_node, pchar_type_node); + + gfor_fndecl_si_kind = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("selected_int_kind")), ".R", + gfc_int4_type_node, 1, pvoid_type_node); + + gfor_fndecl_sr_kind = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("selected_real_kind2008")), ".RR", + gfc_int4_type_node, 3, pvoid_type_node, pvoid_type_node, + pvoid_type_node); /* Power functions. */ { @@ -2675,23 +2624,21 @@ gfc_build_intrinsic_function_decls (void) #undef NRKINDS } - gfor_fndecl_math_ishftc4 = - gfc_build_library_function_decl (get_identifier (PREFIX("ishftc4")), - gfc_int4_type_node, - 3, gfc_int4_type_node, - gfc_int4_type_node, gfc_int4_type_node); - gfor_fndecl_math_ishftc8 = - gfc_build_library_function_decl (get_identifier (PREFIX("ishftc8")), - gfc_int8_type_node, - 3, gfc_int8_type_node, - gfc_int4_type_node, gfc_int4_type_node); + gfor_fndecl_math_ishftc4 = gfc_build_library_function_decl ( + get_identifier (PREFIX("ishftc4")), + gfc_int4_type_node, 3, gfc_int4_type_node, gfc_int4_type_node, + gfc_int4_type_node); + + gfor_fndecl_math_ishftc8 = gfc_build_library_function_decl ( + get_identifier (PREFIX("ishftc8")), + gfc_int8_type_node, 3, gfc_int8_type_node, gfc_int4_type_node, + gfc_int4_type_node); + if (gfc_int16_type_node) - gfor_fndecl_math_ishftc16 = - gfc_build_library_function_decl (get_identifier (PREFIX("ishftc16")), - gfc_int16_type_node, 3, - gfc_int16_type_node, - gfc_int4_type_node, - gfc_int4_type_node); + gfor_fndecl_math_ishftc16 = gfc_build_library_function_decl ( + get_identifier (PREFIX("ishftc16")), + gfc_int16_type_node, 3, gfc_int16_type_node, gfc_int4_type_node, + gfc_int4_type_node); /* BLAS functions. */ { @@ -2737,32 +2684,26 @@ gfc_build_intrinsic_function_decls (void) } /* Other functions. */ - gfor_fndecl_size0 = - gfc_build_library_function_decl (get_identifier (PREFIX("size0")), - gfc_array_index_type, - 1, pvoid_type_node); - gfor_fndecl_size1 = - gfc_build_library_function_decl (get_identifier (PREFIX("size1")), - gfc_array_index_type, - 2, pvoid_type_node, - gfc_array_index_type); - - gfor_fndecl_iargc = - gfc_build_library_function_decl (get_identifier (PREFIX ("iargc")), - gfc_int4_type_node, - 0); + gfor_fndecl_size0 = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("size0")), ".R", + gfc_array_index_type, 1, pvoid_type_node); + + gfor_fndecl_size1 = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("size1")), ".R", + gfc_array_index_type, 2, pvoid_type_node, gfc_array_index_type); + + gfor_fndecl_iargc = gfc_build_library_function_decl ( + get_identifier (PREFIX ("iargc")), gfc_int4_type_node, 0); if (gfc_type_for_size (128, true)) { tree uint128 = gfc_type_for_size (128, true); - gfor_fndecl_clz128 = - gfc_build_library_function_decl (get_identifier (PREFIX ("clz128")), - integer_type_node, 1, uint128); + gfor_fndecl_clz128 = gfc_build_library_function_decl ( + get_identifier (PREFIX ("clz128")), integer_type_node, 1, uint128); - gfor_fndecl_ctz128 = - gfc_build_library_function_decl (get_identifier (PREFIX ("ctz128")), - integer_type_node, 1, uint128); + gfor_fndecl_ctz128 = gfc_build_library_function_decl ( + get_identifier (PREFIX ("ctz128")), integer_type_node, 1, uint128); } } @@ -2774,113 +2715,103 @@ gfc_build_builtin_function_decls (void) { tree gfc_int4_type_node = gfc_get_int_type (4); - gfor_fndecl_stop_numeric = - gfc_build_library_function_decl (get_identifier (PREFIX("stop_numeric")), - void_type_node, 1, gfc_int4_type_node); + gfor_fndecl_stop_numeric = gfc_build_library_function_decl ( + get_identifier (PREFIX("stop_numeric")), + void_type_node, 1, gfc_int4_type_node); /* STOP doesn't return. */ TREE_THIS_VOLATILE (gfor_fndecl_stop_numeric) = 1; - - gfor_fndecl_stop_string = - gfc_build_library_function_decl (get_identifier (PREFIX("stop_string")), - void_type_node, 2, pchar_type_node, - gfc_int4_type_node); + gfor_fndecl_stop_string = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("stop_string")), ".R.", + void_type_node, 2, pchar_type_node, gfc_int4_type_node); /* STOP doesn't return. */ - TREE_THIS_VOLATILE (gfor_fndecl_stop_string) = 1; - - gfor_fndecl_error_stop_numeric = - gfc_build_library_function_decl (get_identifier (PREFIX("error_stop_numeric")), - void_type_node, 1, gfc_int4_type_node); + TREE_THIS_VOLATILE (gfor_fndecl_stop_string) = 1; + gfor_fndecl_error_stop_numeric = gfc_build_library_function_decl ( + get_identifier (PREFIX("error_stop_numeric")), + void_type_node, 1, gfc_int4_type_node); /* ERROR STOP doesn't return. */ TREE_THIS_VOLATILE (gfor_fndecl_error_stop_numeric) = 1; - - gfor_fndecl_error_stop_string = - gfc_build_library_function_decl (get_identifier (PREFIX("error_stop_string")), - void_type_node, 2, pchar_type_node, - gfc_int4_type_node); + gfor_fndecl_error_stop_string = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("error_stop_string")), ".R.", + void_type_node, 2, pchar_type_node, gfc_int4_type_node); /* ERROR STOP doesn't return. */ TREE_THIS_VOLATILE (gfor_fndecl_error_stop_string) = 1; + gfor_fndecl_pause_numeric = gfc_build_library_function_decl ( + get_identifier (PREFIX("pause_numeric")), + void_type_node, 1, gfc_int4_type_node); - gfor_fndecl_pause_numeric = - gfc_build_library_function_decl (get_identifier (PREFIX("pause_numeric")), - void_type_node, 1, gfc_int4_type_node); - - gfor_fndecl_pause_string = - gfc_build_library_function_decl (get_identifier (PREFIX("pause_string")), - void_type_node, 2, pchar_type_node, - gfc_int4_type_node); + gfor_fndecl_pause_string = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("pause_string")), ".R.", + void_type_node, 2, pchar_type_node, gfc_int4_type_node); - gfor_fndecl_runtime_error = - gfc_build_library_function_decl (get_identifier (PREFIX("runtime_error")), - void_type_node, -1, pchar_type_node); + gfor_fndecl_runtime_error = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("runtime_error")), ".R", + void_type_node, -1, pchar_type_node); /* The runtime_error function does not return. */ TREE_THIS_VOLATILE (gfor_fndecl_runtime_error) = 1; - gfor_fndecl_runtime_error_at = - gfc_build_library_function_decl (get_identifier (PREFIX("runtime_error_at")), - void_type_node, -2, pchar_type_node, - pchar_type_node); + gfor_fndecl_runtime_error_at = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("runtime_error_at")), ".RR", + void_type_node, -2, pchar_type_node, pchar_type_node); /* The runtime_error_at function does not return. */ TREE_THIS_VOLATILE (gfor_fndecl_runtime_error_at) = 1; - gfor_fndecl_runtime_warning_at = - gfc_build_library_function_decl (get_identifier (PREFIX("runtime_warning_at")), - void_type_node, -2, pchar_type_node, - pchar_type_node); - gfor_fndecl_generate_error = - gfc_build_library_function_decl (get_identifier (PREFIX("generate_error")), - void_type_node, 3, pvoid_type_node, - integer_type_node, pchar_type_node); - - gfor_fndecl_os_error = - gfc_build_library_function_decl (get_identifier (PREFIX("os_error")), - void_type_node, 1, pchar_type_node); + gfor_fndecl_runtime_warning_at = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("runtime_warning_at")), ".RR", + void_type_node, -2, pchar_type_node, pchar_type_node); + + gfor_fndecl_generate_error = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("generate_error")), ".R.R", + void_type_node, 3, pvoid_type_node, integer_type_node, + pchar_type_node); + + gfor_fndecl_os_error = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("os_error")), ".R", + void_type_node, 1, pchar_type_node); /* The runtime_error function does not return. */ TREE_THIS_VOLATILE (gfor_fndecl_os_error) = 1; - gfor_fndecl_set_args = - gfc_build_library_function_decl (get_identifier (PREFIX("set_args")), - void_type_node, 2, integer_type_node, - build_pointer_type (pchar_type_node)); + gfor_fndecl_set_args = gfc_build_library_function_decl ( + get_identifier (PREFIX("set_args")), + void_type_node, 2, integer_type_node, + build_pointer_type (pchar_type_node)); - gfor_fndecl_set_fpe = - gfc_build_library_function_decl (get_identifier (PREFIX("set_fpe")), - void_type_node, 1, integer_type_node); + gfor_fndecl_set_fpe = gfc_build_library_function_decl ( + get_identifier (PREFIX("set_fpe")), + void_type_node, 1, integer_type_node); /* Keep the array dimension in sync with the call, later in this file. */ - gfor_fndecl_set_options = - gfc_build_library_function_decl (get_identifier (PREFIX("set_options")), - void_type_node, 2, integer_type_node, - build_pointer_type (integer_type_node)); + gfor_fndecl_set_options = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("set_options")), "..R", + void_type_node, 2, integer_type_node, + build_pointer_type (integer_type_node)); - gfor_fndecl_set_convert = - gfc_build_library_function_decl (get_identifier (PREFIX("set_convert")), - void_type_node, 1, integer_type_node); + gfor_fndecl_set_convert = gfc_build_library_function_decl ( + get_identifier (PREFIX("set_convert")), + void_type_node, 1, integer_type_node); - gfor_fndecl_set_record_marker = - gfc_build_library_function_decl (get_identifier (PREFIX("set_record_marker")), - void_type_node, 1, integer_type_node); + gfor_fndecl_set_record_marker = gfc_build_library_function_decl ( + get_identifier (PREFIX("set_record_marker")), + void_type_node, 1, integer_type_node); - gfor_fndecl_set_max_subrecord_length = - gfc_build_library_function_decl (get_identifier (PREFIX("set_max_subrecord_length")), - void_type_node, 1, integer_type_node); + gfor_fndecl_set_max_subrecord_length = gfc_build_library_function_decl ( + get_identifier (PREFIX("set_max_subrecord_length")), + void_type_node, 1, integer_type_node); gfor_fndecl_in_pack = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("internal_pack")), ".r", - pvoid_type_node, 1, pvoid_type_node); + get_identifier (PREFIX("internal_pack")), ".r", + pvoid_type_node, 1, pvoid_type_node); gfor_fndecl_in_unpack = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("internal_unpack")), ".wR", - void_type_node, 2, pvoid_type_node, pvoid_type_node); - - gfor_fndecl_associated = - gfc_build_library_function_decl ( - get_identifier (PREFIX("associated")), - integer_type_node, 2, ppvoid_type_node, - ppvoid_type_node); + get_identifier (PREFIX("internal_unpack")), ".wR", + void_type_node, 2, pvoid_type_node, pvoid_type_node); + + gfor_fndecl_associated = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("associated")), ".RR", + integer_type_node, 2, ppvoid_type_node, ppvoid_type_node); gfc_build_intrinsic_function_decls (); gfc_build_intrinsic_lib_fndecls (); -- cgit v1.2.1 From 4bf69bc330c9edac62fdfa43cc7d3a179ad9e604 Mon Sep 17 00:00:00 2001 From: burnus Date: Tue, 13 Jul 2010 17:26:02 +0000 Subject: 2010-07-13 Tobias Burnus Daniel Franke PR fortran/43665 * trans.h (gfc_build_library_function_decl_with_spec): New prototype. * trans-decl.c (gfc_build_library_function_decl_with_spec): Removed static. * trans-io (gfc_build_io_library_fndecls): Add "fn spec" annotations. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@162147 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 0473d4c01ca..99cccde65a8 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2388,7 +2388,7 @@ gfc_build_library_function_decl (tree name, tree rettype, int nargs, ...) The SPEC parameter specifies the function argument and return type specification according to the fnspec function type attribute. */ -static tree +tree gfc_build_library_function_decl_with_spec (tree name, const char *spec, tree rettype, int nargs, ...) { -- cgit v1.2.1 From 414c3a2c02971657abc9539eb7db6c7a7c03d9b5 Mon Sep 17 00:00:00 2001 From: froydnj Date: Tue, 13 Jul 2010 18:46:25 +0000 Subject: gcc/ * tree.h (build_function_call_expr): Delete. (build_call_expr_loc_array): New function. (build_call_expr_loc_vec): New function. * tree-flow.h (struct omp_region): Change type of ws_args field to a VEC. * builtins.c (build_function_call_expr): Delete. (build_call_expr_loc_array): New function. (build_call_expr_loc): Call it. Use XALLOCAVEC. (build_call_expr): Likewise. (build_call_expr_loc_vec): New function. * cgraphunit.c (build_cdtor): Call build_call_expr instead of build_function_call_expr. * expr.c (emutls_var_address): Likewise. * varasm.c (emutls_common_1): Likewise. * omp-low.c (expand_omp_atomic_mutex): Likewise. (expand_omp_taskreg): Adjust for new type of region->ws_args. (get_ws_args_for): Return a VEC instead of a tree. (expand_parallel_call): Call build_call_expr_loc_vec instead of build_function_call_expr. * stor-layout.c (self_referential_size): Likewise. gcc/fortran/ * trans-decl.c (build_entry_thunks): Call build_call_expr_loc_vec instead of build_function_call_expr. * trans-intrinsic.c (gfc_conv_intrinsic_sr_kind): Likewise. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@162148 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 27 ++++++++++++--------------- 1 file changed, 12 insertions(+), 15 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 99cccde65a8..2cc055d5d18 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1981,8 +1981,6 @@ build_entry_thunks (gfc_namespace * ns) gfc_symbol *thunk_sym; stmtblock_t body; tree thunk_fndecl; - tree args; - tree string_args; tree tmp; locus old_loc; @@ -1992,6 +1990,9 @@ build_entry_thunks (gfc_namespace * ns) gfc_get_backend_locus (&old_loc); for (el = ns->entries; el; el = el->next) { + VEC(tree,gc) *args = NULL; + VEC(tree,gc) *string_args = NULL; + thunk_sym = el->sym; build_function_decl (thunk_sym); @@ -2005,18 +2006,16 @@ build_entry_thunks (gfc_namespace * ns) /* Pass extra parameter identifying this entry point. */ tmp = build_int_cst (gfc_array_index_type, el->id); - args = tree_cons (NULL_TREE, tmp, NULL_TREE); - string_args = NULL_TREE; + VEC_safe_push (tree, gc, args, tmp); if (thunk_sym->attr.function) { if (gfc_return_by_reference (ns->proc_name)) { tree ref = DECL_ARGUMENTS (current_function_decl); - args = tree_cons (NULL_TREE, ref, args); + VEC_safe_push (tree, gc, args, ref); if (ns->proc_name->ts.type == BT_CHARACTER) - args = tree_cons (NULL_TREE, TREE_CHAIN (ref), - args); + VEC_safe_push (tree, gc, args, TREE_CHAIN (ref)); } } @@ -2040,31 +2039,29 @@ build_entry_thunks (gfc_namespace * ns) { /* Pass the argument. */ DECL_ARTIFICIAL (thunk_formal->sym->backend_decl) = 1; - args = tree_cons (NULL_TREE, thunk_formal->sym->backend_decl, - args); + VEC_safe_push (tree, gc, args, thunk_formal->sym->backend_decl); if (formal->sym->ts.type == BT_CHARACTER) { tmp = thunk_formal->sym->ts.u.cl->backend_decl; - string_args = tree_cons (NULL_TREE, tmp, string_args); + VEC_safe_push (tree, gc, string_args, tmp); } } else { /* Pass NULL for a missing argument. */ - args = tree_cons (NULL_TREE, null_pointer_node, args); + VEC_safe_push (tree, gc, args, null_pointer_node); if (formal->sym->ts.type == BT_CHARACTER) { tmp = build_int_cst (gfc_charlen_type_node, 0); - string_args = tree_cons (NULL_TREE, tmp, string_args); + VEC_safe_push (tree, gc, string_args, tmp); } } } /* Call the master function. */ - args = nreverse (args); - args = chainon (args, nreverse (string_args)); + VEC_safe_splice (tree, gc, args, string_args); tmp = ns->proc_name->backend_decl; - tmp = build_function_call_expr (input_location, tmp, args); + tmp = build_call_expr_loc_vec (input_location, tmp, args); if (ns->proc_name->attr.mixed_entry_master) { tree union_decl, field; -- cgit v1.2.1 From 537824d1977a87c7f8b834aa2fdfa7b645bb3d07 Mon Sep 17 00:00:00 2001 From: jakub Date: Tue, 13 Jul 2010 22:55:20 +0000 Subject: * trans-decl.c (gfc_build_intrinsic_function_decls, gfc_build_builtin_function_decls): Mark functions as DECL_PURE_P or TREE_READONLY. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@162160 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 2cc055d5d18..cb805be946f 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2412,6 +2412,7 @@ gfc_build_intrinsic_function_decls (void) get_identifier (PREFIX("compare_string")), "..R.R", integer_type_node, 4, gfc_charlen_type_node, pchar1_type_node, gfc_charlen_type_node, pchar1_type_node); + DECL_PURE_P (gfor_fndecl_compare_string) = 1; gfor_fndecl_concat_string = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("concat_string")), "..W.R.R", @@ -2422,21 +2423,25 @@ gfc_build_intrinsic_function_decls (void) gfor_fndecl_string_len_trim = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("string_len_trim")), "..R", gfc_charlen_type_node, 2, gfc_charlen_type_node, pchar1_type_node); + DECL_PURE_P (gfor_fndecl_string_len_trim) = 1; gfor_fndecl_string_index = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("string_index")), "..R.R.", gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar1_type_node, gfc_charlen_type_node, pchar1_type_node, gfc_logical4_type_node); + DECL_PURE_P (gfor_fndecl_string_index) = 1; gfor_fndecl_string_scan = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("string_scan")), "..R.R.", gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar1_type_node, gfc_charlen_type_node, pchar1_type_node, gfc_logical4_type_node); + DECL_PURE_P (gfor_fndecl_string_scan) = 1; gfor_fndecl_string_verify = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("string_verify")), "..R.R.", gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar1_type_node, gfc_charlen_type_node, pchar1_type_node, gfc_logical4_type_node); + DECL_PURE_P (gfor_fndecl_string_verify) = 1; gfor_fndecl_string_trim = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("string_trim")), ".Ww.R", @@ -2464,11 +2469,13 @@ gfc_build_intrinsic_function_decls (void) get_identifier (PREFIX("select_string")), ".R.R.", integer_type_node, 4, pvoid_type_node, integer_type_node, pchar1_type_node, gfc_charlen_type_node); + DECL_PURE_P (gfor_fndecl_select_string) = 1; gfor_fndecl_compare_string_char4 = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("compare_string_char4")), "..R.R", integer_type_node, 4, gfc_charlen_type_node, pchar4_type_node, gfc_charlen_type_node, pchar4_type_node); + DECL_PURE_P (gfor_fndecl_compare_string_char4) = 1; gfor_fndecl_concat_string_char4 = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("concat_string_char4")), "..W.R.R", @@ -2479,21 +2486,25 @@ gfc_build_intrinsic_function_decls (void) gfor_fndecl_string_len_trim_char4 = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("string_len_trim_char4")), "..R", gfc_charlen_type_node, 2, gfc_charlen_type_node, pchar4_type_node); + DECL_PURE_P (gfor_fndecl_string_len_trim_char4) = 1; gfor_fndecl_string_index_char4 = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("string_index_char4")), "..R.R.", gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar4_type_node, gfc_charlen_type_node, pchar4_type_node, gfc_logical4_type_node); + DECL_PURE_P (gfor_fndecl_string_index_char4) = 1; gfor_fndecl_string_scan_char4 = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("string_scan_char4")), "..R.R.", gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar4_type_node, gfc_charlen_type_node, pchar4_type_node, gfc_logical4_type_node); + DECL_PURE_P (gfor_fndecl_string_scan_char4) = 1; gfor_fndecl_string_verify_char4 = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("string_verify_char4")), "..R.R.", gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar4_type_node, gfc_charlen_type_node, pchar4_type_node, gfc_logical4_type_node); + DECL_PURE_P (gfor_fndecl_string_verify_char4) = 1; gfor_fndecl_string_trim_char4 = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("string_trim_char4")), ".Ww.R", @@ -2521,6 +2532,7 @@ gfc_build_intrinsic_function_decls (void) get_identifier (PREFIX("select_string_char4")), ".R.R.", integer_type_node, 4, pvoid_type_node, integer_type_node, pvoid_type_node, gfc_charlen_type_node); + DECL_PURE_P (gfor_fndecl_select_string_char4) = 1; /* Conversion between character kinds. */ @@ -2554,15 +2566,18 @@ gfc_build_intrinsic_function_decls (void) gfor_fndecl_sc_kind = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("selected_char_kind")), "..R", gfc_int4_type_node, 2, gfc_charlen_type_node, pchar_type_node); + DECL_PURE_P (gfor_fndecl_sc_kind) = 1; gfor_fndecl_si_kind = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("selected_int_kind")), ".R", gfc_int4_type_node, 1, pvoid_type_node); + DECL_PURE_P (gfor_fndecl_si_kind) = 1; gfor_fndecl_sr_kind = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("selected_real_kind2008")), ".RR", gfc_int4_type_node, 3, pvoid_type_node, pvoid_type_node, pvoid_type_node); + DECL_PURE_P (gfor_fndecl_sr_kind) = 1; /* Power functions. */ { @@ -2684,10 +2699,12 @@ gfc_build_intrinsic_function_decls (void) gfor_fndecl_size0 = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("size0")), ".R", gfc_array_index_type, 1, pvoid_type_node); + DECL_PURE_P (gfor_fndecl_size0) = 1; gfor_fndecl_size1 = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("size1")), ".R", gfc_array_index_type, 2, pvoid_type_node, gfc_array_index_type); + DECL_PURE_P (gfor_fndecl_size1) = 1; gfor_fndecl_iargc = gfc_build_library_function_decl ( get_identifier (PREFIX ("iargc")), gfc_int4_type_node, 0); @@ -2698,9 +2715,11 @@ gfc_build_intrinsic_function_decls (void) gfor_fndecl_clz128 = gfc_build_library_function_decl ( get_identifier (PREFIX ("clz128")), integer_type_node, 1, uint128); + TREE_READONLY (gfor_fndecl_clz128) = 1; gfor_fndecl_ctz128 = gfc_build_library_function_decl ( get_identifier (PREFIX ("ctz128")), integer_type_node, 1, uint128); + TREE_READONLY (gfor_fndecl_ctz128) = 1; } } @@ -2722,8 +2741,8 @@ gfc_build_builtin_function_decls (void) get_identifier (PREFIX("stop_string")), ".R.", void_type_node, 2, pchar_type_node, gfc_int4_type_node); /* STOP doesn't return. */ - TREE_THIS_VOLATILE (gfor_fndecl_stop_string) = 1; + gfor_fndecl_error_stop_numeric = gfc_build_library_function_decl ( get_identifier (PREFIX("error_stop_numeric")), void_type_node, 1, gfc_int4_type_node); @@ -2809,6 +2828,7 @@ gfc_build_builtin_function_decls (void) gfor_fndecl_associated = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("associated")), ".RR", integer_type_node, 2, ppvoid_type_node, ppvoid_type_node); + DECL_PURE_P (gfor_fndecl_associated) = 1; gfc_build_intrinsic_function_decls (); gfc_build_intrinsic_lib_fndecls (); -- cgit v1.2.1 From c5faa79924f2b5c58fd21b6bd2416836985dfc25 Mon Sep 17 00:00:00 2001 From: domob Date: Thu, 15 Jul 2010 12:23:47 +0000 Subject: 2010-07-15 Daniel Kraft PR fortran/44709 * trans.h (struct gfc_wrapped_block): New struct. (gfc_start_wrapped_block), (gfc_add_init_cleanup): New methods. (gfc_finish_wrapped_block): New method. (gfc_init_default_dt): Add new init code to block rather than returning it. * trans-array.h (gfc_trans_auto_array_allocation): Use gfc_wrapped_block (gfc_trans_dummy_array_bias): Ditto. (gfc_trans_g77_array): Ditto. (gfc_trans_deferred_array): Ditto. * trans.c (gfc_add_expr_to_block): Call add_expr_to_chain. (add_expr_to_chain): New method based on old gfc_add_expr_to_block. (gfc_start_wrapped_block), (gfc_add_init_cleanup): New methods. (gfc_finish_wrapped_block): New method. * trans-array.c (gfc_trans_auto_array_allocation): use gfc_wrapped_block (gfc_trans_g77_array), (gfc_trans_dummy_array_bias): Ditto. (gfc_trans_deferred_array): Ditto. * trans-decl.c (gfc_trans_dummy_character): Ditto. (gfc_trans_auto_character_variable), (gfc_trans_assign_aux_var): Ditto. (init_intent_out_dt): Ditto. (gfc_init_default_dt): Add new init code to block rather than returning it. (gfc_trans_deferred_vars): Use gfc_wrapped_block to collect all init and cleanup code and put it all together. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@162219 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 158 ++++++++++++++++++++++++----------------------- 1 file changed, 81 insertions(+), 77 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index cb805be946f..dd238fe4a48 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2838,72 +2838,70 @@ gfc_build_builtin_function_decls (void) /* Evaluate the length of dummy character variables. */ -static tree -gfc_trans_dummy_character (gfc_symbol *sym, gfc_charlen *cl, tree fnbody) +static void +gfc_trans_dummy_character (gfc_symbol *sym, gfc_charlen *cl, + gfc_wrapped_block *block) { - stmtblock_t body; + stmtblock_t init; gfc_finish_decl (cl->backend_decl); - gfc_start_block (&body); + gfc_start_block (&init); /* Evaluate the string length expression. */ - gfc_conv_string_length (cl, NULL, &body); + gfc_conv_string_length (cl, NULL, &init); - gfc_trans_vla_type_sizes (sym, &body); + gfc_trans_vla_type_sizes (sym, &init); - gfc_add_expr_to_block (&body, fnbody); - return gfc_finish_block (&body); + gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE); } /* Allocate and cleanup an automatic character variable. */ -static tree -gfc_trans_auto_character_variable (gfc_symbol * sym, tree fnbody) +static void +gfc_trans_auto_character_variable (gfc_symbol * sym, gfc_wrapped_block * block) { - stmtblock_t body; + stmtblock_t init; tree decl; tree tmp; gcc_assert (sym->backend_decl); gcc_assert (sym->ts.u.cl && sym->ts.u.cl->length); - gfc_start_block (&body); + gfc_start_block (&init); /* Evaluate the string length expression. */ - gfc_conv_string_length (sym->ts.u.cl, NULL, &body); + gfc_conv_string_length (sym->ts.u.cl, NULL, &init); - gfc_trans_vla_type_sizes (sym, &body); + gfc_trans_vla_type_sizes (sym, &init); decl = sym->backend_decl; /* Emit a DECL_EXPR for this variable, which will cause the gimplifier to allocate storage, and all that good stuff. */ tmp = fold_build1 (DECL_EXPR, TREE_TYPE (decl), decl); - gfc_add_expr_to_block (&body, tmp); + gfc_add_expr_to_block (&init, tmp); - gfc_add_expr_to_block (&body, fnbody); - return gfc_finish_block (&body); + gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE); } /* Set the initial value of ASSIGN statement auxiliary variable explicitly. */ -static tree -gfc_trans_assign_aux_var (gfc_symbol * sym, tree fnbody) +static void +gfc_trans_assign_aux_var (gfc_symbol * sym, gfc_wrapped_block * block) { - stmtblock_t body; + stmtblock_t init; gcc_assert (sym->backend_decl); - gfc_start_block (&body); + gfc_start_block (&init); /* Set the initial value to length. See the comments in function gfc_add_assign_aux_vars in this file. */ - gfc_add_modify (&body, GFC_DECL_STRING_LEN (sym->backend_decl), - build_int_cst (NULL_TREE, -2)); + gfc_add_modify (&init, GFC_DECL_STRING_LEN (sym->backend_decl), + build_int_cst (NULL_TREE, -2)); - gfc_add_expr_to_block (&body, fnbody); - return gfc_finish_block (&body); + gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE); } static void @@ -3016,15 +3014,15 @@ gfc_trans_vla_type_sizes (gfc_symbol *sym, stmtblock_t *body) /* Initialize a derived type by building an lvalue from the symbol and using trans_assignment to do the work. Set dealloc to false if no deallocation prior the assignment is needed. */ -tree -gfc_init_default_dt (gfc_symbol * sym, tree body, bool dealloc) +void +gfc_init_default_dt (gfc_symbol * sym, stmtblock_t * block, bool dealloc) { - stmtblock_t fnblock; gfc_expr *e; tree tmp; tree present; - gfc_init_block (&fnblock); + gcc_assert (block); + gcc_assert (!sym->attr.allocatable); gfc_set_sym_referenced (sym); e = gfc_lval_expr_from_sym (sym); @@ -3036,11 +3034,8 @@ gfc_init_default_dt (gfc_symbol * sym, tree body, bool dealloc) tmp = build3 (COND_EXPR, TREE_TYPE (tmp), present, tmp, build_empty_stmt (input_location)); } - gfc_add_expr_to_block (&fnblock, tmp); + gfc_add_expr_to_block (block, tmp); gfc_free_expr (e); - if (body) - gfc_add_expr_to_block (&fnblock, body); - return gfc_finish_block (&fnblock); } @@ -3048,15 +3043,15 @@ gfc_init_default_dt (gfc_symbol * sym, tree body, bool dealloc) them their default initializer, if they do not have allocatable components, they have their allocatable components deallocated. */ -static tree -init_intent_out_dt (gfc_symbol * proc_sym, tree body) +static void +init_intent_out_dt (gfc_symbol * proc_sym, gfc_wrapped_block * block) { - stmtblock_t fnblock; + stmtblock_t init; gfc_formal_arglist *f; tree tmp; tree present; - gfc_init_block (&fnblock); + gfc_init_block (&init); for (f = proc_sym->formal; f; f = f->next) if (f->sym && f->sym->attr.intent == INTENT_OUT && !f->sym->attr.pointer @@ -3076,14 +3071,13 @@ init_intent_out_dt (gfc_symbol * proc_sym, tree body) tmp, build_empty_stmt (input_location)); } - gfc_add_expr_to_block (&fnblock, tmp); + gfc_add_expr_to_block (&init, tmp); } else if (f->sym->value) - body = gfc_init_default_dt (f->sym, body, true); + gfc_init_default_dt (f->sym, &init, true); } - gfc_add_expr_to_block (&fnblock, body); - return gfc_finish_block (&fnblock); + gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE); } @@ -3101,9 +3095,12 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) locus loc; gfc_symbol *sym; gfc_formal_arglist *f; - stmtblock_t body; + stmtblock_t tmpblock; + gfc_wrapped_block try_block; bool seen_trans_deferred_array = false; + gfc_start_wrapped_block (&try_block, fnbody); + /* Deal with implicit return variables. Explicit return variables will already have been added. */ if (gfc_return_by_reference (proc_sym) && proc_sym->result == proc_sym) @@ -3125,19 +3122,17 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) else if (proc_sym->as) { tree result = TREE_VALUE (current_fake_result_decl); - fnbody = gfc_trans_dummy_array_bias (proc_sym, result, fnbody); + gfc_trans_dummy_array_bias (proc_sym, result, &try_block); /* An automatic character length, pointer array result. */ if (proc_sym->ts.type == BT_CHARACTER && TREE_CODE (proc_sym->ts.u.cl->backend_decl) == VAR_DECL) - fnbody = gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, - fnbody); + gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, &try_block); } else if (proc_sym->ts.type == BT_CHARACTER) { if (TREE_CODE (proc_sym->ts.u.cl->backend_decl) == VAR_DECL) - fnbody = gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, - fnbody); + gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, &try_block); } else gcc_assert (gfc_option.flag_f2c @@ -3147,7 +3142,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) /* Initialize the INTENT(OUT) derived type dummy arguments. This should be done here so that the offsets and lbounds of arrays are available. */ - fnbody = init_intent_out_dt (proc_sym, fnbody); + init_intent_out_dt (proc_sym, &try_block); for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink) { @@ -3159,8 +3154,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) { case AS_EXPLICIT: if (sym->attr.dummy || sym->attr.result) - fnbody = - gfc_trans_dummy_array_bias (sym, sym->backend_decl, fnbody); + gfc_trans_dummy_array_bias (sym, sym->backend_decl, &try_block); else if (sym->attr.pointer || sym->attr.allocatable) { if (TREE_STATIC (sym->backend_decl)) @@ -3168,7 +3162,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) else { seen_trans_deferred_array = true; - fnbody = gfc_trans_deferred_array (sym, fnbody); + gfc_trans_deferred_array (sym, &try_block); } } else @@ -3176,18 +3170,24 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) if (sym_has_alloc_comp) { seen_trans_deferred_array = true; - fnbody = gfc_trans_deferred_array (sym, fnbody); + gfc_trans_deferred_array (sym, &try_block); } else if (sym->ts.type == BT_DERIVED && sym->value && !sym->attr.data && sym->attr.save == SAVE_NONE) - fnbody = gfc_init_default_dt (sym, fnbody, false); + { + gfc_start_block (&tmpblock); + gfc_init_default_dt (sym, &tmpblock, false); + gfc_add_init_cleanup (&try_block, + gfc_finish_block (&tmpblock), + NULL_TREE); + } gfc_get_backend_locus (&loc); gfc_set_backend_locus (&sym->declared_at); - fnbody = gfc_trans_auto_array_allocation (sym->backend_decl, - sym, fnbody); + gfc_trans_auto_array_allocation (sym->backend_decl, + sym, &try_block); gfc_set_backend_locus (&loc); } break; @@ -3198,27 +3198,26 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) /* We should always pass assumed size arrays the g77 way. */ if (sym->attr.dummy) - fnbody = gfc_trans_g77_array (sym, fnbody); - break; + gfc_trans_g77_array (sym, &try_block); + break; case AS_ASSUMED_SHAPE: /* Must be a dummy parameter. */ gcc_assert (sym->attr.dummy); - fnbody = gfc_trans_dummy_array_bias (sym, sym->backend_decl, - fnbody); + gfc_trans_dummy_array_bias (sym, sym->backend_decl, &try_block); break; case AS_DEFERRED: seen_trans_deferred_array = true; - fnbody = gfc_trans_deferred_array (sym, fnbody); + gfc_trans_deferred_array (sym, &try_block); break; default: gcc_unreachable (); } if (sym_has_alloc_comp && !seen_trans_deferred_array) - fnbody = gfc_trans_deferred_array (sym, fnbody); + gfc_trans_deferred_array (sym, &try_block); } else if (sym->attr.allocatable || (sym->ts.type == BT_CLASS @@ -3231,7 +3230,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) tree tmp; gfc_expr *e; gfc_se se; - stmtblock_t block; + stmtblock_t init; e = gfc_lval_expr_from_sym (sym); if (sym->ts.type == BT_CLASS) @@ -3243,49 +3242,53 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) gfc_free_expr (e); /* Nullify when entering the scope. */ - gfc_start_block (&block); - gfc_add_modify (&block, se.expr, + gfc_start_block (&init); + gfc_add_modify (&init, se.expr, fold_convert (TREE_TYPE (se.expr), null_pointer_node)); - gfc_add_expr_to_block (&block, fnbody); /* Deallocate when leaving the scope. Nullifying is not needed. */ tmp = gfc_deallocate_with_status (se.expr, NULL_TREE, true, NULL); - gfc_add_expr_to_block (&block, tmp); - fnbody = gfc_finish_block (&block); + + gfc_add_init_cleanup (&try_block, gfc_finish_block (&init), tmp); } } else if (sym_has_alloc_comp) - fnbody = gfc_trans_deferred_array (sym, fnbody); + gfc_trans_deferred_array (sym, &try_block); else if (sym->ts.type == BT_CHARACTER) { gfc_get_backend_locus (&loc); gfc_set_backend_locus (&sym->declared_at); if (sym->attr.dummy || sym->attr.result) - fnbody = gfc_trans_dummy_character (sym, sym->ts.u.cl, fnbody); + gfc_trans_dummy_character (sym, sym->ts.u.cl, &try_block); else - fnbody = gfc_trans_auto_character_variable (sym, fnbody); + gfc_trans_auto_character_variable (sym, &try_block); gfc_set_backend_locus (&loc); } else if (sym->attr.assign) { gfc_get_backend_locus (&loc); gfc_set_backend_locus (&sym->declared_at); - fnbody = gfc_trans_assign_aux_var (sym, fnbody); + gfc_trans_assign_aux_var (sym, &try_block); gfc_set_backend_locus (&loc); } else if (sym->ts.type == BT_DERIVED && sym->value && !sym->attr.data && sym->attr.save == SAVE_NONE) - fnbody = gfc_init_default_dt (sym, fnbody, false); + { + gfc_start_block (&tmpblock); + gfc_init_default_dt (sym, &tmpblock, false); + gfc_add_init_cleanup (&try_block, gfc_finish_block (&tmpblock), + NULL_TREE); + } else gcc_unreachable (); } - gfc_init_block (&body); + gfc_init_block (&tmpblock); for (f = proc_sym->formal; f; f = f->next) { @@ -3293,7 +3296,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) { gcc_assert (f->sym->ts.u.cl->backend_decl != NULL); if (TREE_CODE (f->sym->ts.u.cl->backend_decl) == PARM_DECL) - gfc_trans_vla_type_sizes (f->sym, &body); + gfc_trans_vla_type_sizes (f->sym, &tmpblock); } } @@ -3302,11 +3305,12 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) { gcc_assert (proc_sym->ts.u.cl->backend_decl != NULL); if (TREE_CODE (proc_sym->ts.u.cl->backend_decl) == PARM_DECL) - gfc_trans_vla_type_sizes (proc_sym, &body); + gfc_trans_vla_type_sizes (proc_sym, &tmpblock); } - gfc_add_expr_to_block (&body, fnbody); - return gfc_finish_block (&body); + gfc_add_init_cleanup (&try_block, gfc_finish_block (&tmpblock), NULL_TREE); + + return gfc_finish_wrapped_block (&try_block); } static GTY ((param_is (struct module_htab_entry))) htab_t module_htab; -- cgit v1.2.1 From 1767a056f10a2ccbc900df04d01193da73a3d272 Mon Sep 17 00:00:00 2001 From: froydnj Date: Thu, 15 Jul 2010 14:31:28 +0000 Subject: gcc/ * tree.h (DECL_CHAIN): Define. * alias.c: Carefully replace TREE_CHAIN with DECL_CHAIN. * c-decl.c: Likewise. * c-parser.c: Likewise. * c-typeck.c: Likewise. * cfgexpand.c: Likewise. * cgraph.c: Likewise. * cgraphunit.c: Likewise. * combine.c: Likewise. * config/alpha/alpha.c: Likewise. * config/arm/arm.c: Likewise. * config/frv/frv.c: Likewise. * config/i386/i386.c: Likewise. * config/i386/winnt-cxx.c: Likewise. * config/ia64/ia64.c: Likewise. * config/iq2000/iq2000.c: Likewise. * config/mep/mep.c: Likewise. * config/mips/mips.c: Likewise. * config/pa/som.h: Likewise. * config/rs6000/rs6000.c: Likewise. * config/s390/s390.c: Likewise. * config/sh/sh.c: Likewise. * config/sh/symbian-cxx.c: Likewise. * config/sparc/sparc.c: Likewise. * config/spu/spu.c: Likewise. * config/stormy16/stormy16.c: Likewise. * config/vxworks.c: Likewise. * config/xtensa/xtensa.c: Likewise. * coverage.c: Likewise. * dbxout.c: Likewise. * dwarf2out.c: Likewise. * emit-rtl.c: Likewise. * expr.c: Likewise. * function.c: Likewise. * gimple-low.c: Likewise. * gimple-pretty-print.c: Likewise. * gimplify.c: Likewise. * integrate.c: Likewise. * ipa-inline.c: Likewise. * ipa-prop.c: Likewise. * ipa-split.c: Likewise. * ipa-struct-reorg.c: Likewise. * ipa-type-escape.c: Likewise. * langhooks.c: Likewise. * lto-cgraph.c: Likewise. * omp-low.c: Likewise. * stor-layout.c: Likewise. * tree-cfg.c: Likewise. * tree-complex.c: Likewise. * tree-dfa.c: Likewise. * tree-dump.c: Likewise. * tree-inline.c: Likewise. * tree-mudflap.c: Likewise. * tree-nested.c: Likewise. * tree-object-size.c: Likewise. * tree-pretty-print.c: Likewise. * tree-sra.c: Likewise. * tree-ssa-live.c: Likewise. * tree-ssa-loop-niter.c: Likewise. * tree-ssa-math-opts.c: Likewise. * tree-ssa-reassoc.c: Likewise. * tree-ssa-sccvn.c: Likewise. * tree-ssa-structalias.c: Likewise. * tree-tailcall.c: Likewise. * tree-vrp.c: Likewise. * tree.c: Likewise. * var-tracking.c: Likewise. * varasm.c: Likewise. gcc/ada/ * gcc-interface/decl.c: Carefully replace TREE_CHAIN with DECL_CHAIN. * gcc-interface/trans.c: Likewise. * gcc-interface/utils.c: Likewise. * gcc-interface/utils2.c: Likewise. gcc/c-family/ * c-common.c: Carefully replace TREE_CHAIN with DECL_CHAIN. * c-format.c: Likewise. gcc/cp/ * cp-tree.h: Carefully replace TREE_CHAIN with DECL_CHAIN. * call.c: Likewise. * class.c: Likewise. * cp-gimplify.c: Likewise. * decl.c: Likewise. * decl2.c: Likewise. * init.c: Likewise. * mangle.c: Likewise. * name-lookup.c: Likewise. * optimize.c: Likewise. * parser.c: Likewise. * pt.c: Likewise. * rtti.c: Likewise. * search.c: Likewise. * semantics.c: Likewise. * typeck.c: Likewise. * typeck2.c: Likewise. gcc/fortran/ * f95-lang.c: Carefully replace TREE_CHAIN with DECL_CHAIN. * trans-common.c: Likewise. * trans-decl.c: Likewise. * trans-types.c: Likewise. * trans.c: Likewise. gcc/java/ * java-tree.h: Carefully replace TREE_CHAIN with DECL_CHAIN. * boehm.c: Likewise. * class.c: Likewise. * decl.c: Likewise. * expr.c: Likewise. * jcf-parse.c: Likewise. * typeck.c: Likewise. * verify-glue.c: Likewise. gcc/objc/ * objc-act.c: Carefully replace TREE_CHAIN with DECL_CHAIN. gcc/testsuite/ * g++.dg/plugin/attribute_plugin.c: Carefully replace TREE_CHAIN with DECL_CHAIN. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@162223 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index dd238fe4a48..bd7363d933d 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -174,7 +174,7 @@ gfc_add_decl_to_parent_function (tree decl) gcc_assert (decl); DECL_CONTEXT (decl) = DECL_CONTEXT (current_function_decl); DECL_NONLOCAL (decl) = 1; - TREE_CHAIN (decl) = saved_parent_function_decls; + DECL_CHAIN (decl) = saved_parent_function_decls; saved_parent_function_decls = decl; } @@ -184,7 +184,7 @@ gfc_add_decl_to_function (tree decl) gcc_assert (decl); TREE_USED (decl) = 1; DECL_CONTEXT (decl) = current_function_decl; - TREE_CHAIN (decl) = saved_function_decls; + DECL_CHAIN (decl) = saved_function_decls; saved_function_decls = decl; } @@ -194,7 +194,7 @@ add_decl_as_local (tree decl) gcc_assert (decl); TREE_USED (decl) = 1; DECL_CONTEXT (decl) = current_function_decl; - TREE_CHAIN (decl) = saved_local_decls; + DECL_CHAIN (decl) = saved_local_decls; saved_local_decls = decl; } @@ -960,7 +960,7 @@ gfc_nonlocal_dummy_array_decl (gfc_symbol *sym) SET_DECL_VALUE_EXPR (decl, sym->backend_decl); DECL_HAS_VALUE_EXPR_P (decl) = 1; DECL_CONTEXT (decl) = DECL_CONTEXT (sym->backend_decl); - TREE_CHAIN (decl) = nonlocal_dummy_decls; + DECL_CHAIN (decl) = nonlocal_dummy_decls; nonlocal_dummy_decls = decl; } @@ -1091,7 +1091,7 @@ gfc_get_symbol_decl (gfc_symbol * sym) /* For entry master function skip over the __entry argument. */ if (sym->ns->proc_name->attr.entry_master) - sym->backend_decl = TREE_CHAIN (sym->backend_decl); + sym->backend_decl = DECL_CHAIN (sym->backend_decl); } /* Dummy variables should already have been created. */ @@ -2015,7 +2015,7 @@ build_entry_thunks (gfc_namespace * ns) tree ref = DECL_ARGUMENTS (current_function_decl); VEC_safe_push (tree, gc, args, ref); if (ns->proc_name->ts.type == BT_CHARACTER) - VEC_safe_push (tree, gc, args, TREE_CHAIN (ref)); + VEC_safe_push (tree, gc, args, DECL_CHAIN (ref)); } } @@ -2083,7 +2083,7 @@ build_entry_thunks (gfc_namespace * ns) gfc_add_expr_to_block (&body, tmp); for (field = TYPE_FIELDS (TREE_TYPE (union_decl)); - field; field = TREE_CHAIN (field)) + field; field = DECL_CHAIN (field)) if (strcmp (IDENTIFIER_POINTER (DECL_NAME (field)), thunk_sym->result->name) == 0) break; @@ -2219,7 +2219,7 @@ gfc_get_fake_result_decl (gfc_symbol * sym, int parent_flag) tree field; for (field = TYPE_FIELDS (TREE_TYPE (decl)); - field; field = TREE_CHAIN (field)) + field; field = DECL_CHAIN (field)) if (strcmp (IDENTIFIER_POINTER (DECL_NAME (field)), sym->name) == 0) break; @@ -2270,7 +2270,7 @@ gfc_get_fake_result_decl (gfc_symbol * sym, int parent_flag) if (sym->ns->proc_name->backend_decl == this_function_decl && sym->ns->proc_name->attr.entry_master) - decl = TREE_CHAIN (decl); + decl = DECL_CHAIN (decl); TREE_USED (decl) = 1; if (sym->as) @@ -4531,8 +4531,8 @@ gfc_generate_function_code (gfc_namespace * ns) { tree next; - next = TREE_CHAIN (decl); - TREE_CHAIN (decl) = NULL_TREE; + next = DECL_CHAIN (decl); + DECL_CHAIN (decl) = NULL_TREE; pushdecl (decl); decl = next; } @@ -4710,8 +4710,8 @@ gfc_process_block_locals (gfc_namespace* ns) { tree next; - next = TREE_CHAIN (decl); - TREE_CHAIN (decl) = NULL_TREE; + next = DECL_CHAIN (decl); + DECL_CHAIN (decl) = NULL_TREE; pushdecl (decl); decl = next; } -- cgit v1.2.1 From abca35418102c31d95b688897b34b9ff2688ee3d Mon Sep 17 00:00:00 2001 From: pault Date: Mon, 19 Jul 2010 18:48:44 +0000 Subject: 2010-07-19 Paul Thomas PR fortran/42385 * interface.c (matching_typebound_op): Add argument for the return of the generic name for the procedure. (build_compcall_for_operator): Add an argument for the generic name of an operator procedure and supply it to the expression. (gfc_extend_expr, gfc_extend_assign): Use the generic name in calls to the above procedures. * resolve.c (resolve_typebound_function): Catch procedure component calls for CLASS objects, check that the vtable is complete and insert the $vptr and procedure components, to make the call. (resolve_typebound_function): The same. * trans-decl.c (gfc_trans_deferred_vars): Do not deallocate an allocatable scalar if it is a result. 2010-07-19 Paul Thomas PR fortran/42385 * gfortran.dg/class_defined_operator_1.f03 : New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@162313 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index bd7363d933d..5932695a587 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3249,9 +3249,10 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) /* Deallocate when leaving the scope. Nullifying is not needed. */ - tmp = gfc_deallocate_with_status (se.expr, NULL_TREE, true, - NULL); - + tmp = NULL; + if (!sym->attr.result) + tmp = gfc_deallocate_with_status (se.expr, NULL_TREE, + true, NULL); gfc_add_init_cleanup (&try_block, gfc_finish_block (&init), tmp); } } -- cgit v1.2.1 From 89ac8ba1010f80f10f55ffe9d9445a25163266af Mon Sep 17 00:00:00 2001 From: domob Date: Wed, 21 Jul 2010 13:44:38 +0000 Subject: 2010-07-21 Daniel Kraft * trans.h (gfc_get_return_label): Removed. (gfc_generate_return): New method. (gfc_trans_deferred_vars): Update gfc_wrapped_block rather than returning a tree directly. * trans-stmt.c (gfc_trans_return): Use `gfc_generate_return'. (gfc_trans_block_construct): Update for new interface to `gfc_trans_deferred_vars'. * trans-decl.c (current_function_return_label): Removed. (current_procedure_symbol): New variable. (gfc_get_return_label): Removed. (gfc_trans_deferred_vars): Update gfc_wrapped_block rather than returning a tree directly. (get_proc_result), (gfc_generate_return): New methods. (gfc_generate_function_code): Clean up and do init/cleanup here also with gfc_wrapped_block. Remove return-label but rather return directly. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@162373 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 265 +++++++++++++++++++++++------------------------ 1 file changed, 128 insertions(+), 137 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 5932695a587..326afd76e18 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -55,8 +55,6 @@ along with GCC; see the file COPYING3. If not see static GTY(()) tree current_fake_result_decl; static GTY(()) tree parent_fake_result_decl; -static GTY(()) tree current_function_return_label; - /* Holds the variable DECLs for the current function. */ @@ -75,6 +73,9 @@ static GTY(()) tree saved_local_decls; static gfc_namespace *module_namespace; +/* The currently processed procedure symbol. */ +static gfc_symbol* current_procedure_symbol = NULL; + /* List of static constructor functions. */ @@ -237,28 +238,6 @@ gfc_build_label_decl (tree label_id) } -/* Returns the return label for the current function. */ - -tree -gfc_get_return_label (void) -{ - char name[GFC_MAX_SYMBOL_LEN + 10]; - - if (current_function_return_label) - return current_function_return_label; - - sprintf (name, "__return_%s", - IDENTIFIER_POINTER (DECL_NAME (current_function_decl))); - - current_function_return_label = - gfc_build_label_decl (get_identifier (name)); - - DECL_ARTIFICIAL (current_function_return_label) = 1; - - return current_function_return_label; -} - - /* Set the backend source location of a decl. */ void @@ -3089,18 +3068,15 @@ init_intent_out_dt (gfc_symbol * proc_sym, gfc_wrapped_block * block) Initialization of ASSIGN statement auxiliary variable. Automatic deallocation. */ -tree -gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) +void +gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) { locus loc; gfc_symbol *sym; gfc_formal_arglist *f; stmtblock_t tmpblock; - gfc_wrapped_block try_block; bool seen_trans_deferred_array = false; - gfc_start_wrapped_block (&try_block, fnbody); - /* Deal with implicit return variables. Explicit return variables will already have been added. */ if (gfc_return_by_reference (proc_sym) && proc_sym->result == proc_sym) @@ -3122,17 +3098,17 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) else if (proc_sym->as) { tree result = TREE_VALUE (current_fake_result_decl); - gfc_trans_dummy_array_bias (proc_sym, result, &try_block); + gfc_trans_dummy_array_bias (proc_sym, result, block); /* An automatic character length, pointer array result. */ if (proc_sym->ts.type == BT_CHARACTER && TREE_CODE (proc_sym->ts.u.cl->backend_decl) == VAR_DECL) - gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, &try_block); + gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, block); } else if (proc_sym->ts.type == BT_CHARACTER) { if (TREE_CODE (proc_sym->ts.u.cl->backend_decl) == VAR_DECL) - gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, &try_block); + gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, block); } else gcc_assert (gfc_option.flag_f2c @@ -3142,7 +3118,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) /* Initialize the INTENT(OUT) derived type dummy arguments. This should be done here so that the offsets and lbounds of arrays are available. */ - init_intent_out_dt (proc_sym, &try_block); + init_intent_out_dt (proc_sym, block); for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink) { @@ -3154,7 +3130,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) { case AS_EXPLICIT: if (sym->attr.dummy || sym->attr.result) - gfc_trans_dummy_array_bias (sym, sym->backend_decl, &try_block); + gfc_trans_dummy_array_bias (sym, sym->backend_decl, block); else if (sym->attr.pointer || sym->attr.allocatable) { if (TREE_STATIC (sym->backend_decl)) @@ -3162,7 +3138,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) else { seen_trans_deferred_array = true; - gfc_trans_deferred_array (sym, &try_block); + gfc_trans_deferred_array (sym, block); } } else @@ -3170,7 +3146,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) if (sym_has_alloc_comp) { seen_trans_deferred_array = true; - gfc_trans_deferred_array (sym, &try_block); + gfc_trans_deferred_array (sym, block); } else if (sym->ts.type == BT_DERIVED && sym->value @@ -3179,7 +3155,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) { gfc_start_block (&tmpblock); gfc_init_default_dt (sym, &tmpblock, false); - gfc_add_init_cleanup (&try_block, + gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock), NULL_TREE); } @@ -3187,7 +3163,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) gfc_get_backend_locus (&loc); gfc_set_backend_locus (&sym->declared_at); gfc_trans_auto_array_allocation (sym->backend_decl, - sym, &try_block); + sym, block); gfc_set_backend_locus (&loc); } break; @@ -3198,26 +3174,26 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) /* We should always pass assumed size arrays the g77 way. */ if (sym->attr.dummy) - gfc_trans_g77_array (sym, &try_block); + gfc_trans_g77_array (sym, block); break; case AS_ASSUMED_SHAPE: /* Must be a dummy parameter. */ gcc_assert (sym->attr.dummy); - gfc_trans_dummy_array_bias (sym, sym->backend_decl, &try_block); + gfc_trans_dummy_array_bias (sym, sym->backend_decl, block); break; case AS_DEFERRED: seen_trans_deferred_array = true; - gfc_trans_deferred_array (sym, &try_block); + gfc_trans_deferred_array (sym, block); break; default: gcc_unreachable (); } if (sym_has_alloc_comp && !seen_trans_deferred_array) - gfc_trans_deferred_array (sym, &try_block); + gfc_trans_deferred_array (sym, block); } else if (sym->attr.allocatable || (sym->ts.type == BT_CLASS @@ -3253,26 +3229,26 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) if (!sym->attr.result) tmp = gfc_deallocate_with_status (se.expr, NULL_TREE, true, NULL); - gfc_add_init_cleanup (&try_block, gfc_finish_block (&init), tmp); + gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp); } } else if (sym_has_alloc_comp) - gfc_trans_deferred_array (sym, &try_block); + gfc_trans_deferred_array (sym, block); else if (sym->ts.type == BT_CHARACTER) { gfc_get_backend_locus (&loc); gfc_set_backend_locus (&sym->declared_at); if (sym->attr.dummy || sym->attr.result) - gfc_trans_dummy_character (sym, sym->ts.u.cl, &try_block); + gfc_trans_dummy_character (sym, sym->ts.u.cl, block); else - gfc_trans_auto_character_variable (sym, &try_block); + gfc_trans_auto_character_variable (sym, block); gfc_set_backend_locus (&loc); } else if (sym->attr.assign) { gfc_get_backend_locus (&loc); gfc_set_backend_locus (&sym->declared_at); - gfc_trans_assign_aux_var (sym, &try_block); + gfc_trans_assign_aux_var (sym, block); gfc_set_backend_locus (&loc); } else if (sym->ts.type == BT_DERIVED @@ -3282,7 +3258,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) { gfc_start_block (&tmpblock); gfc_init_default_dt (sym, &tmpblock, false); - gfc_add_init_cleanup (&try_block, gfc_finish_block (&tmpblock), + gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock), NULL_TREE); } else @@ -3309,9 +3285,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) gfc_trans_vla_type_sizes (proc_sym, &tmpblock); } - gfc_add_init_cleanup (&try_block, gfc_finish_block (&tmpblock), NULL_TREE); - - return gfc_finish_wrapped_block (&try_block); + gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock), NULL_TREE); } static GTY ((param_is (struct module_htab_entry))) htab_t module_htab; @@ -4309,6 +4283,56 @@ create_main_function (tree fndecl) } +/* Get the result expression for a procedure. */ + +static tree +get_proc_result (gfc_symbol* sym) +{ + if (sym->attr.subroutine || sym == sym->result) + { + if (current_fake_result_decl != NULL) + return TREE_VALUE (current_fake_result_decl); + + return NULL_TREE; + } + + return sym->result->backend_decl; +} + + +/* Generate an appropriate return-statement for a procedure. */ + +tree +gfc_generate_return (void) +{ + gfc_symbol* sym; + tree result; + tree fndecl; + + sym = current_procedure_symbol; + fndecl = sym->backend_decl; + + if (TREE_TYPE (DECL_RESULT (fndecl)) == void_type_node) + result = NULL_TREE; + else + { + result = get_proc_result (sym); + + /* Set the return value to the dummy result variable. The + types may be different for scalar default REAL functions + with -ff2c, therefore we have to convert. */ + if (result != NULL_TREE) + { + result = convert (TREE_TYPE (DECL_RESULT (fndecl)), result); + result = fold_build2 (MODIFY_EXPR, TREE_TYPE (result), + DECL_RESULT (fndecl), result); + } + } + + return build1_v (RETURN_EXPR, result); +} + + /* Generate code for a function. */ void @@ -4318,16 +4342,18 @@ gfc_generate_function_code (gfc_namespace * ns) tree old_context; tree decl; tree tmp; - tree tmp2; - stmtblock_t block; + stmtblock_t init, cleanup; stmtblock_t body; - tree result; + gfc_wrapped_block try_block; tree recurcheckvar = NULL_TREE; gfc_symbol *sym; + gfc_symbol *previous_procedure_symbol; int rank; bool is_recursive; sym = ns->proc_name; + previous_procedure_symbol = current_procedure_symbol; + current_procedure_symbol = sym; /* Check that the frontend isn't still using this. */ gcc_assert (sym->tlink == NULL); @@ -4349,7 +4375,7 @@ gfc_generate_function_code (gfc_namespace * ns) trans_function_start (sym); - gfc_init_block (&block); + gfc_init_block (&init); if (ns->entries && ns->proc_name->ts.type == BT_CHARACTER) { @@ -4388,34 +4414,32 @@ gfc_generate_function_code (gfc_namespace * ns) else current_fake_result_decl = NULL_TREE; - current_function_return_label = NULL; + is_recursive = sym->attr.recursive + || (sym->attr.entry_master + && sym->ns->entries->sym->attr.recursive); + if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) + && !is_recursive + && !gfc_option.flag_recursive) + { + char * msg; + + asprintf (&msg, "Recursive call to nonrecursive procedure '%s'", + sym->name); + recurcheckvar = gfc_create_var (boolean_type_node, "is_recursive"); + TREE_STATIC (recurcheckvar) = 1; + DECL_INITIAL (recurcheckvar) = boolean_false_node; + gfc_add_expr_to_block (&init, recurcheckvar); + gfc_trans_runtime_check (true, false, recurcheckvar, &init, + &sym->declared_at, msg); + gfc_add_modify (&init, recurcheckvar, boolean_true_node); + gfc_free (msg); + } /* Now generate the code for the body of this function. */ gfc_init_block (&body); - is_recursive = sym->attr.recursive - || (sym->attr.entry_master - && sym->ns->entries->sym->attr.recursive); - if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) - && !is_recursive - && !gfc_option.flag_recursive) - { - char * msg; - - asprintf (&msg, "Recursive call to nonrecursive procedure '%s'", - sym->name); - recurcheckvar = gfc_create_var (boolean_type_node, "is_recursive"); - TREE_STATIC (recurcheckvar) = 1; - DECL_INITIAL (recurcheckvar) = boolean_false_node; - gfc_add_expr_to_block (&block, recurcheckvar); - gfc_trans_runtime_check (true, false, recurcheckvar, &block, - &sym->declared_at, msg); - gfc_add_modify (&block, recurcheckvar, boolean_true_node); - gfc_free (msg); - } - if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node - && sym->attr.subroutine) + && sym->attr.subroutine) { tree alternate_return; alternate_return = gfc_get_fake_result_decl (sym, 0); @@ -4438,29 +4462,9 @@ gfc_generate_function_code (gfc_namespace * ns) tmp = gfc_trans_code (ns->code); gfc_add_expr_to_block (&body, tmp); - /* Add a return label if needed. */ - if (current_function_return_label) - { - tmp = build1_v (LABEL_EXPR, current_function_return_label); - gfc_add_expr_to_block (&body, tmp); - } - - tmp = gfc_finish_block (&body); - /* Add code to create and cleanup arrays. */ - tmp = gfc_trans_deferred_vars (sym, tmp); - if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node) { - if (sym->attr.subroutine || sym == sym->result) - { - if (current_fake_result_decl != NULL) - result = TREE_VALUE (current_fake_result_decl); - else - result = NULL_TREE; - current_fake_result_decl = NULL_TREE; - } - else - result = sym->result->backend_decl; + tree result = get_proc_result (sym); if (result != NULL_TREE && sym->attr.function @@ -4470,24 +4474,12 @@ gfc_generate_function_code (gfc_namespace * ns) && sym->ts.u.derived->attr.alloc_comp) { rank = sym->as ? sym->as->rank : 0; - tmp2 = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank); - gfc_add_expr_to_block (&block, tmp2); + tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank); + gfc_add_expr_to_block (&init, tmp); } else if (sym->attr.allocatable && sym->attr.dimension == 0) - gfc_add_modify (&block, result, fold_convert (TREE_TYPE (result), - null_pointer_node)); - } - - gfc_add_expr_to_block (&block, tmp); - - /* Reset recursion-check variable. */ - if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) - && !is_recursive - && !gfc_option.flag_openmp - && recurcheckvar != NULL_TREE) - { - gfc_add_modify (&block, recurcheckvar, boolean_false_node); - recurcheckvar = NULL; + gfc_add_modify (&init, result, fold_convert (TREE_TYPE (result), + null_pointer_node)); } if (result == NULL_TREE) @@ -4500,31 +4492,28 @@ gfc_generate_function_code (gfc_namespace * ns) TREE_NO_WARNING(sym->backend_decl) = 1; } else - { - /* Set the return value to the dummy result variable. The - types may be different for scalar default REAL functions - with -ff2c, therefore we have to convert. */ - tmp = convert (TREE_TYPE (DECL_RESULT (fndecl)), result); - tmp = fold_build2 (MODIFY_EXPR, TREE_TYPE (tmp), - DECL_RESULT (fndecl), tmp); - tmp = build1_v (RETURN_EXPR, tmp); - gfc_add_expr_to_block (&block, tmp); - } + gfc_add_expr_to_block (&body, gfc_generate_return ()); } - else + + gfc_init_block (&cleanup); + + /* Reset recursion-check variable. */ + if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) + && !is_recursive + && !gfc_option.flag_openmp + && recurcheckvar != NULL_TREE) { - gfc_add_expr_to_block (&block, tmp); - /* Reset recursion-check variable. */ - if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) - && !is_recursive - && !gfc_option.flag_openmp - && recurcheckvar != NULL_TREE) - { - gfc_add_modify (&block, recurcheckvar, boolean_false_node); - recurcheckvar = NULL_TREE; - } + gfc_add_modify (&cleanup, recurcheckvar, boolean_false_node); + recurcheckvar = NULL; } + /* Finish the function body and add init and cleanup code. */ + tmp = gfc_finish_block (&body); + gfc_start_wrapped_block (&try_block, tmp); + /* Add code to create and cleanup arrays. */ + gfc_trans_deferred_vars (sym, &try_block); + gfc_add_init_cleanup (&try_block, gfc_finish_block (&init), + gfc_finish_block (&cleanup)); /* Add all the decls we created during processing. */ decl = saved_function_decls; @@ -4539,7 +4528,7 @@ gfc_generate_function_code (gfc_namespace * ns) } saved_function_decls = NULL_TREE; - DECL_SAVED_TREE (fndecl) = gfc_finish_block (&block); + DECL_SAVED_TREE (fndecl) = gfc_finish_wrapped_block (&try_block); decl = getdecls (); /* Finish off this function and send it for code generation. */ @@ -4590,6 +4579,8 @@ gfc_generate_function_code (gfc_namespace * ns) if (sym->attr.is_main_program) create_main_function (fndecl); + + current_procedure_symbol = previous_procedure_symbol; } -- cgit v1.2.1 From 84bfaaebbe4a0f0e0299752da56415a9756430c1 Mon Sep 17 00:00:00 2001 From: jakub Date: Fri, 23 Jul 2010 17:04:35 +0000 Subject: * tree.h (struct tree_base): Add nameless_flag bitfield. (TYPE_NAMELESS, DECL_NAMELESS): Define. * omp-low.c (create_omp_child_function, scan_omp_parallel, scan_omp_task, lower_omp_taskreg): Set DECL_NAMELESS and/or DECL_ARTIFICIAL where needed. * dwarf2out.c (dwarf2_name): Return NULL if DECL_NAMELESS. (type_tag): Return NULL if TYPE_NAMELESS or if TYPE_DECL has DECL_NAMELESS set. * trans-types.c (gfc_get_array_descriptor_base, gfc_get_array_type_bounds): Set TYPE_NAMELESS. * trans-decl.c (gfc_build_qualified_array): Set DECL_NAMELESS instead of clearing DECL_NAME. (gfc_build_dummy_array_decl): Set DECL_NAMELESS. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@162476 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-decl.c | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) (limited to 'gcc/fortran/trans-decl.c') diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 326afd76e18..2b030110231 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -759,16 +759,16 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym) gtype = build_array_type (gtype, rtype); /* Ensure the bound variables aren't optimized out at -O0. For -O1 and above they often will be optimized out, but - can be tracked by VTA. Also clear the artificial - lbound.N or ubound.N DECL_NAME, so that it doesn't end up - in debug info. */ + can be tracked by VTA. Also set DECL_NAMELESS, so that + the artificial lbound.N or ubound.N DECL_NAME doesn't + end up in debug info. */ if (lbound && TREE_CODE (lbound) == VAR_DECL && DECL_ARTIFICIAL (lbound) && DECL_IGNORED_P (lbound)) { if (DECL_NAME (lbound) && strstr (IDENTIFIER_POINTER (DECL_NAME (lbound)), "lbound") != 0) - DECL_NAME (lbound) = NULL_TREE; + DECL_NAMELESS (lbound) = 1; DECL_IGNORED_P (lbound) = 0; } if (ubound && TREE_CODE (ubound) == VAR_DECL @@ -777,7 +777,7 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym) if (DECL_NAME (ubound) && strstr (IDENTIFIER_POINTER (DECL_NAME (ubound)), "ubound") != 0) - DECL_NAME (ubound) = NULL_TREE; + DECL_NAMELESS (ubound) = 1; DECL_IGNORED_P (ubound) = 0; } } @@ -879,6 +879,7 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy) VAR_DECL, get_identifier (name), type); DECL_ARTIFICIAL (decl) = 1; + DECL_NAMELESS (decl) = 1; TREE_PUBLIC (decl) = 0; TREE_STATIC (decl) = 0; DECL_EXTERNAL (decl) = 0; -- cgit v1.2.1