From 2c41dd82e23c296681aa466693bfc726e2d919ce Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Wed, 22 Sep 2021 00:16:28 +0000 Subject: Daily bump. --- gcc/fortran/ChangeLog | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 08e7d4c..6a247c6 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,31 @@ +2021-09-21 Tobias Burnus + + PR fortran/55534 + * cpp.c: Define GCC_C_COMMON_C for #include "options.h" to make + cpp_reason_option_codes available. + (gfc_cpp_register_include_paths): Make static, set pfile's + warn_missing_include_dirs and move before caller. + (gfc_cpp_init_cb): New, cb code moved from ... + (gfc_cpp_init_0): ... here. + (gfc_cpp_post_options): Call gfc_cpp_init_cb. + (cb_cpp_diagnostic_cpp_option): New. As implemented in c-family + to match CppReason flags to -W... names. + (cb_cpp_diagnostic): Use it to replace single special case. + * cpp.h (gfc_cpp_register_include_paths): Remove as now static. + * gfortran.h (gfc_check_include_dirs): New prototype. + (gfc_add_include_path): Add new bool arg. + * options.c (gfc_init_options): Don't set -Wmissing-include-dirs. + (gfc_post_options): Set it here after commandline processing. Call + gfc_add_include_path with defer_warn=false. + (gfc_handle_option): Call it with defer_warn=true. + * scanner.c (gfc_do_check_include_dir, gfc_do_check_include_dirs, + gfc_check_include_dirs): New. Diagnostic moved from ... + (add_path_to_list): ... here, which came before cmdline processing. + Take additional bool defer_warn argument. + (gfc_add_include_path): Take additional defer_warn arg. + * scanner.h (struct gfc_directorylist): Reorder for alignment issues, + add new 'bool warn'. + 2021-09-20 Tobias Burnus * gfortran.h (gfc_omp_clauses): Add order_unconstrained. -- cgit v1.1 From 424a4a463ac5932830a83560cf929f9c2f4564d8 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 22 Sep 2021 11:11:00 +0200 Subject: Fortran: Add gfc_simple_for_loop aux function Function to generate a simple loop (to be used internally). Callers will be added in follow-up commits. gcc/fortran/ * trans-expr.c (gfc_simple_for_loop): New. * trans.h (gfc_simple_for_loop): New prototype. --- gcc/fortran/trans-expr.c | 34 ++++++++++++++++++++++++++++++++++ gcc/fortran/trans.h | 2 ++ 2 files changed, 36 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 4a81f46..41d5452 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -11728,3 +11728,37 @@ gfc_trans_assign (gfc_code * code) { return gfc_trans_assignment (code->expr1, code->expr2, false, true); } + +/* Generate a simple loop for internal use of the form + for (var = begin; var end; var += step) + body; */ +void +gfc_simple_for_loop (stmtblock_t *block, tree var, tree begin, tree end, + enum tree_code cond, tree step, tree body) +{ + tree tmp; + + /* var = begin. */ + gfc_add_modify (block, var, begin); + + /* Loop: for (var = begin; var end; var += step). */ + tree label_loop = gfc_build_label_decl (NULL_TREE); + tree label_cond = gfc_build_label_decl (NULL_TREE); + TREE_USED (label_loop) = 1; + TREE_USED (label_cond) = 1; + + gfc_add_expr_to_block (block, build1_v (GOTO_EXPR, label_cond)); + gfc_add_expr_to_block (block, build1_v (LABEL_EXPR, label_loop)); + + /* Loop body. */ + gfc_add_expr_to_block (block, body); + + /* End of loop body. */ + tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (var), var, step); + gfc_add_modify (block, var, tmp); + gfc_add_expr_to_block (block, build1_v (LABEL_EXPR, label_cond)); + tmp = fold_build2_loc (input_location, cond, boolean_type_node, var, end); + tmp = build3_v (COND_EXPR, tmp, build1_v (GOTO_EXPR, label_loop), + build_empty_stmt (input_location)); + gfc_add_expr_to_block (block, tmp); +} diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 78578cf..4d29834 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -518,6 +518,8 @@ tree gfc_string_to_single_character (tree len, tree str, int kind); tree gfc_get_tree_for_caf_expr (gfc_expr *); void gfc_get_caf_token_offset (gfc_se*, tree *, tree *, tree, tree, gfc_expr *); tree gfc_caf_get_image_index (stmtblock_t *, gfc_expr *, tree); +void gfc_simple_for_loop (stmtblock_t *, tree, tree, tree, enum tree_code, tree, + tree); /* Find the decl containing the auxiliary variables for assigned variables. */ void gfc_conv_label_variable (gfc_se * se, gfc_expr * expr); -- cgit v1.1 From 83aac698835edcdb3e6d96b856bef1c5f92e5e24 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 22 Sep 2021 20:58:35 +0200 Subject: Fortran: Improve -Wmissing-include-dirs warnings [PR55534] MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit It turned out that enabling the -Wmissing-include-dirs for libcpp did output too many warnings – at least as run with -B and similar options during the GCC build and warning for internal include dirs like finclude, unlikely of relevance to for a real-world user. This patch now only warns for -I and -J by default but permits to get the full warnings including libcpp ones with -Wmissing-include-dirs. It additionally documents this in the manual. With that change, the -Wno-missing-include-dirs could be removed from libgfortran's configure and libgomp's testsuite always cflags. This reverts those bits of the previous commit r12-3722-g417ea5c02cef7f000e66d1af22b066c2c1cda047 Additionally, it turned out that all call to load_file called exit explicitly - except for the main file via gfc_init -> gfc_new_file. The latter also output a file not existing fatal error, such that two errors where printed. Now exit is called in line with the other users of load_file. Finally, when compileing with "nonexisting/file.f90", first a warning that "nonexisting" does not exist as include path was printed before the file not found error was printed. Now the directory in which the physical file is located is added silently, relying on the file-not-found diagnostic for those. PR fortran/55534 gcc/ChangeLog: * doc/invoke.texi (-Wno-missing-include-dirs.): Document Fortran behavior. gcc/fortran/ChangeLog: * cpp.c (gfc_cpp_register_include_paths, gfc_cpp_post_options): Add new bool verbose_missing_dir_warn argument. * cpp.h (gfc_cpp_post_options): Update prototype. * f95-lang.c (gfc_init): Remove duplicated file-not found diag. * gfortran.h (gfc_check_include_dirs): Takes bool verbose_missing_dir_warn arg. (gfc_new_file): Returns now void. * options.c (gfc_post_options): Update to warn for -I and -J, only, by default but for all when user requested. * scanner.c (gfc_do_check_include_dir): (gfc_do_check_include_dirs, gfc_check_include_dirs): Take bool verbose warn arg and update to avoid printing the same message twice or never. (load_file): Fix indent. (gfc_new_file): Return void and exit when load_file failed as all other load_file users do. libgfortran/ChangeLog: * configure.ac (AM_FCFLAGS): Revert r12-3722 by removing -Wno-missing-include-dirs. * configure: Regenerate. libgomp/ChangeLog: * testsuite/libgomp.fortran/fortran.exp (ALWAYS_CFLAGS): Revert r12-3722 by removing -Wno-missing-include-dirs. * testsuite/libgomp.oacc-fortran/fortran.exp (ALWAYS_CFLAGS): Likewise. gcc/testsuite/ChangeLog: * gfortran.dg/include_14.f90: Add -J testcase and update dg-output. * gfortran.dg/include_15.f90: Likewise. * gfortran.dg/include_16.f90: Likewise. * gfortran.dg/include_17.f90: Likewise. * gfortran.dg/include_18.f90: Likewise. * gfortran.dg/include_19.f90: Likewise. --- gcc/fortran/cpp.c | 9 +++++---- gcc/fortran/cpp.h | 2 +- gcc/fortran/f95-lang.c | 4 ++-- gcc/fortran/gfortran.h | 4 ++-- gcc/fortran/options.c | 19 ++++++++++++++----- gcc/fortran/scanner.c | 27 +++++++++++++++++---------- 6 files changed, 41 insertions(+), 24 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/cpp.c b/gcc/fortran/cpp.c index 3ff8954..e86386c 100644 --- a/gcc/fortran/cpp.c +++ b/gcc/fortran/cpp.c @@ -245,11 +245,12 @@ gfc_cpp_temporary_file (void) } static void -gfc_cpp_register_include_paths (void) +gfc_cpp_register_include_paths (bool verbose_missing_dir_warn) { int cxx_stdinc = 0; cpp_get_options (cpp_in)->warn_missing_include_dirs - = global_options.x_cpp_warn_missing_include_dirs; + = (global_options.x_cpp_warn_missing_include_dirs + && verbose_missing_dir_warn); register_include_chains (cpp_in, gfc_cpp_option.sysroot, gfc_cpp_option.prefix, gfc_cpp_option.multilib, gfc_cpp_option.standard_include_paths, cxx_stdinc, @@ -484,7 +485,7 @@ gfc_cpp_init_cb (void) } void -gfc_cpp_post_options (void) +gfc_cpp_post_options (bool verbose_missing_dir_warn) { /* Any preprocessing-related option without '-cpp' is considered an error. */ @@ -547,7 +548,7 @@ gfc_cpp_post_options (void) diagnostic_initialize_input_context (global_dc, nullptr, true); gfc_cpp_init_cb (); - gfc_cpp_register_include_paths (); + gfc_cpp_register_include_paths (verbose_missing_dir_warn); } diff --git a/gcc/fortran/cpp.h b/gcc/fortran/cpp.h index 5cb7e5a..44644a2 100644 --- a/gcc/fortran/cpp.h +++ b/gcc/fortran/cpp.h @@ -41,7 +41,7 @@ void gfc_cpp_init_options (unsigned int decoded_options_count, int gfc_cpp_handle_option(size_t scode, const char *arg, int value); -void gfc_cpp_post_options (void); +void gfc_cpp_post_options (bool); bool gfc_cpp_preprocess (const char *source_file); diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c index 026228d..58dcaf0 100644 --- a/gcc/fortran/f95-lang.c +++ b/gcc/fortran/f95-lang.c @@ -259,8 +259,8 @@ gfc_init (void) gfc_init_1 (); - if (!gfc_new_file ()) - fatal_error (input_location, "cannot open input file: %s", gfc_source_file); + /* Calls exit in case of a fail. */ + gfc_new_file (); if (flag_preprocess_only) return false; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 3c7a843..7ef835b 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3032,7 +3032,7 @@ void gfc_scanner_init_1 (void); void gfc_add_include_path (const char *, bool, bool, bool, bool); void gfc_add_intrinsic_modules_path (const char *); void gfc_release_include_path (void); -void gfc_check_include_dirs (void); +void gfc_check_include_dirs (bool); FILE *gfc_open_included_file (const char *, bool, bool); int gfc_at_end (void); @@ -3064,7 +3064,7 @@ gfc_char_t gfc_peek_char (void); char gfc_peek_ascii_char (void); void gfc_error_recovery (void); void gfc_gobble_whitespace (void); -bool gfc_new_file (void); +void gfc_new_file (void); const char * gfc_read_orig_filename (const char *, const char **); extern gfc_source_form gfc_current_form; diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c index d789397..016b704 100644 --- a/gcc/fortran/options.c +++ b/gcc/fortran/options.c @@ -251,14 +251,20 @@ gfc_post_options (const char **pfilename) { const char *filename = *pfilename, *canon_source_file = NULL; char *source_path; + bool verbose_missing_dir_warn; int i; /* This needs to be after the commandline has been processed. In Fortran, the options is by default enabled, in C/C++ - by default disabled. */ + by default disabled. + If not enabled explicitly by the user, only warn for -I + and -J, otherwise warn for all include paths. */ + verbose_missing_dir_warn + = (global_options_set.x_cpp_warn_missing_include_dirs + && global_options.x_cpp_warn_missing_include_dirs); SET_OPTION_IF_UNSET (&global_options, &global_options_set, cpp_warn_missing_include_dirs, 1); - gfc_check_include_dirs (); + gfc_check_include_dirs (verbose_missing_dir_warn); /* Finalize DEC flags. */ post_dec_flags (flag_dec); @@ -339,10 +345,13 @@ gfc_post_options (const char **pfilename) source_path = (char *) alloca (i + 1); memcpy (source_path, canon_source_file, i); source_path[i] = 0; - gfc_add_include_path (source_path, true, true, true, false); + /* Only warn if the directory is different from the input file as + if that one is not found, already an error is shown. */ + bool warn = gfc_option.flag_preprocessed && gfc_source_file != filename; + gfc_add_include_path (source_path, true, true, warn, false); } else - gfc_add_include_path (".", true, true, true, false); + gfc_add_include_path (".", true, true, false, false); if (canon_source_file != gfc_source_file) free (CONST_CAST (char *, canon_source_file)); @@ -490,7 +499,7 @@ gfc_post_options (const char **pfilename) gfc_fatal_error ("Maximum subrecord length cannot exceed %d", MAX_SUBRECORD_LENGTH); - gfc_cpp_post_options (); + gfc_cpp_post_options (verbose_missing_dir_warn); if (gfc_option.allow_std & GFC_STD_F2008) lang_hooks.name = "GNU Fortran2008"; diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c index 6fe74bd..52124bd 100644 --- a/gcc/fortran/scanner.c +++ b/gcc/fortran/scanner.c @@ -307,9 +307,9 @@ gfc_do_check_include_dir (const char *path, bool warn) if (errno != ENOENT) gfc_warning_now (0, "Include directory %qs: %s", path, xstrerror(errno)); - else if (warn && !gfc_cpp_enabled ()) + else if (warn) gfc_warning_now (OPT_Wmissing_include_dirs, - "Nonexistent include directory %qs", path); + "Nonexistent include directory %qs", path); return false; } else if (!S_ISDIR (st.st_mode)) @@ -323,7 +323,7 @@ gfc_do_check_include_dir (const char *path, bool warn) /* In order that -W(no-)missing-include-dirs works, the diagnostic can only be run after processing the commandline. */ static void -gfc_do_check_include_dirs (gfc_directorylist **list) +gfc_do_check_include_dirs (gfc_directorylist **list, bool do_warn) { gfc_directorylist *prev, *q, *n; prev = NULL; @@ -331,7 +331,7 @@ gfc_do_check_include_dirs (gfc_directorylist **list) while (n) { q = n; n = n->next; - if (gfc_do_check_include_dir (q->path, q->warn)) + if (gfc_do_check_include_dir (q->path, q->warn && do_warn)) { prev = q; continue; @@ -346,10 +346,16 @@ gfc_do_check_include_dirs (gfc_directorylist **list) } void -gfc_check_include_dirs () +gfc_check_include_dirs (bool verbose_missing_dir_warn) { - gfc_do_check_include_dirs (&include_dirs); - gfc_do_check_include_dirs (&intrinsic_modules_dirs); + /* This is a bit convoluted: If gfc_cpp_enabled () and + verbose_missing_dir_warn, the warning is shown by libcpp. Otherwise, + it is shown here, still conditional on OPT_Wmissing_include_dirs. */ + bool warn = !gfc_cpp_enabled () || !verbose_missing_dir_warn; + gfc_do_check_include_dirs (&include_dirs, warn); + gfc_do_check_include_dirs (&intrinsic_modules_dirs, verbose_missing_dir_warn); + if (gfc_option.module_dir && gfc_cpp_enabled ()) + gfc_do_check_include_dirs (&include_dirs, true); } /* Adds path to the list pointed to by list. */ @@ -2771,7 +2777,7 @@ load_file (const char *realfilename, const char *displayedname, bool initial) it tries to determine the source form from the filename, defaulting to free form. */ -bool +void gfc_new_file (void) { bool result; @@ -2789,6 +2795,9 @@ gfc_new_file (void) else result = load_file (gfc_source_file, NULL, true); + if (!result) + exit (FATAL_EXIT_CODE); + gfc_current_locus.lb = line_head; gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line; @@ -2799,8 +2808,6 @@ gfc_new_file (void) exit (SUCCESS_EXIT_CODE); #endif - - return result; } static char * -- cgit v1.1 From 8fa9e73e6db0ff05447f5547df925fdcb4733d05 Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Sun, 19 Sep 2021 17:23:58 -0700 Subject: Fortran: Fix testcases that violate C838, + revealed ICE The three test cases fixed in this patch violated F2018 C838, which only allows passing an assumed-rank argument to an assumed-rank dummy. Wrapping the call in "select rank" revealed a null pointer dereference which is fixed by guarding the use of the result of GFC_DECL_SAVED_DESCRIPTOR similar to what is already done elsewhere. 2021-09-19 Sandra Loosemore gcc/fortran/ * trans-stmt.c (trans_associate_var): Check that result of GFC_DECL_SAVED_DESCRIPTOR is not null before using it. gcc/testsuite/ * gfortran.dg/assumed_rank_18.f90 (g): Wrap call to h in select rank. * gfortran.dg/assumed_type_10.f90 (test_array): Likewise for call to test_lib. * gfortran.dg/assumed_type_11.f90 (test_array): Likewise. --- gcc/fortran/trans-stmt.c | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 11df186..a8ff473 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -1788,9 +1788,10 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) /* Go straight to the class data. */ if (sym2->attr.dummy && !sym2->attr.optional) { - class_decl = DECL_LANG_SPECIFIC (sym2->backend_decl) ? - GFC_DECL_SAVED_DESCRIPTOR (sym2->backend_decl) : - sym2->backend_decl; + class_decl = sym2->backend_decl; + if (DECL_LANG_SPECIFIC (class_decl) + && GFC_DECL_SAVED_DESCRIPTOR (class_decl)) + class_decl = GFC_DECL_SAVED_DESCRIPTOR (class_decl); if (POINTER_TYPE_P (TREE_TYPE (class_decl))) class_decl = build_fold_indirect_ref_loc (input_location, class_decl); -- cgit v1.1 From 7a40f2e74815a926c5f47416c29efbc17aa1ef43 Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Sun, 19 Sep 2021 17:32:03 -0700 Subject: Fortran: Fixes for F2018 C838 (PR fortran/101334) The compiler was failing to diagnose the error required by F2018 C838 when passing an assumed-rank array argument to a non-assumed-rank dummy. It was also incorrectly giving an error for calls to the 2-argument form of the ASSOCIATED intrinsic, which is supposed to be permitted by C838. 2021-09-19 Sandra Loosemore PR fortran/101334 gcc/fortran/ * check.c (gfc_check_associated): Allow an assumed-rank array for the pointer argument. * interface.c (compare_parameter): Also give rank mismatch error on assumed-rank array. gcc/testsuite/ * gfortran.dg/c-interop/c535b-2.f90: Remove xfails. * gfortran.dg/c-interop/c535b-3.f90: Likewise. --- gcc/fortran/check.c | 4 +++- gcc/fortran/interface.c | 4 +++- 2 files changed, 6 insertions(+), 2 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 851af1b..f31ad68 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -1520,7 +1520,9 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target) t = true; if (!same_type_check (pointer, 0, target, 1, true)) t = false; - if (!rank_check (target, 0, pointer->rank)) + /* F2018 C838 explicitly allows an assumed-rank variable as the first + argument of intrinsic inquiry functions. */ + if (pointer->rank != -1 && !rank_check (target, 0, pointer->rank)) t = false; if (target->rank > 0) { diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 9e3e8aa..f9a7c9c 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -2634,7 +2634,9 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, && formal->as->type == AS_ASSUMED_SHAPE)) && actual->expr_type != EXPR_NULL) || (actual->rank == 0 && formal->attr.dimension - && gfc_is_coindexed (actual))) + && gfc_is_coindexed (actual)) + /* Assumed-rank actual argument; F2018 C838. */ + || actual->rank == -1) { if (where && (!formal->attr.artificial || (!formal->maybe_array -- cgit v1.1 From 5098e7077bfcace3e80144e63c81be94546ced16 Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Wed, 22 Sep 2021 07:49:17 -0700 Subject: Fortran: diagnostic for argument w/type parameters for assumed-type dummy 2021-09-22 Sandra Loosemore PR fortran/101319 gcc/fortran/ * interface.c (gfc_compare_actual_formal): Extend existing assumed-type diagnostic to also check for argument with type parameters. gcc/testsuite/ * gfortran.dg/c-interop/assumed-type-dummy.f90: Remove xfail. --- gcc/fortran/interface.c | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index f9a7c9c..dae4b95 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -3183,21 +3183,21 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, is_elemental, where)) return false; - /* TS 29113, 6.3p2. */ + /* TS 29113, 6.3p2; F2018 15.5.2.4. */ if (f->sym->ts.type == BT_ASSUMED && (a->expr->ts.type == BT_DERIVED || (a->expr->ts.type == BT_CLASS && CLASS_DATA (a->expr)))) { - gfc_namespace *f2k_derived; - - f2k_derived = a->expr->ts.type == BT_DERIVED - ? a->expr->ts.u.derived->f2k_derived - : CLASS_DATA (a->expr)->ts.u.derived->f2k_derived; - - if (f2k_derived - && (f2k_derived->finalizers || f2k_derived->tb_sym_root)) + gfc_symbol *derived = (a->expr->ts.type == BT_DERIVED + ? a->expr->ts.u.derived + : CLASS_DATA (a->expr)->ts.u.derived); + gfc_namespace *f2k_derived = derived->f2k_derived; + if (derived->attr.pdt_type + || (f2k_derived + && (f2k_derived->finalizers || f2k_derived->tb_sym_root))) { - gfc_error ("Actual argument at %L to assumed-type dummy is of " + gfc_error ("Actual argument at %L to assumed-type dummy " + "has type parameters or is of " "derived type with type-bound or FINAL procedures", &a->expr->where); return false; -- cgit v1.1 From e4777439fc77465b4cf89b6bfeb47cd00329cb20 Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Thu, 23 Sep 2021 00:16:29 +0000 Subject: Daily bump. --- gcc/fortran/ChangeLog | 45 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6a247c6..f96198d5 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,48 @@ +2021-09-23 Sandra Loosemore + + PR fortran/101319 + * interface.c (gfc_compare_actual_formal): Extend existing + assumed-type diagnostic to also check for argument with type + parameters. + +2021-09-23 Sandra Loosemore + + PR fortran/101334 + * check.c (gfc_check_associated): Allow an assumed-rank + array for the pointer argument. + * interface.c (compare_parameter): Also give rank mismatch + error on assumed-rank array. + +2021-09-23 Sandra Loosemore + + * trans-stmt.c (trans_associate_var): Check that result of + GFC_DECL_SAVED_DESCRIPTOR is not null before using it. + +2021-09-22 Tobias Burnus + + PR fortran/55534 + * cpp.c (gfc_cpp_register_include_paths, gfc_cpp_post_options): + Add new bool verbose_missing_dir_warn argument. + * cpp.h (gfc_cpp_post_options): Update prototype. + * f95-lang.c (gfc_init): Remove duplicated file-not found diag. + * gfortran.h (gfc_check_include_dirs): Takes bool + verbose_missing_dir_warn arg. + (gfc_new_file): Returns now void. + * options.c (gfc_post_options): Update to warn for -I and -J, + only, by default but for all when user requested. + * scanner.c (gfc_do_check_include_dir): + (gfc_do_check_include_dirs, gfc_check_include_dirs): Take bool + verbose warn arg and update to avoid printing the same message + twice or never. + (load_file): Fix indent. + (gfc_new_file): Return void and exit when load_file failed + as all other load_file users do. + +2021-09-22 Tobias Burnus + + * trans-expr.c (gfc_simple_for_loop): New. + * trans.h (gfc_simple_for_loop): New prototype. + 2021-09-21 Tobias Burnus PR fortran/55534 -- cgit v1.1 From 1b07d9dce6c51c98d011236c3d4cd84a2ed59ba2 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Thu, 23 Sep 2021 18:47:45 +0200 Subject: Fortran: Handle allocated() with coindexed scalars [PR93834] While for an allocatable 'array', 'array(:)' and 'array(:)[1]' are not allocatable, it is believed that not only 'scalar' but also 'scalar[1]' is allocatable. However, coarrays are collectively established/allocated; thus, 'allocated(scalar[i])' is equivalent to 'allocated(scalar)'. [At least when assuming that 'i' does not refer to a failed image.] 2021-09-23 Harald Anlauf Tobias Burnus PR fortran/93834 gcc/fortran/ChangeLog: * trans-intrinsic.c (gfc_conv_allocated): Cleanup. Handle coindexed scalar coarrays. gcc/testsuite/ChangeLog: * gfortran.dg/coarray/coarray_allocated.f90: New test. --- gcc/fortran/trans-intrinsic.c | 55 ++++++++++++++++++++++++++----------------- 1 file changed, 34 insertions(+), 21 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 42a995b..612ca41 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -8887,50 +8887,63 @@ caf_this_image_ref (gfc_ref *ref) static void gfc_conv_allocated (gfc_se *se, gfc_expr *expr) { - gfc_actual_arglist *arg1; gfc_se arg1se; tree tmp; - symbol_attribute caf_attr; + bool coindexed_caf_comp = false; + gfc_expr *e = expr->value.function.actual->expr; gfc_init_se (&arg1se, NULL); - arg1 = expr->value.function.actual; - - if (arg1->expr->ts.type == BT_CLASS) + if (e->ts.type == BT_CLASS) { /* Make sure that class array expressions have both a _data component reference and an array reference.... */ - if (CLASS_DATA (arg1->expr)->attr.dimension) - gfc_add_class_array_ref (arg1->expr); + if (CLASS_DATA (e)->attr.dimension) + gfc_add_class_array_ref (e); /* .... whilst scalars only need the _data component. */ else - gfc_add_data_component (arg1->expr); + gfc_add_data_component (e); } - /* When arg1 references an allocatable component in a coarray, then call + /* When 'e' references an allocatable component in a coarray, then call the caf-library function caf_is_present (). */ - if (flag_coarray == GFC_FCOARRAY_LIB && arg1->expr->expr_type == EXPR_FUNCTION - && arg1->expr->value.function.isym - && arg1->expr->value.function.isym->id == GFC_ISYM_CAF_GET) - caf_attr = gfc_caf_attr (arg1->expr->value.function.actual->expr); - else - gfc_clear_attr (&caf_attr); - if (flag_coarray == GFC_FCOARRAY_LIB && caf_attr.codimension - && !caf_this_image_ref (arg1->expr->value.function.actual->expr->ref)) - tmp = trans_caf_is_present (se, arg1->expr->value.function.actual->expr); + if (flag_coarray == GFC_FCOARRAY_LIB && e->expr_type == EXPR_FUNCTION + && e->value.function.isym + && e->value.function.isym->id == GFC_ISYM_CAF_GET) + { + e = e->value.function.actual->expr; + if (gfc_expr_attr (e).codimension) + { + /* Last partref is the coindexed coarray. As coarrays are collectively + (de)allocated, the allocation status must be the same as the one of + the local allocation. Convert to local access. */ + for (gfc_ref *ref = e->ref; ref; ref = ref->next) + if (ref->type == REF_ARRAY && ref->u.ar.codimen) + { + for (int i = ref->u.ar.dimen; + i < ref->u.ar.dimen + ref->u.ar.codimen; ++i) + ref->u.ar.dimen_type[i] = DIMEN_THIS_IMAGE; + break; + } + } + else if (!caf_this_image_ref (e->ref)) + coindexed_caf_comp = true; + } + if (coindexed_caf_comp) + tmp = trans_caf_is_present (se, e); else { - if (arg1->expr->rank == 0) + if (e->rank == 0) { /* Allocatable scalar. */ arg1se.want_pointer = 1; - gfc_conv_expr (&arg1se, arg1->expr); + gfc_conv_expr (&arg1se, e); tmp = arg1se.expr; } else { /* Allocatable array. */ arg1se.descriptor_only = 1; - gfc_conv_expr_descriptor (&arg1se, arg1->expr); + gfc_conv_expr_descriptor (&arg1se, e); tmp = gfc_conv_descriptor_data_get (arg1se.expr); } -- cgit v1.1 From 2646d0e06b170569be1da28fce1d6e2f03a15f60 Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Thu, 23 Sep 2021 08:03:52 -0700 Subject: Fortran: Diagnose default-initialized pointer/allocatable dummies TS29113 changed what was then C516 in the 2010 Fortran standard (now C1557 in F2018) from disallowing all of pointer, allocatable, and optional attributes on dummy arguments to BIND(C) functions, to disallowing only pointer/allocatable with default-initialization. gfortran was previously failing to diagnose violations of this constraint. 2021-09-23 Sandra Loosemore PR fortran/101320 gcc/fortran/ * decl.c (gfc_verify_c_interop_param): Handle F2018 C1557, aka TS29113 C516. gcc/testsuite/ * gfortran.dg/c-interop/c516.f90: Remove xfails. Add more tests. --- gcc/fortran/decl.c | 14 ++++++++++++++ 1 file changed, 14 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index f2e8896..b3c65b7 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1557,6 +1557,20 @@ gfc_verify_c_interop_param (gfc_symbol *sym) "CONTIGUOUS attribute as procedure %qs is BIND(C)", sym->name, &sym->declared_at, sym->ns->proc_name->name); + /* Per F2018, C1557, pointer/allocatable dummies to a bind(c) + procedure that are default-initialized are not permitted. */ + if ((sym->attr.pointer || sym->attr.allocatable) + && sym->ts.type == BT_DERIVED + && gfc_has_default_initializer (sym->ts.u.derived)) + { + gfc_error ("Default-initialized %s dummy argument %qs " + "at %L is not permitted in BIND(C) procedure %qs", + (sym->attr.pointer ? "pointer" : "allocatable"), + sym->name, &sym->declared_at, + sym->ns->proc_name->name); + retval = false; + } + /* Character strings are only C interoperable if they have a length of 1. However, as an argument they are also iteroperable when passed as descriptor (which requires len=: or len=*). */ -- cgit v1.1 From 391b23e02bf29a103422f54ed034650afa99152b Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Fri, 24 Sep 2021 00:16:23 +0000 Subject: Daily bump. --- gcc/fortran/ChangeLog | 13 +++++++++++++ 1 file changed, 13 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f96198d5..42c3cbe 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,18 @@ 2021-09-23 Sandra Loosemore + PR fortran/101320 + * decl.c (gfc_verify_c_interop_param): Handle F2018 C1557, + aka TS29113 C516. + +2021-09-23 Harald Anlauf + Tobias Burnus + + PR fortran/93834 + * trans-intrinsic.c (gfc_conv_allocated): Cleanup. Handle + coindexed scalar coarrays. + +2021-09-23 Sandra Loosemore + PR fortran/101319 * interface.c (gfc_compare_actual_formal): Extend existing assumed-type diagnostic to also check for argument with type -- cgit v1.1 From 204f56aa65d2496e9f7db86c4aa37d42a336fc5b Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 24 Sep 2021 09:30:51 +0200 Subject: Fortran: Improve file-reading error diagnostic [PR55534] PR fortran/55534 gcc/fortran/ChangeLog: * scanner.c (load_file): Return void, call (gfc_)fatal_error for all errors. (include_line, include_stmt, gfc_new_file): Remove exit call for failed load_file run. gcc/testsuite/ChangeLog: * gfortran.dg/include_9.f90: Add dg-prune-output. * gfortran.dg/include_23.f90: New test. * gfortran.dg/include_24.f90: New test. --- gcc/fortran/scanner.c | 66 +++++++++++++++++++-------------------------------- 1 file changed, 24 insertions(+), 42 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c index 52124bd..5a45069 100644 --- a/gcc/fortran/scanner.c +++ b/gcc/fortran/scanner.c @@ -47,6 +47,7 @@ along with GCC; see the file COPYING3. If not see #include "toplev.h" /* For set_src_pwd. */ #include "debug.h" #include "options.h" +#include "diagnostic-core.h" /* For fatal_error. */ #include "cpp.h" #include "scanner.h" @@ -2230,7 +2231,7 @@ preprocessor_line (gfc_char_t *c) } -static bool load_file (const char *, const char *, bool); +static void load_file (const char *, const char *, bool); /* include_line()-- Checks a line buffer to see if it is an include line. If so, we call load_file() recursively to load the included @@ -2396,9 +2397,7 @@ include_line (gfc_char_t *line) read by anything else. */ filename = gfc_widechar_to_char (begin, -1); - if (!load_file (filename, NULL, false)) - exit (FATAL_EXIT_CODE); - + load_file (filename, NULL, false); free (filename); return 1; } @@ -2505,9 +2504,7 @@ include_stmt (gfc_linebuf *b) filename[i] = (unsigned char) c; } filename[length] = '\0'; - if (!load_file (filename, NULL, false)) - exit (FATAL_EXIT_CODE); - + load_file (filename, NULL, false); free (filename); do_ret: @@ -2525,9 +2522,11 @@ do_ret: return ret; } + + /* Load a file into memory by calling load_line until the file ends. */ -static bool +static void load_file (const char *realfilename, const char *displayedname, bool initial) { gfc_char_t *line; @@ -2549,13 +2548,8 @@ load_file (const char *realfilename, const char *displayedname, bool initial) for (f = current_file; f; f = f->up) if (filename_cmp (filename, f->filename) == 0) - { - fprintf (stderr, "%s:%d: Error: File '%s' is being included " - "recursively\n", current_file->filename, current_file->line, - filename); - return false; - } - + fatal_error (linemap_line_start (line_table, current_file->line, 0), + "File %qs is being included recursively", filename); if (initial) { if (gfc_src_file) @@ -2567,10 +2561,7 @@ load_file (const char *realfilename, const char *displayedname, bool initial) input = gfc_open_file (realfilename); if (input == NULL) - { - gfc_error_now ("Cannot open file %qs", filename); - return false; - } + gfc_fatal_error ("Cannot open file %qs", filename); } else { @@ -2579,22 +2570,20 @@ load_file (const char *realfilename, const char *displayedname, bool initial) { /* For -fpre-include file, current_file is NULL. */ if (current_file) - fprintf (stderr, "%s:%d: Error: Can't open included file '%s'\n", - current_file->filename, current_file->line, filename); + fatal_error (linemap_line_start (line_table, current_file->line, 0), + "Cannot open included file %qs", filename); else - fprintf (stderr, "Error: Can't open pre-included file '%s'\n", - filename); - - return false; + gfc_fatal_error ("Cannot open pre-included file %qs", filename); } stat_result = stat (realfilename, &st); - if (stat_result == 0 && !S_ISREG(st.st_mode)) + if (stat_result == 0 && !S_ISREG (st.st_mode)) { - fprintf (stderr, "%s:%d: Error: Included path '%s'" - " is not a regular file\n", - current_file->filename, current_file->line, filename); fclose (input); - return false; + if (current_file) + fatal_error (linemap_line_start (line_table, current_file->line, 0), + "Included file %qs is not a regular file", filename); + else + gfc_fatal_error ("Included file %qs is not a regular file", filename); } } @@ -2768,7 +2757,6 @@ load_file (const char *realfilename, const char *displayedname, bool initial) add_file_change (NULL, current_file->inclusion_line + 1); current_file = current_file->up; linemap_add (line_table, LC_LEAVE, 0, NULL, 0); - return true; } @@ -2780,23 +2768,17 @@ load_file (const char *realfilename, const char *displayedname, bool initial) void gfc_new_file (void) { - bool result; - - if (flag_pre_include != NULL - && !load_file (flag_pre_include, NULL, false)) - exit (FATAL_EXIT_CODE); + if (flag_pre_include != NULL) + load_file (flag_pre_include, NULL, false); if (gfc_cpp_enabled ()) { - result = gfc_cpp_preprocess (gfc_source_file); + gfc_cpp_preprocess (gfc_source_file); if (!gfc_cpp_preprocess_only ()) - result = load_file (gfc_cpp_temporary_file (), gfc_source_file, true); + load_file (gfc_cpp_temporary_file (), gfc_source_file, true); } else - result = load_file (gfc_source_file, NULL, true); - - if (!result) - exit (FATAL_EXIT_CODE); + load_file (gfc_source_file, NULL, true); gfc_current_locus.lb = line_head; gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line; -- cgit v1.1 From 2364250eccc389a5f9820ac55f8260d34f229e73 Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Thu, 23 Sep 2021 15:00:43 -0700 Subject: Fortran: Add missing diagnostic for F2018 C711 (TS29113 C407c) 2021-09-24 Sandra Loosemore PR fortran/101333 gcc/fortran/ * interface.c (compare_parameter): Enforce F2018 C711. gcc/testsuite/ * gfortran.dg/c-interop/c407c-1.f90: Remove xfails. --- gcc/fortran/interface.c | 15 +++++++++++++++ 1 file changed, 15 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index dae4b95..a2fea0e 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -2448,6 +2448,21 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, return false; } + /* TS29113 C407c; F2018 C711. */ + if (actual->ts.type == BT_ASSUMED + && symbol_rank (formal) == -1 + && actual->rank != -1 + && !(actual->symtree->n.sym->as + && actual->symtree->n.sym->as->type == AS_ASSUMED_SHAPE)) + { + if (where) + gfc_error ("Assumed-type actual argument at %L corresponding to " + "assumed-rank dummy argument %qs must be " + "assumed-shape or assumed-rank", + &actual->where, formal->name); + return false; + } + /* F2008, 12.5.2.5; IR F08/0073. */ if (formal->ts.type == BT_CLASS && formal->attr.class_ok && actual->expr_type != EXPR_NULL -- cgit v1.1 From 84cccff60a978174271a30042bf7841d2ae436eb Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Fri, 24 Sep 2021 19:10:15 +0200 Subject: Fortran - improve checking for intrinsics allowed in constant expressions gcc/fortran/ChangeLog: PR fortran/102458 * expr.c (is_non_constant_intrinsic): Check for intrinsics excluded in constant expressions (F2018:10.1.2). (gfc_is_constant_expr): Use that check. gcc/testsuite/ChangeLog: PR fortran/102458 * gfortran.dg/pr102458.f90: New test. --- gcc/fortran/expr.c | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 604e63e..5ad1c4f 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -990,6 +990,34 @@ done: } +/* Standard intrinsics listed under F2018:10.1.2 (6), which are excluded in + constant expressions, except TRANSFER (c.f. item (8)), which would need + separate treatment. */ + +static bool +is_non_constant_intrinsic (gfc_expr *e) +{ + if (e->expr_type == EXPR_FUNCTION + && e->value.function.isym) + { + switch (e->value.function.isym->id) + { + case GFC_ISYM_COMMAND_ARGUMENT_COUNT: + case GFC_ISYM_GET_TEAM: + case GFC_ISYM_NULL: + case GFC_ISYM_NUM_IMAGES: + case GFC_ISYM_TEAM_NUMBER: + case GFC_ISYM_THIS_IMAGE: + return true; + + default: + return false; + } + } + return false; +} + + /* Determine if an expression is constant in the sense of F08:7.1.12. * This function expects that the expression has already been simplified. */ @@ -1023,6 +1051,10 @@ gfc_is_constant_expr (gfc_expr *e) gcc_assert (e->symtree || e->value.function.esym || e->value.function.isym); + /* Check for intrinsics excluded in constant expressions. */ + if (e->value.function.isym && is_non_constant_intrinsic (e)) + return false; + /* Call to intrinsic with at least one argument. */ if (e->value.function.isym && e->value.function.actual) { -- cgit v1.1 From 9a4293ed9bdd029dd44d19b412b1cdf12372801e Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Sat, 25 Sep 2021 00:16:20 +0000 Subject: Daily bump. --- gcc/fortran/ChangeLog | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 42c3cbe..6f8b469 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,23 @@ +2021-09-24 Harald Anlauf + + PR fortran/102458 + * expr.c (is_non_constant_intrinsic): Check for intrinsics + excluded in constant expressions (F2018:10.1.2). + (gfc_is_constant_expr): Use that check. + +2021-09-24 Sandra Loosemore + + PR fortran/101333 + * interface.c (compare_parameter): Enforce F2018 C711. + +2021-09-24 Tobias Burnus + + PR fortran/55534 + * scanner.c (load_file): Return void, call (gfc_)fatal_error for + all errors. + (include_line, include_stmt, gfc_new_file): Remove exit call + for failed load_file run. + 2021-09-23 Sandra Loosemore PR fortran/101320 -- cgit v1.1 From fe2771b291c2c7c0ac37b75ec5b160937524b60c Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sun, 26 Sep 2021 19:26:01 +0200 Subject: Fortran: Fix associated intrinsic with assumed rank [PR101334] ASSOCIATE (ptr, tgt) takes as first argument also an assumed-rank array; however, using it together with a tgt (required to be non assumed rank) had issues for both scalar and nonscalar tgt. PR fortran/101334 gcc/fortran/ChangeLog: * trans-intrinsic.c (gfc_conv_associated): Support assumed-rank 'pointer' with scalar/array 'target' argument. libgfortran/ChangeLog: * intrinsics/associated.c (associated): Also check for same rank. gcc/testsuite/ChangeLog: * gfortran.dg/associated_assumed_rank.f90: New test. --- gcc/fortran/trans-intrinsic.c | 30 +++++++++++++++++++++--------- 1 file changed, 21 insertions(+), 9 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 612ca41..60e94f0 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -8974,7 +8974,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) gfc_se arg2se; tree tmp2; tree tmp; - tree nonzero_arraylen; + tree nonzero_arraylen = NULL_TREE; gfc_ss *ss; bool scalar; @@ -9074,14 +9074,16 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) { tmp = gfc_conv_descriptor_rank (arg1se.expr); tmp = fold_build2_loc (input_location, MINUS_EXPR, - TREE_TYPE (tmp), tmp, gfc_index_one_node); + TREE_TYPE (tmp), tmp, + build_int_cst (TREE_TYPE (tmp), 1)); } else tmp = gfc_rank_cst[arg1->expr->rank - 1]; tmp = gfc_conv_descriptor_stride_get (arg1se.expr, tmp); - nonzero_arraylen = fold_build2_loc (input_location, NE_EXPR, - logical_type_node, tmp, - build_int_cst (TREE_TYPE (tmp), 0)); + if (arg2->expr->rank != 0) + nonzero_arraylen = fold_build2_loc (input_location, NE_EXPR, + logical_type_node, tmp, + build_int_cst (TREE_TYPE (tmp), 0)); /* A pointer to an array, call library function _gfor_associated. */ arg1se.want_pointer = 1; @@ -9091,16 +9093,26 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) arg2se.want_pointer = 1; arg2se.force_no_tmp = 1; - gfc_conv_expr_descriptor (&arg2se, arg2->expr); + if (arg2->expr->rank != 0) + gfc_conv_expr_descriptor (&arg2se, arg2->expr); + else + { + gfc_conv_expr (&arg2se, arg2->expr); + arg2se.expr + = gfc_conv_scalar_to_descriptor (&arg2se, arg2se.expr, + gfc_expr_attr (arg2->expr)); + arg2se.expr = gfc_build_addr_expr (NULL_TREE, arg2se.expr); + } gfc_add_block_to_block (&se->pre, &arg2se.pre); gfc_add_block_to_block (&se->post, &arg2se.post); se->expr = build_call_expr_loc (input_location, gfor_fndecl_associated, 2, arg1se.expr, arg2se.expr); se->expr = convert (logical_type_node, se->expr); - se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR, - logical_type_node, se->expr, - nonzero_arraylen); + if (arg2->expr->rank != 0) + se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR, + logical_type_node, se->expr, + nonzero_arraylen); } /* If target is present zero character length pointers cannot -- cgit v1.1 From 1932e1169a236849f5e7f1cd386da100d9af470f Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Mon, 27 Sep 2021 00:16:16 +0000 Subject: Daily bump. --- gcc/fortran/ChangeLog | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6f8b469..cd13bc5 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2021-09-26 Tobias Burnus + + PR fortran/101334 + * trans-intrinsic.c (gfc_conv_associated): Support assumed-rank + 'pointer' with scalar/array 'target' argument. + 2021-09-24 Harald Anlauf PR fortran/102458 -- cgit v1.1 From 00f6de9c69119594f7dad3bd525937c94c8200d0 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Mon, 27 Sep 2021 14:04:54 +0200 Subject: Fortran: Fix assumed-size to assumed-rank passing [PR94070] This code inlines the size0 and size1 libgfortran calls, the former is still used by libgfortan itself (and by old code). Besides permitting more optimizations, it also permits to handle assumed-rank dummies better: If the dummy argument is a nonpointer/nonallocatable, an assumed-size actual arg is repesented by having ubound == -1 for the last dimension. However, for allocatable/pointers, this value can also exist. Hence, the dummy arg attr has to be honored. For that reason, when calling an assumed-rank procedure with nonpointer, nonallocatable dummy arguments, the bounds have to be updated to avoid the case ubound == -1 for the last dimension. PR fortran/94070 gcc/fortran/ChangeLog: * trans-array.c (gfc_tree_array_size): New function to find size inline (whole array or one dimension). (array_parameter_size): Use it, take stmt_block as arg. (gfc_conv_array_parameter): Update call. * trans-array.h (gfc_tree_array_size): Add prototype. * trans-decl.c (gfor_fndecl_size0, gfor_fndecl_size1): Remove these global vars. (gfc_build_intrinsic_function_decls): Remove their initialization. * trans-expr.c (gfc_conv_procedure_call): Update bounds of pointer/allocatable actual args to nonallocatable/nonpointer dummies to be one based. * trans-intrinsic.c (gfc_conv_intrinsic_shape): Fix case for assumed rank with allocatable/pointer dummy. (gfc_conv_intrinsic_size): Update to use inline function. * trans.h (gfor_fndecl_size0, gfor_fndecl_size1): Remove var decl. libgfortran/ChangeLog: * intrinsics/size.c (size0, size1): Comment that now not used by newer compiler code. libgomp/ChangeLog: * testsuite/libgomp.oacc-fortran/privatized-ref-2.f90: Update expected dg-note output. gcc/testsuite/ChangeLog: * gfortran.dg/c-interop/cf-out-descriptor-6.f90: Remove xfail. * gfortran.dg/c-interop/size.f90: Remove xfail. * gfortran.dg/intrinsic_size_3.f90: Update scan-tree-dump-times. * gfortran.dg/transpose_optimization_2.f90: Likewise. * gfortran.dg/size_optional_dim_1.f90: Add scan-tree-dump-not. * gfortran.dg/assumed_rank_22.f90: New test. * gfortran.dg/assumed_rank_22_aux.c: New test. --- gcc/fortran/trans-array.c | 165 +++++++++++++++++++++++++++++++++++------- gcc/fortran/trans-array.h | 2 + gcc/fortran/trans-decl.c | 14 ---- gcc/fortran/trans-expr.c | 43 +++++++++-- gcc/fortran/trans-intrinsic.c | 119 ++++++++++++------------------ gcc/fortran/trans.h | 2 - 6 files changed, 227 insertions(+), 118 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 0d013de..b8061f3 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -7901,31 +7901,143 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) gfc_cleanup_loop (&loop); } + +/* Calculate the array size (number of elements); if dim != NULL_TREE, + return size for that dim (dim=0..rank-1; only for GFC_DESCRIPTOR_TYPE_P). */ +tree +gfc_tree_array_size (stmtblock_t *block, tree desc, gfc_expr *expr, tree dim) +{ + if (GFC_ARRAY_TYPE_P (TREE_TYPE (desc))) + { + gcc_assert (dim == NULL_TREE); + return GFC_TYPE_ARRAY_SIZE (TREE_TYPE (desc)); + } + tree size, tmp, rank = NULL_TREE, cond = NULL_TREE; + symbol_attribute attr = gfc_expr_attr (expr); + gfc_array_spec *as = gfc_get_full_arrayspec_from_expr (expr); + gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))); + if ((!attr.pointer && !attr.allocatable && as && as->type == AS_ASSUMED_RANK) + || !dim) + { + if (expr->rank < 0) + rank = fold_convert (signed_char_type_node, + gfc_conv_descriptor_rank (desc)); + else + rank = build_int_cst (signed_char_type_node, expr->rank); + } + + if (dim || expr->rank == 1) + { + if (!dim) + dim = gfc_index_zero_node; + tree ubound = gfc_conv_descriptor_ubound_get (desc, dim); + tree lbound = gfc_conv_descriptor_lbound_get (desc, dim); + + size = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, ubound, lbound); + size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, + size, gfc_index_one_node); + /* if (!allocatable && !pointer && assumed rank) + size = (idx == rank && ubound[rank-1] == -1 ? -1 : size; + else + size = max (0, size); */ + size = fold_build2_loc (input_location, MAX_EXPR, gfc_array_index_type, + size, gfc_index_zero_node); + if (!attr.pointer && !attr.allocatable + && as && as->type == AS_ASSUMED_RANK) + { + tmp = fold_build2_loc (input_location, MINUS_EXPR, signed_char_type_node, + rank, build_int_cst (signed_char_type_node, 1)); + cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + fold_convert (signed_char_type_node, dim), + tmp); + tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + gfc_conv_descriptor_ubound_get (desc, dim), + build_int_cst (gfc_array_index_type, -1)); + cond = fold_build2_loc (input_location, TRUTH_AND_EXPR, boolean_type_node, + cond, tmp); + tmp = build_int_cst (gfc_array_index_type, -1); + size = build3_loc (input_location, COND_EXPR, gfc_array_index_type, + cond, tmp, size); + } + return size; + } + + /* size = 1. */ + size = gfc_create_var (gfc_array_index_type, "size"); + gfc_add_modify (block, size, build_int_cst (TREE_TYPE (size), 1)); + tree extent = gfc_create_var (gfc_array_index_type, "extent"); + + stmtblock_t cond_block, loop_body; + gfc_init_block (&cond_block); + gfc_init_block (&loop_body); + + /* Loop: for (i = 0; i < rank; ++i). */ + tree idx = gfc_create_var (signed_char_type_node, "idx"); + /* Loop body. */ + /* #if (assumed-rank + !allocatable && !pointer) + if (idx == rank - 1 && dim[idx].ubound == -1) + extent = -1; + else + #endif + extent = gfc->dim[i].ubound - gfc->dim[i].lbound + 1 + if (extent < 0) + extent = 0 + size *= extent. */ + cond = NULL_TREE; + if (!attr.pointer && !attr.allocatable && as && as->type == AS_ASSUMED_RANK) + { + tmp = fold_build2_loc (input_location, MINUS_EXPR, signed_char_type_node, + rank, build_int_cst (signed_char_type_node, 1)); + cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + idx, tmp); + tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + gfc_conv_descriptor_ubound_get (desc, idx), + build_int_cst (gfc_array_index_type, -1)); + cond = fold_build2_loc (input_location, TRUTH_AND_EXPR, boolean_type_node, + cond, tmp); + } + tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, + gfc_conv_descriptor_ubound_get (desc, idx), + gfc_conv_descriptor_lbound_get (desc, idx)); + tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, + tmp, gfc_index_one_node); + gfc_add_modify (&cond_block, extent, tmp); + tmp = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, + extent, gfc_index_zero_node); + tmp = build3_v (COND_EXPR, tmp, + fold_build2_loc (input_location, MODIFY_EXPR, + gfc_array_index_type, + extent, gfc_index_zero_node), + build_empty_stmt (input_location)); + gfc_add_expr_to_block (&cond_block, tmp); + tmp = gfc_finish_block (&cond_block); + if (cond) + tmp = build3_v (COND_EXPR, cond, + fold_build2_loc (input_location, MODIFY_EXPR, + gfc_array_index_type, extent, + build_int_cst (gfc_array_index_type, -1)), + tmp); + gfc_add_expr_to_block (&loop_body, tmp); + /* size *= extent. */ + gfc_add_modify (&loop_body, size, + fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, + size, extent)); + /* Generate loop. */ + gfc_simple_for_loop (block, idx, build_int_cst (TREE_TYPE (idx), 0), rank, LT_EXPR, + build_int_cst (TREE_TYPE (idx), 1), + gfc_finish_block (&loop_body)); + return size; +} + /* Helper function for gfc_conv_array_parameter if array size needs to be computed. */ static void -array_parameter_size (tree desc, gfc_expr *expr, tree *size) +array_parameter_size (stmtblock_t *block, tree desc, gfc_expr *expr, tree *size) { tree elem; - if (GFC_ARRAY_TYPE_P (TREE_TYPE (desc))) - *size = GFC_TYPE_ARRAY_SIZE (TREE_TYPE (desc)); - else if (expr->rank > 1) - *size = build_call_expr_loc (input_location, - gfor_fndecl_size0, 1, - gfc_build_addr_expr (NULL, desc)); - else - { - tree ubound = gfc_conv_descriptor_ubound_get (desc, gfc_index_zero_node); - tree lbound = gfc_conv_descriptor_lbound_get (desc, gfc_index_zero_node); - - *size = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, ubound, lbound); - *size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - *size, gfc_index_one_node); - *size = fold_build2_loc (input_location, MAX_EXPR, gfc_array_index_type, - *size, gfc_index_zero_node); - } + *size = gfc_tree_array_size (block, desc, expr, NULL); elem = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc))); *size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, *size, fold_convert (gfc_array_index_type, elem)); @@ -8035,7 +8147,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77, else se->expr = gfc_build_addr_expr (NULL_TREE, tmp); if (size) - array_parameter_size (tmp, expr, size); + array_parameter_size (&se->pre, tmp, expr, size); return; } @@ -8047,7 +8159,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77, tmp = se->expr; } if (size) - array_parameter_size (tmp, expr, size); + array_parameter_size (&se->pre, tmp, expr, size); se->expr = gfc_conv_array_data (tmp); return; } @@ -8122,7 +8234,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77, if (expr->ts.type == BT_CHARACTER && expr->expr_type != EXPR_FUNCTION) se->string_length = expr->ts.u.cl->backend_decl; if (size) - array_parameter_size (se->expr, expr, size); + array_parameter_size (&se->pre, se->expr, expr, size); se->expr = gfc_conv_array_data (se->expr); return; } @@ -8132,7 +8244,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77, /* Result of the enclosing function. */ gfc_conv_expr_descriptor (se, expr); if (size) - array_parameter_size (se->expr, expr, size); + array_parameter_size (&se->pre, se->expr, expr, size); se->expr = gfc_build_addr_expr (NULL_TREE, se->expr); if (g77 && TREE_TYPE (TREE_TYPE (se->expr)) != NULL_TREE @@ -8149,9 +8261,10 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77, gfc_conv_expr_descriptor (se, expr); if (size) - array_parameter_size (build_fold_indirect_ref_loc (input_location, - se->expr), - expr, size); + array_parameter_size (&se->pre, + build_fold_indirect_ref_loc (input_location, + se->expr), + expr, size); } /* Deallocate the allocatable components of structures that are diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index e4d443d..85ff216 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -39,6 +39,8 @@ void gfc_trans_dummy_array_bias (gfc_symbol *, tree, gfc_wrapped_block *); /* Generate entry and exit code for g77 calling convention arrays. */ void gfc_trans_g77_array (gfc_symbol *, gfc_wrapped_block *); +tree gfc_tree_array_size (stmtblock_t *, tree, gfc_expr *, tree); + tree gfc_full_array_size (stmtblock_t *, tree, int); tree gfc_duplicate_allocatable (tree, tree, tree, int, tree); diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 3bd8a0f..c758d26 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -214,8 +214,6 @@ tree gfor_fndecl_convert_char4_to_char1; /* Other misc. runtime library functions. */ -tree gfor_fndecl_size0; -tree gfor_fndecl_size1; tree gfor_fndecl_iargc; tree gfor_fndecl_kill; tree gfor_fndecl_kill_sub; @@ -3692,18 +3690,6 @@ gfc_build_intrinsic_function_decls (void) } /* Other functions. */ - 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; - TREE_NOTHROW (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; - TREE_NOTHROW (gfor_fndecl_size1) = 1; - gfor_fndecl_iargc = gfc_build_library_function_decl ( get_identifier (PREFIX ("iargc")), gfc_int4_type_node, 0); TREE_NOTHROW (gfor_fndecl_iargc) = 1; diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 41d5452..1c24556 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -6450,6 +6450,29 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, parmse.force_tmp = 1; } + /* Special case for assumed-rank arrays: when passing an + argument to a nonallocatable/nonpointer dummy, the bounds have + to be reset as otherwise a last-dim ubound of -1 is + indistinguishable from an assumed-size array in the callee. */ + if (!sym->attr.is_bind_c && e && fsym && fsym->as + && fsym->as->type == AS_ASSUMED_RANK + && e->rank != -1 + && e->expr_type == EXPR_VARIABLE + && ((fsym->ts.type == BT_CLASS + && !CLASS_DATA (fsym)->attr.class_pointer + && !CLASS_DATA (fsym)->attr.allocatable) + || (fsym->ts.type != BT_CLASS + && !fsym->attr.pointer && !fsym->attr.allocatable))) + { + /* Change AR_FULL to a (:,:,:) ref to force bounds update. */ + gfc_ref *ref; + for (ref = e->ref; ref->next; ref = ref->next) + ; + if (ref->u.ar.type == AR_FULL + && ref->u.ar.as->type != AS_ASSUMED_SIZE) + ref->u.ar.type = AR_SECTION; + } + if (sym->attr.is_bind_c && e && (is_CFI_desc (fsym, NULL) || assumed_length_string)) /* Implement F2018, 18.3.6, list item (5), bullet point 2. */ @@ -6510,16 +6533,26 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, gfc_conv_array_parameter (&parmse, e, nodesc_arg, fsym, sym->name, NULL); - /* Unallocated allocatable arrays and unassociated pointer arrays - need their dtype setting if they are argument associated with - assumed rank dummies, unless already assumed rank. */ + /* Special case for assumed-rank arrays. */ if (!sym->attr.is_bind_c && e && fsym && fsym->as && fsym->as->type == AS_ASSUMED_RANK && e->rank != -1) { - if (gfc_expr_attr (e).pointer + if ((gfc_expr_attr (e).pointer || gfc_expr_attr (e).allocatable) - set_dtype_for_unallocated (&parmse, e); + && ((fsym->ts.type == BT_CLASS + && (CLASS_DATA (fsym)->attr.class_pointer + || CLASS_DATA (fsym)->attr.allocatable)) + || (fsym->ts.type != BT_CLASS + && (fsym->attr.pointer || fsym->attr.allocatable)))) + { + /* Unallocated allocatable arrays and unassociated pointer + arrays need their dtype setting if they are argument + associated with assumed rank dummies. However, if the + dummy is nonallocate/nonpointer, the user may not + pass those. Hence, it can be skipped. */ + set_dtype_for_unallocated (&parmse, e); + } else if (e->expr_type == EXPR_VARIABLE && e->ref && e->ref->u.ar.type == AR_FULL diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 60e94f0..900a1a2 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -6697,6 +6697,8 @@ gfc_conv_intrinsic_shape (gfc_se *se, gfc_expr *expr) gfc_expr *e; gfc_array_spec *as; gfc_ss *ss; + symbol_attribute attr; + tree result_desc = se->expr; /* Remove the KIND argument, if present. */ s = expr->value.function.actual; @@ -6707,17 +6709,25 @@ gfc_conv_intrinsic_shape (gfc_se *se, gfc_expr *expr) gfc_conv_intrinsic_funcall (se, expr); - as = gfc_get_full_arrayspec_from_expr (s->expr);; - ss = gfc_walk_expr (s->expr); - /* According to F2018 16.9.172, para 5, an assumed rank entity, argument associated with an assumed size array, has the ubound of the final dimension set to -1 and SHAPE must return this. */ - if (as && as->type == AS_ASSUMED_RANK - && se->expr && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se->expr)) - && ss && ss->info->type == GFC_SS_SECTION) + + as = gfc_get_full_arrayspec_from_expr (s->expr); + if (!as || as->type != AS_ASSUMED_RANK) + return; + attr = gfc_expr_attr (s->expr); + ss = gfc_walk_expr (s->expr); + if (attr.pointer || attr.allocatable + || !ss || ss->info->type != GFC_SS_SECTION) + return; + if (se->expr) + result_desc = se->expr; + if (POINTER_TYPE_P (TREE_TYPE (result_desc))) + result_desc = build_fold_indirect_ref_loc (input_location, result_desc); + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (result_desc))) { - tree desc, rank, minus_one, cond, ubound, tmp; + tree rank, minus_one, cond, ubound, tmp; stmtblock_t block; gfc_se ase; @@ -6745,8 +6755,7 @@ gfc_conv_intrinsic_shape (gfc_se *se, gfc_expr *expr) /* Obtain the last element of the result from the library shape intrinsic and set it to -1 if that is the value of ubound. */ - desc = se->expr; - tmp = gfc_conv_array_data (desc); + tmp = gfc_conv_array_data (result_desc); tmp = build_fold_indirect_ref_loc (input_location, tmp); tmp = gfc_build_array_ref (tmp, rank, NULL, NULL); @@ -6758,7 +6767,6 @@ gfc_conv_intrinsic_shape (gfc_se *se, gfc_expr *expr) build_empty_stmt (input_location)); gfc_add_expr_to_block (&se->pre, cond); } - } static void @@ -7968,8 +7976,7 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr) gfc_actual_arglist *actual; tree arg1; tree type; - tree fncall0; - tree fncall1; + tree size; gfc_se argse; gfc_expr *e; gfc_symbol *sym = NULL; @@ -8046,37 +8053,31 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr) /* For functions that return a class array conv_expr_descriptor is not able to get the descriptor right. Therefore this special case. */ gfc_conv_expr_reference (&argse, e); - argse.expr = gfc_build_addr_expr (NULL_TREE, - gfc_class_data_get (argse.expr)); + argse.expr = gfc_class_data_get (argse.expr); } else if (sym && sym->backend_decl) { gcc_assert (GFC_CLASS_TYPE_P (TREE_TYPE (sym->backend_decl))); - argse.expr = sym->backend_decl; - argse.expr = gfc_build_addr_expr (NULL_TREE, - gfc_class_data_get (argse.expr)); + argse.expr = gfc_class_data_get (sym->backend_decl); } else - { - argse.want_pointer = 1; - gfc_conv_expr_descriptor (&argse, actual->expr); - } + gfc_conv_expr_descriptor (&argse, actual->expr); gfc_add_block_to_block (&se->pre, &argse.pre); gfc_add_block_to_block (&se->post, &argse.post); - arg1 = gfc_evaluate_now (argse.expr, &se->pre); - - /* Build the call to size0. */ - fncall0 = build_call_expr_loc (input_location, - gfor_fndecl_size0, 1, arg1); + arg1 = argse.expr; actual = actual->next; - if (actual->expr) { + stmtblock_t block; + gfc_init_block (&block); gfc_init_se (&argse, NULL); gfc_conv_expr_type (&argse, actual->expr, gfc_array_index_type); - gfc_add_block_to_block (&se->pre, &argse.pre); + gfc_add_block_to_block (&block, &argse.pre); + tree tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, + argse.expr, gfc_index_one_node); + size = gfc_tree_array_size (&block, arg1, e, tmp); /* Unusually, for an intrinsic, size does not exclude an optional arg2, so we must test for it. */ @@ -8084,59 +8085,35 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr) && actual->expr->symtree->n.sym->attr.dummy && actual->expr->symtree->n.sym->attr.optional) { - tree tmp; - /* Build the call to size1. */ - fncall1 = build_call_expr_loc (input_location, - gfor_fndecl_size1, 2, - arg1, argse.expr); - + tree cond; + stmtblock_t block2; + gfc_init_block (&block2); gfc_init_se (&argse, NULL); argse.want_pointer = 1; argse.data_not_needed = 1; gfc_conv_expr (&argse, actual->expr); gfc_add_block_to_block (&se->pre, &argse.pre); - tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, - argse.expr, null_pointer_node); - tmp = gfc_evaluate_now (tmp, &se->pre); - se->expr = fold_build3_loc (input_location, COND_EXPR, - pvoid_type_node, tmp, fncall1, fncall0); + cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, + argse.expr, null_pointer_node); + cond = gfc_evaluate_now (cond, &se->pre); + /* 'block2' contains the arg2 absent case, 'block' the arg2 present + case; size_var can be used in both blocks. */ + tree size_var = gfc_tree_array_size (&block2, arg1, e, NULL_TREE); + tmp = fold_build2_loc (input_location, MODIFY_EXPR, + TREE_TYPE (size_var), size_var, size); + gfc_add_expr_to_block (&block, tmp); + tmp = build3_v (COND_EXPR, cond, gfc_finish_block (&block), + gfc_finish_block (&block2)); + gfc_add_expr_to_block (&se->pre, tmp); + size = size_var; } else - { - se->expr = NULL_TREE; - argse.expr = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, - argse.expr, gfc_index_one_node); - } - } - else if (expr->value.function.actual->expr->rank == 1) - { - argse.expr = gfc_index_zero_node; - se->expr = NULL_TREE; + gfc_add_block_to_block (&se->pre, &block); } else - se->expr = fncall0; - - if (se->expr == NULL_TREE) - { - tree ubound, lbound; - - arg1 = build_fold_indirect_ref_loc (input_location, - arg1); - ubound = gfc_conv_descriptor_ubound_get (arg1, argse.expr); - lbound = gfc_conv_descriptor_lbound_get (arg1, argse.expr); - se->expr = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, ubound, lbound); - se->expr = fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, - se->expr, gfc_index_one_node); - se->expr = fold_build2_loc (input_location, MAX_EXPR, - gfc_array_index_type, se->expr, - gfc_index_zero_node); - } - + size = gfc_tree_array_size (&se->pre, arg1, e, NULL_TREE); type = gfc_typenode_for_spec (&expr->ts); - se->expr = convert (type, se->expr); + se->expr = convert (type, size); } diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 4d29834..53f0f86 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -960,8 +960,6 @@ extern GTY(()) tree gfor_fndecl_convert_char1_to_char4; extern GTY(()) tree gfor_fndecl_convert_char4_to_char1; /* Other misc. runtime library functions. */ -extern GTY(()) tree gfor_fndecl_size0; -extern GTY(()) tree gfor_fndecl_size1; extern GTY(()) tree gfor_fndecl_iargc; extern GTY(()) tree gfor_fndecl_kill; extern GTY(()) tree gfor_fndecl_kill_sub; -- cgit v1.1 From cf966403d91afcf475347f0d06dd2b7215ae3611 Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Tue, 28 Sep 2021 00:16:21 +0000 Subject: Daily bump. --- gcc/fortran/ChangeLog | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index cd13bc5..724f3ff 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,22 @@ +2021-09-27 Tobias Burnus + + PR fortran/94070 + * trans-array.c (gfc_tree_array_size): New function to + find size inline (whole array or one dimension). + (array_parameter_size): Use it, take stmt_block as arg. + (gfc_conv_array_parameter): Update call. + * trans-array.h (gfc_tree_array_size): Add prototype. + * trans-decl.c (gfor_fndecl_size0, gfor_fndecl_size1): Remove + these global vars. + (gfc_build_intrinsic_function_decls): Remove their initialization. + * trans-expr.c (gfc_conv_procedure_call): Update + bounds of pointer/allocatable actual args to nonallocatable/nonpointer + dummies to be one based. + * trans-intrinsic.c (gfc_conv_intrinsic_shape): Fix case for + assumed rank with allocatable/pointer dummy. + (gfc_conv_intrinsic_size): Update to use inline function. + * trans.h (gfor_fndecl_size0, gfor_fndecl_size1): Remove var decl. + 2021-09-26 Tobias Burnus PR fortran/101334 -- cgit v1.1 From 5e2adfeed21ee584a82cdcdfa7eed41202eb67cd Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Wed, 29 Sep 2021 20:11:53 +0200 Subject: Fortran: fix error recovery for invalid constructor gcc/fortran/ChangeLog: PR fortran/102520 * array.c (expand_constructor): Do not dereference NULL pointer. gcc/testsuite/ChangeLog: PR fortran/102520 * gfortran.dg/pr102520.f90: New test. --- gcc/fortran/array.c | 3 +++ 1 file changed, 3 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index b858bad..a4d1cb4 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -1798,6 +1798,9 @@ expand_constructor (gfc_constructor_base base) e = c->expr; + if (e == NULL) + return false; + if (empty_constructor) empty_ts = e->ts; -- cgit v1.1 From d238146e41ef986cd53ea2c9bf7ad85c4b81e690 Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Thu, 30 Sep 2021 00:16:20 +0000 Subject: Daily bump. --- gcc/fortran/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 724f3ff..123096d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2021-09-29 Harald Anlauf + + PR fortran/102520 + * array.c (expand_constructor): Do not dereference NULL pointer. + 2021-09-27 Tobias Burnus PR fortran/94070 -- cgit v1.1 From 643e8f4ee3a2a59a9b96fbcd1ffa8bacbda5b383 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Thu, 30 Sep 2021 19:08:25 +0200 Subject: Fortran: Fix same_type_as A test for CLASS(*) + assumed rank was missing; adding a test to unlimited_polymorphic_1.f03 showed an ICE as backend_decl wasn't set. While gfc_get_symbol_decl would fix it, the code also assumed that the class(*) was a variable and could not be a subobject of a derived type. PR fortran/71703 PR fortran/84007 gcc/fortran/ChangeLog: * trans-intrinsic.c (gfc_conv_same_type_as): Fix handling of UNLIMITED_POLY. * trans.h (gfc_vtpr_hash_get): Renamed prototype to ... (gfc_vptr_hash_get): ... this to match function name. gcc/testsuite/ChangeLog: * gfortran.dg/c-interop/c535b-1.f90: Remove wrong comment. * gfortran.dg/unlimited_polymorphic_1.f03: Extend. * gfortran.dg/unlimited_polymorphic_32.f90: New test. --- gcc/fortran/trans-intrinsic.c | 42 ++++++++++++++++++++++++++++-------------- gcc/fortran/trans.h | 2 +- 2 files changed, 29 insertions(+), 15 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 900a1a2..2a2829c 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -9126,21 +9126,14 @@ gfc_conv_same_type_as (gfc_se *se, gfc_expr *expr) a = expr->value.function.actual->expr; b = expr->value.function.actual->next->expr; - if (UNLIMITED_POLY (a)) + bool unlimited_poly_a = UNLIMITED_POLY (a); + bool unlimited_poly_b = UNLIMITED_POLY (b); + if (unlimited_poly_a) { - tmp = gfc_class_vptr_get (a->symtree->n.sym->backend_decl); - conda = fold_build2_loc (input_location, NE_EXPR, logical_type_node, - tmp, build_int_cst (TREE_TYPE (tmp), 0)); - } - - if (UNLIMITED_POLY (b)) - { - tmp = gfc_class_vptr_get (b->symtree->n.sym->backend_decl); - condb = fold_build2_loc (input_location, NE_EXPR, logical_type_node, - tmp, build_int_cst (TREE_TYPE (tmp), 0)); + se1.want_pointer = 1; + gfc_add_vptr_component (a); } - - if (a->ts.type == BT_CLASS) + else if (a->ts.type == BT_CLASS) { gfc_add_vptr_component (a); gfc_add_hash_component (a); @@ -9149,7 +9142,12 @@ gfc_conv_same_type_as (gfc_se *se, gfc_expr *expr) a = gfc_get_int_expr (gfc_default_integer_kind, NULL, a->ts.u.derived->hash_value); - if (b->ts.type == BT_CLASS) + if (unlimited_poly_b) + { + se2.want_pointer = 1; + gfc_add_vptr_component (b); + } + else if (b->ts.type == BT_CLASS) { gfc_add_vptr_component (b); gfc_add_hash_component (b); @@ -9161,6 +9159,22 @@ gfc_conv_same_type_as (gfc_se *se, gfc_expr *expr) gfc_conv_expr (&se1, a); gfc_conv_expr (&se2, b); + if (unlimited_poly_a) + { + conda = fold_build2_loc (input_location, NE_EXPR, logical_type_node, + se1.expr, + build_int_cst (TREE_TYPE (se1.expr), 0)); + se1.expr = gfc_vptr_hash_get (se1.expr); + } + + if (unlimited_poly_b) + { + condb = fold_build2_loc (input_location, NE_EXPR, logical_type_node, + se2.expr, + build_int_cst (TREE_TYPE (se2.expr), 0)); + se2.expr = gfc_vptr_hash_get (se2.expr); + } + tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, se1.expr, fold_convert (TREE_TYPE (se1.expr), se2.expr)); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 53f0f86..fa3e865 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -438,7 +438,7 @@ tree gfc_class_vtab_def_init_get (tree); tree gfc_class_vtab_copy_get (tree); tree gfc_class_vtab_final_get (tree); /* Get an accessor to the vtab's * field, when a vptr handle is present. */ -tree gfc_vtpr_hash_get (tree); +tree gfc_vptr_hash_get (tree); tree gfc_vptr_size_get (tree); tree gfc_vptr_extends_get (tree); tree gfc_vptr_def_init_get (tree); -- cgit v1.1 From 8a0861ef29521e90293bd0236d2bb30b71a4970e Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Thu, 30 Sep 2021 20:28:39 +0200 Subject: Fortran: fix reference to Fortran standard in comment gcc/fortran/ * expr.c: The correct reference to Fortran standard is: F2018:10.1.12. --- gcc/fortran/expr.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 5ad1c4f..6c38935 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -990,7 +990,7 @@ done: } -/* Standard intrinsics listed under F2018:10.1.2 (6), which are excluded in +/* Standard intrinsics listed under F2018:10.1.12 (6), which are excluded in constant expressions, except TRANSFER (c.f. item (8)), which would need separate treatment. */ -- cgit v1.1 From b19bbfb1482505367dd19ae4ab1ea19e36802b6a Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Thu, 30 Sep 2021 20:29:31 +0200 Subject: Fortran: resolve expressions during SIZE simplification gcc/fortran/ChangeLog: PR fortran/102458 * simplify.c (simplify_size): Resolve expressions used in array specifications so that SIZE can be simplified. gcc/testsuite/ChangeLog: PR fortran/102458 * gfortran.dg/pr102458b.f90: New test. --- gcc/fortran/simplify.c | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index b46cbfa..f40e493 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -7471,6 +7471,7 @@ simplify_size (gfc_expr *array, gfc_expr *dim, int k) mpz_t size; gfc_expr *return_value; int d; + gfc_ref *ref; /* For unary operations, the size of the result is given by the size of the operand. For binary ones, it's the size of the first operand @@ -7527,6 +7528,10 @@ simplify_size (gfc_expr *array, gfc_expr *dim, int k) return simplified; } + for (ref = array->ref; ref; ref = ref->next) + if (ref->type == REF_ARRAY && ref->u.ar.as) + gfc_resolve_array_spec (ref->u.ar.as, 0); + if (dim == NULL) { if (!gfc_array_size (array, &size)) -- cgit v1.1 From 2467998373b9b6ddd3dae1b8ea72c1ee3054c699 Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Fri, 1 Oct 2021 00:16:27 +0000 Subject: Daily bump. --- gcc/fortran/ChangeLog | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 123096d..94af00a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,22 @@ +2021-09-30 Harald Anlauf + + PR fortran/102458 + * simplify.c (simplify_size): Resolve expressions used in array + specifications so that SIZE can be simplified. + +2021-09-30 Harald Anlauf + + * expr.c: The correct reference to Fortran standard is: F2018:10.1.12. + +2021-09-30 Tobias Burnus + + PR fortran/71703 + PR fortran/84007 + * trans-intrinsic.c (gfc_conv_same_type_as): Fix handling + of UNLIMITED_POLY. + * trans.h (gfc_vtpr_hash_get): Renamed prototype to ... + (gfc_vptr_hash_get): ... this to match function name. + 2021-09-29 Harald Anlauf PR fortran/102520 -- cgit v1.1 From e705b8533aa0a00a65734eb5fd6344295723dccc Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Fri, 1 Oct 2021 10:45:48 +0200 Subject: openmp: Differentiate between order(concurrent) and order(reproducible:concurrent) While OpenMP 5.1 implies order(concurrent) is the same thing as order(reproducible:concurrent), this is going to change in OpenMP 5.2, where essentially order(concurrent) means nothing is stated on whether it is reproducible or unconstrained (and is determined by other means, e.g. for/do with schedule static or runtime with static being selected is implicitly reproducible, distribute with dist_schedule static is implicitly reproducible, loop is implicitly reproducible) and when the modifier is specified explicitly, it overrides the implicit behavior either way. And, when order(reproducible:concurrent) is used with e.g. schedule(dynamic) or some other schedule that is by definition not reproducible, it is implementation's duty to ensure it is reproducible, either by remembering how it scheduled some loop and then replaying the same schedule when seeing loops with the same directive/schedule/number of iterations, or by overriding the schedule to some reproducible one. This patch doesn't implement the 5.2 wording just yet, but in the FEs differentiates between the 3 states - no explicit modifier, explicit reproducible or explicit unconstrainted, so that the middle-end can easily switch any time. Instead it follows the 5.1 wording where both order(concurrent) (implicit or explicit) or order(reproducible:concurrent) imply reproducibility. And, it implements the easier method, when for/do should be reproducible, it just chooses static schedule. order(concurrent) implies no OpenMP APIs in the loop body nor threadprivate vars, so the exact scheduling isn't (easily at least) observable. 2021-10-01 Jakub Jelinek gcc/ * tree.h (OMP_CLAUSE_ORDER_REPRODUCIBLE): Define. * tree-pretty-print.c (dump_omp_clause) : Print reproducible: for OMP_CLAUSE_ORDER_REPRODUCIBLE. * omp-general.c (omp_extract_for_data): If OMP_CLAUSE_ORDER is seen without OMP_CLAUSE_ORDER_UNCONSTRAINED, overwrite sched_kind to OMP_CLAUSE_SCHEDULE_STATIC. gcc/c-family/ * c-omp.c (c_omp_split_clauses): Also copy OMP_CLAUSE_ORDER_REPRODUCIBLE. gcc/c/ * c-parser.c (c_parser_omp_clause_order): Set OMP_CLAUSE_ORDER_REPRODUCIBLE for explicit reproducible: modifier. gcc/cp/ * parser.c (cp_parser_omp_clause_order): Set OMP_CLAUSE_ORDER_REPRODUCIBLE for explicit reproducible: modifier. gcc/fortran/ * gfortran.h (gfc_omp_clauses): Add order_reproducible bitfield. * dump-parse-tree.c (show_omp_clauses): Print REPRODUCIBLE: for it. * openmp.c (gfc_match_omp_clauses): Set order_reproducible for explicit reproducible: modifier. * trans-openmp.c (gfc_trans_omp_clauses): Set OMP_CLAUSE_ORDER_REPRODUCIBLE for order_reproducible. (gfc_split_omp_clauses): Also copy order_reproducible. gcc/testsuite/ * gfortran.dg/gomp/order-5.f90: Adjust scan-tree-dump-times regexps. libgomp/ * testsuite/libgomp.c-c++-common/order-reproducible-1.c: New test. * testsuite/libgomp.c-c++-common/order-reproducible-2.c: New test. --- gcc/fortran/dump-parse-tree.c | 2 ++ gcc/fortran/gfortran.h | 4 ++-- gcc/fortran/openmp.c | 5 +++-- gcc/fortran/trans-openmp.c | 7 +++++++ 4 files changed, 14 insertions(+), 4 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 28eb09e..64e04c0 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1634,6 +1634,8 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) fputs (" ORDER(", dumpfile); if (omp_clauses->order_unconstrained) fputs ("UNCONSTRAINED:", dumpfile); + else if (omp_clauses->order_reproducible) + fputs ("REPRODUCIBLE:", dumpfile); fputs ("CONCURRENT)", dumpfile); } if (omp_clauses->ordered) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 7ef835b..c25d1cc 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1491,8 +1491,8 @@ typedef struct gfc_omp_clauses unsigned inbranch:1, notinbranch:1, nogroup:1; unsigned sched_simd:1, sched_monotonic:1, sched_nonmonotonic:1; unsigned simd:1, threads:1, depend_source:1, destroy:1, order_concurrent:1; - unsigned order_unconstrained:1, capture:1, grainsize_strict:1; - unsigned num_tasks_strict:1; + unsigned order_unconstrained:1, order_reproducible:1, capture:1; + unsigned grainsize_strict:1, num_tasks_strict:1; ENUM_BITFIELD (gfc_omp_sched_kind) sched_kind:3; ENUM_BITFIELD (gfc_omp_device_type) device_type:2; ENUM_BITFIELD (gfc_omp_memorder) memorder:3; diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 9ee52d6..6a4ca28 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -2374,8 +2374,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, { if (m == MATCH_ERROR) goto error; - if (gfc_match (" reproducible : concurrent )") == MATCH_YES - || gfc_match (" concurrent )") == MATCH_YES) + if (gfc_match (" reproducible : concurrent )") == MATCH_YES) + c->order_reproducible = true; + else if (gfc_match (" concurrent )") == MATCH_YES) ; else if (gfc_match (" unconstrained : concurrent )") == MATCH_YES) c->order_unconstrained = true; diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 4ca2c3f..d234d1b 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -3804,6 +3804,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, { c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_ORDER); OMP_CLAUSE_ORDER_UNCONSTRAINED (c) = clauses->order_unconstrained; + OMP_CLAUSE_ORDER_REPRODUCIBLE (c) = clauses->order_reproducible; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -5895,6 +5896,8 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->order_concurrent; clausesa[GFC_OMP_SPLIT_DISTRIBUTE].order_unconstrained = code->ext.omp_clauses->order_unconstrained; + clausesa[GFC_OMP_SPLIT_DISTRIBUTE].order_reproducible + = code->ext.omp_clauses->order_reproducible; } if (mask & GFC_OMP_MASK_PARALLEL) { @@ -5951,6 +5954,8 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->order_concurrent; clausesa[GFC_OMP_SPLIT_DO].order_unconstrained = code->ext.omp_clauses->order_unconstrained; + clausesa[GFC_OMP_SPLIT_DO].order_reproducible + = code->ext.omp_clauses->order_reproducible; } if (mask & GFC_OMP_MASK_SIMD) { @@ -5969,6 +5974,8 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->order_concurrent; clausesa[GFC_OMP_SPLIT_SIMD].order_unconstrained = code->ext.omp_clauses->order_unconstrained; + clausesa[GFC_OMP_SPLIT_SIMD].order_reproducible + = code->ext.omp_clauses->order_reproducible; /* And this is copied to all. */ clausesa[GFC_OMP_SPLIT_SIMD].if_expr = code->ext.omp_clauses->if_expr; -- cgit v1.1 From 4dc7ce6fb3917958d1a6036d8acf2953b9c1b868 Mon Sep 17 00:00:00 2001 From: Martin Sebor Date: Fri, 1 Oct 2021 11:50:25 -0600 Subject: Enhance -Waddress to detect more suspicious expressions [PR102103]. Resolves: PR c/102103 - missing warning comparing array address to null gcc/ChangeLog: PR c/102103 * doc/invoke.texi (-Waddress): Update. * gengtype.c (write_types): Avoid -Waddress. * poly-int.h (POLY_SET_COEFF): Avoid using null. gcc/c-family/ChangeLog: PR c/102103 * c-common.c (decl_with_nonnull_addr_p): Handle members. Check and perform warning suppression. (c_common_truthvalue_conversion): Enhance warning suppression. gcc/c/ChangeLog: PR c/102103 * c-typeck.c (maybe_warn_for_null_address): New function. (build_binary_op): Call it. gcc/cp/ChangeLog: PR c/102103 * typeck.c (warn_for_null_address): Enhance. (cp_build_binary_op): Call it also for member pointers. gcc/fortran/ChangeLog: PR c/102103 * array.c: Remove an unnecessary test. * trans-array.c: Same. gcc/testsuite/ChangeLog: PR c/102103 * g++.dg/cpp0x/constexpr-array-ptr10.C: Suppress a valid warning. * g++.dg/warn/Wreturn-local-addr-6.C: Correct a cast. * gcc.dg/Waddress.c: Expect a warning. * c-c++-common/Waddress-3.c: New test. * c-c++-common/Waddress-4.c: New test. * g++.dg/warn/Waddress-5.C: New test. * g++.dg/warn/Waddress-6.C: New test. * g++.dg/warn/pr101219.C: Expect a warning. * gcc.dg/Waddress-3.c: New test. --- gcc/fortran/array.c | 2 +- gcc/fortran/trans-array.c | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index a4d1cb4..6552eaf 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -2581,7 +2581,7 @@ gfc_array_dimen_size (gfc_expr *array, int dimen, mpz_t *result) } } - if (array->shape && array->shape[dimen]) + if (array->shape) { mpz_init_set (*result, array->shape[dimen]); return true; diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index b8061f3..e2f59e0 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -5104,7 +5104,6 @@ set_loop_bounds (gfc_loopinfo *loop) if (info->shape) { - gcc_assert (info->shape[dim]); /* The frontend has worked out the size for us. */ if (!loopspec[n] || !specinfo->shape -- cgit v1.1 From 9d116bcc5556c7df32803f7bf8e6e238ea1c13fb Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Sat, 2 Oct 2021 00:16:31 +0000 Subject: Daily bump. --- gcc/fortran/ChangeLog | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 94af00a..c9a1293 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,19 @@ +2021-10-01 Martin Sebor + + PR c/102103 + * array.c: Remove an unnecessary test. + * trans-array.c: Same. + +2021-10-01 Jakub Jelinek + + * gfortran.h (gfc_omp_clauses): Add order_reproducible bitfield. + * dump-parse-tree.c (show_omp_clauses): Print REPRODUCIBLE: for it. + * openmp.c (gfc_match_omp_clauses): Set order_reproducible for + explicit reproducible: modifier. + * trans-openmp.c (gfc_trans_omp_clauses): Set + OMP_CLAUSE_ORDER_REPRODUCIBLE for order_reproducible. + (gfc_split_omp_clauses): Also copy order_reproducible. + 2021-09-30 Harald Anlauf PR fortran/102458 -- cgit v1.1 From 51d9ef7747b2dc439f7456303f0784faf5cdb1d3 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Mon, 4 Oct 2021 09:38:43 +0200 Subject: Fortran: Avoid var initialization in interfaces [PR54753] MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Intent(out) implies deallocation/default initialization; however, it is pointless to do this for dummy-arguments symbols of procedures which are inside an INTERFACE block. – This also fixes a bogus error for the attached included testcase, but fixing the non-interface version still has to be done. PR fortran/54753 gcc/fortran/ChangeLog: * resolve.c (can_generate_init, resolve_fl_variable_derived, resolve_symbol): Only do initialization with intent(out) if not inside of an interface block. --- gcc/fortran/resolve.c | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 30b96b2..511fe3a 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -12676,7 +12676,8 @@ can_generate_init (gfc_symbol *sym) || a->cray_pointer || sym->assoc || (!a->referenced && !a->result) - || (a->dummy && a->intent != INTENT_OUT) + || (a->dummy && (a->intent != INTENT_OUT + || sym->ns->proc_name->attr.if_source == IFSRC_IFBODY)) || (a->function && sym != sym->result) ); } @@ -12913,7 +12914,9 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag) /* Assign default initializer. */ if (!(sym->value || sym->attr.pointer || sym->attr.allocatable) - && (!no_init_flag || sym->attr.intent == INTENT_OUT)) + && (!no_init_flag + || (sym->attr.intent == INTENT_OUT + && sym->ns->proc_name->attr.if_source != IFSRC_IFBODY))) sym->value = gfc_generate_initializer (&sym->ts, can_generate_init (sym)); return true; @@ -16154,7 +16157,8 @@ resolve_symbol (gfc_symbol *sym) || sym->ts.u.derived->attr.alloc_comp || sym->ts.u.derived->attr.pointer_comp)) && !(a->function && sym != sym->result)) - || (a->dummy && a->intent == INTENT_OUT && !a->pointer)) + || (a->dummy && !a->pointer && a->intent == INTENT_OUT + && sym->ns->proc_name->attr.if_source != IFSRC_IFBODY)) apply_default_init (sym); else if (a->function && sym->result && a->access != ACCESS_PRIVATE && (sym->ts.u.derived->attr.alloc_comp @@ -16166,6 +16170,7 @@ resolve_symbol (gfc_symbol *sym) if (sym->ts.type == BT_CLASS && sym->ns == gfc_current_ns && sym->attr.dummy && sym->attr.intent == INTENT_OUT + && sym->ns->proc_name->attr.if_source != IFSRC_IFBODY && !CLASS_DATA (sym)->attr.class_pointer && !CLASS_DATA (sym)->attr.allocatable) apply_default_init (sym); -- cgit v1.1 From da9c5f7856c929a3b80e22ab75ebeebce4409501 Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Tue, 5 Oct 2021 00:16:29 +0000 Subject: Daily bump. --- gcc/fortran/ChangeLog | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c9a1293..da5d1a2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2021-10-04 Tobias Burnus + + PR fortran/54753 + * resolve.c (can_generate_init, resolve_fl_variable_derived, + resolve_symbol): Only do initialization with intent(out) if not + inside of an interface block. + 2021-10-01 Martin Sebor PR c/102103 -- cgit v1.1 From ece8b0fce6bbfb1e531de8164da47eeed80d3cf1 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 6 Oct 2021 08:47:40 +0200 Subject: Fortran: Fix deprecate warning with parameter Only warn with !GCC$ ATTRIBUTES DEPRECATED if deprecated PARMETERS are actually used. gcc/fortran/ChangeLog: * resolve.c (resolve_values): Only show deprecated warning if attr.referenced. gcc/testsuite/ChangeLog: * gfortran.dg/attr_deprecated-2.f90: New test. --- gcc/fortran/resolve.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 511fe3a..0d0af39 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -12351,7 +12351,7 @@ resolve_values (gfc_symbol *sym) if (sym->value == NULL) return; - if (sym->attr.ext_attr & (1 << EXT_ATTR_DEPRECATED)) + if (sym->attr.ext_attr & (1 << EXT_ATTR_DEPRECATED) && sym->attr.referenced) gfc_warning (OPT_Wdeprecated_declarations, "Using parameter %qs declared at %L is deprecated", sym->name, &sym->declared_at); -- cgit v1.1 From 57c7ec62ee0fbc33cacc5feb3e26d3ad4f765cdb Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Thu, 7 Oct 2021 00:16:24 +0000 Subject: Daily bump. --- gcc/fortran/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index da5d1a2..b296797 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2021-10-06 Tobias Burnus + + * resolve.c (resolve_values): Only show + deprecated warning if attr.referenced. + 2021-10-04 Tobias Burnus PR fortran/54753 -- cgit v1.1