[PATCH] PR fortran/99853 - ICE: Cannot convert 'LOGICAL(4)' to 'INTEGER(8)' (etc.)
Dear Fortranners,
the original fix by Steve was lingering in the PR.
We did ICE in situations where in a SELECT CASE a kind conversion
was deemed necessary, but it did involve different types.
The check gfc_convert_type_warn () was invoked with arguments
requesting to generate an internal error. A regular gfc_error
is good enough here.
Regtested on x86_64-pc-linux-gnu. OK?
Thanks, also to Steve,
Harald
Fortran: generate regular error on invalid conversions of CASE expressions
gcc/fortran/ChangeLog:
PR fortran/99853
* resolve.c (resolve_select): Generate regular gfc_error on
invalid conversions instead of an gfc_internal_error.
gcc/testsuite/ChangeLog:
PR fortran/99853
* gfortran.dg/pr99853.f90: New test.
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index af71b132dec..8da396b32ec 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8770,11 +8770,11 @@ resolve_select (gfc_code *code, bool select_type)
if (cp->low != NULL
&& case_expr->ts.kind != gfc_kind_max(case_expr, cp->low))
- gfc_convert_type_warn (case_expr, &cp->low->ts, 2, 0);
+ gfc_convert_type_warn (case_expr, &cp->low->ts, 1, 0);
if (cp->high != NULL
&& case_expr->ts.kind != gfc_kind_max(case_expr, cp->high))
- gfc_convert_type_warn (case_expr, &cp->high->ts, 2, 0);
+ gfc_convert_type_warn (case_expr, &cp->high->ts, 1, 0);
}
}
}
diff --git a/gcc/testsuite/gfortran.dg/pr99853.f90 b/gcc/testsuite/gfortran.dg/pr99853.f90
new file mode 100644
index 000..421a656bec2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr99853.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! { dg-options "-std=f2018" }
+! PR fortran/99853
+
+subroutine s1 ()
+ select case (.true.) ! { dg-error "Cannot convert" }
+ case (1_8) ! { dg-error "must be of type LOGICAL" }
+ end select
+end
+
+subroutine s2 ()
+ select case (.false._1) ! { dg-error "Cannot convert" }
+ case (2:3) ! { dg-error "must be of type LOGICAL" }
+ end select
+end
+
+subroutine s3 ()
+ select case (3_2) ! { dg-error "Cannot convert" }
+ case (.false.)! { dg-error "must be of type INTEGER" }
+ end select
+end
+
+subroutine s4 (i)
+ select case (i) ! { dg-error "Cannot convert" }
+ case (.true._8) ! { dg-error "must be of type INTEGER" }
+ end select
+end
+
+! { dg-prune-output "Cannot convert" }
Re: [PATCH,FORTRAN] Fix memory leak of gsymbol
Hi Bernhard,
Am 27.10.21 um 23:43 schrieb Bernhard Reutner-Fischer via Gcc-patches:
ping
[I'll rebase and retest this too since it's been a while.
Ok if it passes?]
On Sun, 21 Oct 2018 16:04:34 +0200
Bernhard Reutner-Fischer wrote:
Hi!
Regtested on x86_64-unknown-linux, installing on
aldot/fortran-fe-stringpool.
We did not free global symbols. For a simplified abstract_type_3.f03
valgrind reports:
96 bytes in 1 blocks are still reachable in loss record 461 of 602
at 0x48377D5: calloc (vg_replace_malloc.c:711)
by 0x21257C3: xcalloc (xmalloc.c:162)
by 0x98611B: gfc_get_gsymbol(char const*) (symbol.c:4341)
by 0x932C58: parse_module() (parse.c:5912)
by 0x9336F8: gfc_parse_file() (parse.c:6236)
by 0x991449: gfc_be_parse_file() (f95-lang.c:204)
by 0x11D8EDE: compile_file() (toplev.c:455)
by 0x11DB9C3: do_compile() (toplev.c:2170)
by 0x11DBCAF: toplev::main(int, char**) (toplev.c:2305)
by 0x2045D37: main (main.c:39)
This patch reduces leaks to
LEAK SUMMARY:
definitely lost: 344 bytes in 1 blocks
indirectly lost: 3,024 bytes in 4 blocks
possibly lost: 0 bytes in 0 blocks
- still reachable: 1,576,174 bytes in 2,277 blocks
+ still reachable: 1,576,078 bytes in 2,276 blocks
suppressed: 0 bytes in 0 blocks
gcc/fortran/ChangeLog:
2018-10-21 Bernhard Reutner-Fischer
* parse.c (clean_up_modules): Free gsym.
---
gcc/fortran/parse.c | 18 +++---
1 file changed, 11 insertions(+), 7 deletions(-)
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index b7265c42f58..f7c369a17ac 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -6066,7 +6066,7 @@ resolve_all_program_units (gfc_namespace
*gfc_global_ns_list)
static void
-clean_up_modules (gfc_gsymbol *gsym)
+clean_up_modules (gfc_gsymbol *&gsym)
{
if (gsym == NULL)
return;
@@ -6074,14 +6074,18 @@ clean_up_modules (gfc_gsymbol *gsym)
clean_up_modules (gsym->left);
clean_up_modules (gsym->right);
- if (gsym->type != GSYM_MODULE || !gsym->ns)
+ if (gsym->type != GSYM_MODULE)
return;
- gfc_current_ns = gsym->ns;
- gfc_derived_types = gfc_current_ns->derived_types;
- gfc_done_2 ();
- gsym->ns = NULL;
- return;
+ if (gsym->ns)
+{
+ gfc_current_ns = gsym->ns;
+ gfc_derived_types = gfc_current_ns->derived_types;
+ gfc_done_2 ();
+ gsym->ns = NULL;
+}
+ free (gsym);
+ gsym = NULL;
this essentially looks fine, but did you inspect the callers?
With the change to the interface (*gsym -> *&gsym), it could have
effects not visible here due to the explicit gsym = NULL.
Assuming you checked that, and if it regtests fine, then it is
OK for mainline.
Thanks for the patch!
Harald
}
Re: [PATCH,FORTRAN] Fix memory leak of gsymbol
On Thu, 28 Oct 2021 23:37:59 +0200 Harald Anlauf wrote: > Hi Bernhard, > > Am 27.10.21 um 23:43 schrieb Bernhard Reutner-Fischer via Gcc-patches: > > ping > > [I'll rebase and retest this too since it's been a while. > > Ok if it passes?] > > > > On Sun, 21 Oct 2018 16:04:34 +0200 > > Bernhard Reutner-Fischer wrote: > >> gcc/fortran/ChangeLog: > >> > >> 2018-10-21 Bernhard Reutner-Fischer > >> > >>* parse.c (clean_up_modules): Free gsym. > this essentially looks fine, but did you inspect the callers? > > With the change to the interface (*gsym -> *&gsym), it could have > effects not visible here due to the explicit gsym = NULL. > > Assuming you checked that, and if it regtests fine, then it is > OK for mainline. The only caller is translate_all_program_units. Since we free only module gsyms, even -fdump-fortran-global is unaffected by this, fwiw. It regtests cleanly and i will push it when the rest is approved. Thanks!
[PATCH,Fortran 2/2] Fix write_omp_udr for user-operator REDUCTIONs
From: Bernhard Reutner-Fischer
Due to a typo a user operator used in a reduction was not found in the
symtree so would have been written multiple times (in theory).
E.g. user operator ".add." was looked up as ".ad" instead of "add".
For gcc-11 branch and earlier one would
- memcpy (name, udr->name, len - 1);
+ memcpy (name, udr->name + 1, len - 1);
but for gcc-12 we have an appropriate helper already.
Jakub, please take care of non-trunk branches if you want it fixed
there.
Cc: Jakub Jelinek
gcc/fortran/ChangeLog:
2017-11-16 Bernhard Reutner-Fischer
* module.c (write_omp_udr): Use gfc_get_name_from_uop.
---
gcc/fortran/module.c | 8 ++--
1 file changed, 2 insertions(+), 6 deletions(-)
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 1328414e4f7..90ab9e275f3 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -6021,12 +6021,8 @@ write_omp_udr (gfc_omp_udr *udr)
return;
else
{
- gfc_symtree *st;
- size_t len = strlen (udr->name + 1);
- char *name = XALLOCAVEC (char, len);
- memcpy (name, udr->name, len - 1);
- name[len - 1] = '\0';
- st = gfc_find_symtree (gfc_current_ns->uop_root, name);
+ const char *name = gfc_get_name_from_uop (udr->name);
+ gfc_symtree *st = gfc_find_symtree (gfc_current_ns->uop_root, name);
/* If corresponding user operator is private, don't write
the UDR. */
if (st != NULL)
--
2.33.0
[PATCH,Fortran 1/2] Add uop/name helpers
From: Bernhard Reutner-Fischer
Introduce a helper to construct a user operator from a name and the
reverse operation, i.e. a helper to construct a name from a user
operator.
Cc: Jakub Jelinek
gcc/fortran/ChangeLog:
2017-10-29 Bernhard Reutner-Fischer
* gfortran.h (gfc_get_uop_from_name, gfc_get_name_from_uop): Declare.
* symbol.c (gfc_get_uop_from_name, gfc_get_name_from_uop): Define.
* module.c (load_omp_udrs): Use them.
---
gcc/fortran/gfortran.h | 2 ++
gcc/fortran/module.c | 21 +++--
gcc/fortran/symbol.c | 21 +
3 files changed, 26 insertions(+), 18 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 9378b4b8a24..afe9f2354ee 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3399,6 +3399,8 @@ void gfc_delete_symtree (gfc_symtree **, const char *);
gfc_symtree *gfc_get_unique_symtree (gfc_namespace *);
gfc_user_op *gfc_get_uop (const char *);
gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
+const char *gfc_get_uop_from_name (const char*);
+const char *gfc_get_name_from_uop (const char*);
void gfc_free_symbol (gfc_symbol *&);
void gfc_release_symbol (gfc_symbol *&);
gfc_symbol *gfc_new_symbol (const char *, gfc_namespace *);
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 7b98ba539d6..1328414e4f7 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -5027,7 +5027,7 @@ load_omp_udrs (void)
while (peek_atom () != ATOM_RPAREN)
{
const char *name = NULL, *newname;
- char *altname;
+ const char *altname = NULL;
gfc_typespec ts;
gfc_symtree *st;
gfc_omp_reduction_op rop = OMP_REDUCTION_USER;
@@ -5054,15 +5054,8 @@ load_omp_udrs (void)
else if (strcmp (p, ".neqv.") == 0)
rop = OMP_REDUCTION_NEQV;
}
- altname = NULL;
if (rop == OMP_REDUCTION_USER && name[0] == '.')
- {
- size_t len = strlen (name + 1);
- altname = XALLOCAVEC (char, len);
- gcc_assert (name[len] == '.');
- memcpy (altname, name + 1, len - 1);
- altname[len - 1] = '\0';
- }
+ altname = gfc_get_name_from_uop (name);
newname = name;
if (rop == OMP_REDUCTION_USER)
newname = find_use_name (altname ? altname : name, !!altname);
@@ -5074,15 +5067,7 @@ load_omp_udrs (void)
continue;
}
if (altname && newname != altname)
- {
- size_t len = strlen (newname);
- altname = XALLOCAVEC (char, len + 3);
- altname[0] = '.';
- memcpy (altname + 1, newname, len);
- altname[len + 1] = '.';
- altname[len + 2] = '\0';
- name = gfc_get_string ("%s", altname);
- }
+ name = altname = gfc_get_uop_from_name (newname);
st = gfc_find_symtree (gfc_current_ns->omp_udr_root, name);
gfc_omp_udr *udr = gfc_omp_udr_find (st, &ts);
if (udr)
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 289d85734bd..900ab49c478 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -3044,6 +3044,27 @@ gfc_find_uop (const char *name, gfc_namespace *ns)
return (st == NULL) ? NULL : st->n.uop;
}
+/* Given a name return a string usable as user operator name. */
+const char *
+gfc_get_uop_from_name (const char* name) {
+ gcc_assert (name[0] != '.');
+ return gfc_get_string (".%s.", name);
+}
+
+/* Given a user operator name return a string usable as name. */
+const char *
+gfc_get_name_from_uop (const char* name) {
+ gcc_assert (name[0] == '.');
+ const size_t len = strlen (name) - 1;
+ gcc_assert (len > 1);
+ gcc_assert (name[len] == '.');
+ char *buffer = XNEWVEC (char, len);
+ memcpy (buffer, name + 1, len - 1);
+ buffer[len - 1] = '\0';
+ const char *ret = gfc_get_string ("%s", buffer);
+ XDELETEVEC (buffer);
+ return ret;
+}
/* Update a symbol's common_block field, and take care of the associated
memory management. */
--
2.33.0
Re: [PATCH,FORTRAN] Fix memory leak in finalization wrappers
On Wed, 27 Oct 2021 23:39:43 +0200 Bernhard Reutner-Fischer wrote: > Ping > [hmz. it's been a while, I'll rebase and retest this one. > Ok if it passes?] Testing passed without any new regressions. Ok for trunk? thanks, > > On Mon, 15 Oct 2018 10:23:06 +0200 > Bernhard Reutner-Fischer wrote: > > > If a finalization is not required we created a namespace containing > > formal arguments for an internal interface definition but never used > > any of these. So the whole sub_ns namespace was not wired up to the > > program and consequently was never freed. The fix is to simply not > > generate any finalization wrappers if we know that it will be unused. > > Note that this reverts back to the original r190869 > > (8a96d64282ac534cb597f446f02ac5d0b13249cc) handling for this case > > by reverting this specific part of r194075 > > (f1ee56b4be7cc3892e6ccc75d73033c129098e87) for PR fortran/37336. > > > > Regtests cleanly, installed to the fortran-fe-stringpool branch, sent > > here for reference and later inclusion. > > I might plug a few more leaks in preparation of switching to hash-maps. > > I fear that the leaks around interfaces are another candidate ;) > > > > Should probably add a tag for the compile-time leak PR68800 shouldn't i. > > > > valgrind summary for e.g. > > gfortran.dg/abstract_type_3.f03 and gfortran.dg/abstract_type_4.f03 > > where ".orig" is pristine trunk and ".mine" contains this fix: > > > > at3.orig.vg:LEAK SUMMARY: > > at3.orig.vg- definitely lost: 8,460 bytes in 11 blocks > > at3.orig.vg- indirectly lost: 13,288 bytes in 55 blocks > > at3.orig.vg- possibly lost: 0 bytes in 0 blocks > > at3.orig.vg- still reachable: 572,278 bytes in 2,142 blocks > > at3.orig.vg-suppressed: 0 bytes in 0 blocks > > at3.orig.vg- > > at3.orig.vg-Use --track-origins=yes to see where uninitialised values come > > from > > at3.orig.vg-ERROR SUMMARY: 38 errors from 33 contexts (suppressed: 0 from 0) > > -- > > at3.mine.vg:LEAK SUMMARY: > > at3.mine.vg- definitely lost: 344 bytes in 1 blocks > > at3.mine.vg- indirectly lost: 7,192 bytes in 18 blocks > > at3.mine.vg- possibly lost: 0 bytes in 0 blocks > > at3.mine.vg- still reachable: 572,278 bytes in 2,142 blocks > > at3.mine.vg-suppressed: 0 bytes in 0 blocks > > at3.mine.vg- > > at3.mine.vg-ERROR SUMMARY: 1 errors from 1 contexts (suppressed: 0 from 0) > > at3.mine.vg-ERROR SUMMARY: 1 errors from 1 contexts (suppressed: 0 from 0) > > at4.orig.vg:LEAK SUMMARY: > > at4.orig.vg- definitely lost: 13,751 bytes in 12 blocks > > at4.orig.vg- indirectly lost: 11,976 bytes in 60 blocks > > at4.orig.vg- possibly lost: 0 bytes in 0 blocks > > at4.orig.vg- still reachable: 572,278 bytes in 2,142 blocks > > at4.orig.vg-suppressed: 0 bytes in 0 blocks > > at4.orig.vg- > > at4.orig.vg-Use --track-origins=yes to see where uninitialised values come > > from > > at4.orig.vg-ERROR SUMMARY: 18 errors from 16 contexts (suppressed: 0 from 0) > > -- > > at4.mine.vg:LEAK SUMMARY: > > at4.mine.vg- definitely lost: 3,008 bytes in 3 blocks > > at4.mine.vg- indirectly lost: 4,056 bytes in 11 blocks > > at4.mine.vg- possibly lost: 0 bytes in 0 blocks > > at4.mine.vg- still reachable: 572,278 bytes in 2,142 blocks > > at4.mine.vg-suppressed: 0 bytes in 0 blocks > > at4.mine.vg- > > at4.mine.vg-ERROR SUMMARY: 3 errors from 3 contexts (suppressed: 0 from 0) > > at4.mine.vg-ERROR SUMMARY: 3 errors from 3 contexts (suppressed: 0 from 0) > > > > gcc/fortran/ChangeLog: > > > > 2018-10-12 Bernhard Reutner-Fischer > > > > * class.c (generate_finalization_wrapper): Do leak finalization > > wrappers if they will not be used. > > * expr.c (gfc_free_actual_arglist): Formatting fix. > > * gfortran.h (gfc_free_symbol): Pass argument by reference. > > (gfc_release_symbol): Likewise. > > (gfc_free_namespace): Likewise. > > * symbol.c (gfc_release_symbol): Adjust acordingly. > > (free_components): Set procedure pointer components > > of derived types to NULL after freeing. > > (free_tb_tree): Likewise. > > (gfc_free_symbol): Set sym to NULL after freeing. > > (gfc_free_namespace): Set namespace to NULL after freeing. > > --- > > gcc/fortran/class.c| 25 + > > gcc/fortran/expr.c | 2 +- > > gcc/fortran/gfortran.h | 6 +++--- > > gcc/fortran/symbol.c | 19 ++- > > 4 files changed, 23 insertions(+), 29 deletions(-) > > > > diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c > > index 69c95fc5dfa..e0bb381a55f 100644 > > --- a/gcc/fortran/class.c > > +++ b/gcc/fortran/class.c > > @@ -1533,7 +1533,6 @@ generate_finalization_wrapper (gfc_symbol *derived, > > gfc_namespace *ns, > >gfc_code *last_code, *block; > >const char *name; > >bool finalizable_comp = false; > > - bool expr_null_wrapper = false; > >gfc_expr *ancestor_wrapper = NULL, *rank; > >gfc_iterator *iter; > > > > @@ -1561,13 +1560,17 @@ genera
Re: [PATCH,Fortran 0/1] Correct CAF locations in simplify
On Wed, 27 Oct 2021 23:29:40 +0200 Bernhard Reutner-Fischer wrote: > Hi! > > I found this lying around in an oldish tree. > Regtest running over night, ok for trunk if it passes? Regtest turned up no regressions. Ok for trunk? thanks, > > Bernhard Reutner-Fischer (1): > Tweak locations around CAF simplify > > gcc/fortran/simplify.c | 28 +++- > 1 file changed, 15 insertions(+), 13 deletions(-) >
Re: [PATCH,FORTRAN 28/29] Free type-bound procedure structs
ping [Rebased, re-regtested cleanly. Ok for trunk?] On Wed, 5 Sep 2018 14:57:31 + Bernhard Reutner-Fischer wrote: > From: Bernhard Reutner-Fischer > > compiling gfortran.dg/typebound_proc_31.f90 leaked the type-bound > structs: > > 56 bytes in 1 blocks are definitely lost. > at 0x4C2CC05: calloc (vg_replace_malloc.c:711) > by 0x151EA90: xcalloc (xmalloc.c:162) > by 0x8E3E4F: gfc_get_typebound_proc(gfc_typebound_proc*) (symbol.c:4945) > by 0x84C095: match_procedure_in_type (decl.c:10486) > by 0x84C095: gfc_match_procedure() (decl.c:6696) > ... > > gcc/fortran/ChangeLog: > > 2017-12-06 Bernhard Reutner-Fischer > > * symbol.c (free_tb_tree): Free type-bound procedure struct. > (gfc_get_typebound_proc): Use explicit memcpy for clarity. > --- > gcc/fortran/symbol.c | 4 ++-- > 1 file changed, 2 insertions(+), 2 deletions(-) > > diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c > index 53c760a6c38..cde34c67482 100644 > --- a/gcc/fortran/symbol.c > +++ b/gcc/fortran/symbol.c > @@ -3845,7 +3845,7 @@ free_tb_tree (gfc_symtree *t) > >/* TODO: Free type-bound procedure structs themselves; probably needs some > sort of ref-counting mechanism. */ > - > + free (t->n.tb); >free (t); > } > > @@ -5052,7 +5052,7 @@ gfc_get_typebound_proc (gfc_typebound_proc *tb0) > >result = XCNEW (gfc_typebound_proc); >if (tb0) > -*result = *tb0; > +memcpy (result, tb0, sizeof (gfc_typebound_proc));; >result->error = 1; > >latest_undo_chgset->tbps.safe_push (result);
Re: libgfortran.so SONAME and powerpc64le-linux ABI changes (work in progress patches)
Here are the patches I worked on today. It does seem to fix KIND=16 to use
Float128, but by not considering long double for KIND processing, it breaks the
tests that want to do ISO C binding to long double.
Feel free to completely ignore the patches and go off in a different
direction. But I thought it would be useful to share what I've done.
> From 443773ac040383311384577b48ecc0bd957ff328 Mon Sep 17 00:00:00 2001
> From: Michael Meissner
> Date: Thu, 28 Oct 2021 23:23:53 -0400
> Subject: [PATCH] Initial patch for PowerPC Fortran KIND=16
This is a work in progress patch. It attempts to make Fortran KIND=16 to
always mean Float128 on PowerPC VSX systems. Unfortunately, in changing
KIND=16 to Float128, it breaks all of the ISO C bindings for long double
support in Fortran.
gcc/
2021-10-28 Michael Meissner
* config/rs6000/rs6000.h (FORTRAN_USE_FLOAT128): New macro.
(FORTRAN_USE_LONG_DOUBLE): New macro.
* tree.h (complex_float128_type_node): Define.
* doc/tm.texi.in (FORTRAN_USE_FLOAT128): Add documentation.
(FORTRAN_USE_LONG_DOUBLE): Likewise.
* doc/tm.texi: Regenerate.
gcc/fortran/
2021-10-28 Michael Meissner
* f95-lang.c (gfc_init_builtin_functions): Flesh out more Float128
support.
* gfortran.h (FORTRAN_USE_LONG_DOUBLE): Provide default
definition.
(FORTRAN_USE_FLOAT128): Likewise.
* trans-types.c (gfc_init_kinds): Add support for
FORTRAN_USE_LONG_DOUBLE and FORTRAN_USE_FLOAT128.
(gfc_build_real_type): Likewise.
(gfc_build_complex_type): Add support for Float128 complex.
---
gcc/config/rs6000/rs6000.h | 10 ++
gcc/doc/tm.texi| 13 +
gcc/doc/tm.texi.in | 13 +
gcc/fortran/f95-lang.c | 28
gcc/fortran/gfortran.h | 13 +
gcc/fortran/trans-types.c | 24 +---
gcc/tree.h | 2 ++
7 files changed, 96 insertions(+), 7 deletions(-)
diff --git a/gcc/config/rs6000/rs6000.h b/gcc/config/rs6000/rs6000.h
index 3eba1c072cf..4e016e548db 100644
--- a/gcc/config/rs6000/rs6000.h
+++ b/gcc/config/rs6000/rs6000.h
@@ -2691,3 +2691,13 @@ while (0)
rs6000_asm_output_opcode (STREAM); \
} \
while (0)
+
+/* Whether Fortran should use long double or __float128 for KIND=16. If we
+ support IEEE 128-bit and long double is not IEEE 128-bit, then use the
+ _Float128 type for KIND=16. Otherwise use long double. */
+#undef FORTRAN_USE_FLOAT128
+#define FORTRAN_USE_FLOAT128 (TARGET_FLOAT128_TYPE && !TARGET_IEEEQUAD)
+
+#undef FORTRAN_USE_LONG_DOUBLE
+#define FORTRAN_USE_LONG_DOUBLE(!FORTRAN_USE_FLOAT128)
+
diff --git a/gcc/doc/tm.texi b/gcc/doc/tm.texi
index 902402d7503..13ecca2605c 100644
--- a/gcc/doc/tm.texi
+++ b/gcc/doc/tm.texi
@@ -12612,3 +12612,16 @@ counters are incremented using atomic operations.
Targets not supporting
64-bit atomic operations may override the default value and request a 32-bit
type.
@end deftypefn
+
+@defmac FORTRAN_USE_LONG_DOUBLE
+Define this macro to return true if Fortran should enable @code{long
+double} support for @code{KIND} processing. If you do not define this
+macro, Fortran always uses the @code{long double} type.
+@end defmac
+
+@defmac FORTRAN_USE_LONG_DOUBLE
+Define this macro to return true if Fortran should enable
+@code{_Float128} support for @code{KIND} processing. If you do not
+define this macro, Fortran will enable @code{_Float128} support if the
+quadmath library is built, and the mode @code{TFmode} is enabled.
+@end defmac
diff --git a/gcc/doc/tm.texi.in b/gcc/doc/tm.texi.in
index 86352dc9bd2..012ef1ecc98 100644
--- a/gcc/doc/tm.texi.in
+++ b/gcc/doc/tm.texi.in
@@ -8187,3 +8187,16 @@ maintainer is familiar with.
@hook TARGET_MEMTAG_UNTAGGED_POINTER
@hook TARGET_GCOV_TYPE_SIZE
+
+@defmac FORTRAN_USE_LONG_DOUBLE
+Define this macro to return true if Fortran should enable @code{long
+double} support for @code{KIND} processing. If you do not define this
+macro, Fortran always uses the @code{long double} type.
+@end defmac
+
+@defmac FORTRAN_USE_LONG_DOUBLE
+Define this macro to return true if Fortran should enable
+@code{_Float128} support for @code{KIND} processing. If you do not
+define this macro, Fortran will enable @code{_Float128} support if the
+quadmath library is built, and the mode @code{TFmode} is enabled.
+@end defmac
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 58dcaf01d75..b8117dc72b4 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -674,9 +674,11 @@ gfc_init_builtin_functions (void)
tree mfunc_float[6];
tree mfunc_double[6];
tree mfunc_longdouble[6];
+ tree mfunc_float128[6];
tree mfunc_cfloat[6];
tree mfunc_cdouble[6];
tree mfunc_clongdouble[6];
+ tree mfunc_cfloat128[6];
tree func_cfloat_float, func_flo
