[committed] gfortran.dg/gomp/affinity-clause-1.f90: Fix scan-tree-dump (was: [r13-7120 Regression] FAIL: gfortran.dg/gomp/affinity-clause-1.f90 -O scan-tree-dump-times original "#pragma omp task affin
Commit r13-7137 fixes thethe dump issue with -m32, cf. attachment.
Tobias
On 09.04.23 00:11, haochen.jiang via Gcc-patches wrote:
Fortran: Fix dg directives and remove trailing whitespaces in testsuite
caused
FAIL: gfortran.dg/gomp/affinity-clause-1.f90 -O scan-tree-dump-times original "#pragma
omp task affinity\\(iterator\\(integer\\(kind=4\\) i=D\\.[0-9]+:5:1\\):b\\[\\(.* ?
\\+ -1\\]\\) affinity\\(iterator\\(integer\\(kind=4\\)
i=D\\.[0-9]+:5:1\\):d\\[\\(\\(integer\\(kind=8\\)\\) i \\+ -1\\) \\* 6\\]\\)" 1
-
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634
München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas
Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht
München, HRB 106955
commit b8e32978e3d9e3b88cd4f441edfdebfa395a5c26
Author: Tobias Burnus
Date: Tue Apr 11 13:15:39 2023 +0200
gfortran.dg/gomp/affinity-clause-1.f90: Fix scan-tree-dump
Commit r13-7120-g46fe32cb4d887d44a62f9c4ff2a72532d4eb5a19 added the
missing hyphen to 'dg-final', which exposed an -m32 pattern mismatch.
gcc/testsuite/
* gfortran.dg/gomp/affinity-clause-1.f90: Update scan-tree pattern
for -m32.
diff --git a/gcc/testsuite/gfortran.dg/gomp/affinity-clause-1.f90 b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-1.f90
index b8c7b5d68ad..32c9acef070 100644
--- a/gcc/testsuite/gfortran.dg/gomp/affinity-clause-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-1.f90
@@ -27,2 +27 @@ end
-! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) i=D\\.\[0-9\]+:5:1\\):b\\\[\\(.* ? \\+ -1\\\]\\) affinity\\(iterator\\(integer\\(kind=4\\) i=D\\.\[0-9\]+:5:1\\):d\\\[\\(\\(integer\\(kind=8\\)\\) i \\+ -1\\) \\* 6\\\]\\)" 1 "original" } }
-
+! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) i=D\\.\[0-9\]+:5:1\\):b\\\[.* ? \\+ -1\\\]\\) affinity\\(iterator\\(integer\\(kind=4\\) i=D\\.\[0-9\]+:5:1\\):d\\\[\\(.*i \\+ -1\\) \\* 6\\\]\\)" 1 "original" } }
Re: [committed] gfortran.dg/gomp/affinity-clause-1.f90: Fix scan-tree-dump (was: [r13-7120 Regression] FAIL: gfortran.dg/gomp/affinity-clause-1.f90 -O scan-tree-dump-times original "#pragma omp task a
Hi Tobias, I started applying my poor knowledge of regular expressions to fix this last night and timed out. Thanks for doing it for me. I will look carefully and learn from the master :-) Is it really a regression, when a change exposes a latent bug? Never mind, though, it's fixed. Cheers Paul On Tue, 11 Apr 2023 at 12:22, Tobias Burnus wrote: > Commit r13-7137 fixes thethe dump issue with -m32, cf. attachment. > > Tobias > > On 09.04.23 00:11, haochen.jiang via Gcc-patches wrote: > > Fortran: Fix dg directives and remove trailing whitespaces in > testsuite > > caused > > FAIL: gfortran.dg/gomp/affinity-clause-1.f90 -O scan-tree-dump-times > original "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) > i=D\\.[0-9]+:5:1\\):b\\[\\(.* ? \\+ -1\\]\\) > affinity\\(iterator\\(integer\\(kind=4\\) > i=D\\.[0-9]+:5:1\\):d\\[\\(\\(integer\\(kind=8\\)\\) i \\+ -1\\) \\* > 6\\]\\)" 1 > - > Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, > 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: > Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; > Registergericht München, HRB 106955 > -- "If you can't explain it simply, you don't understand it well enough" - Albert Einstein
[PATCH, v2] Fortran: resolve correct generic with TYPE(C_PTR) arguments [PR61615]
Hi Jerry, all,
On 4/11/23 02:43, Jerry D via Gcc-patches wrote:
On 4/10/23 1:49 PM, Harald Anlauf via Fortran wrote:
Dear all,
when comparing formal and actual arguments of a procedure, there was no
check of rank for derived types from intrinsic module ISO_C_BINDING.
This could lead to a wrong resolution of generic procedures with dummy
argument of related types, see PR. This was likely an oversight.
The attached fix is simple and regtests cleanly on x86_64-pc-linux-gnu.
OK for mainline?
Thanks,
Harald
Looks good to go.
Jerry
I actually found a flaw in the previous patch regarding the handling
of rank, and also realized that a comparison of the types was missing
for those from this intrinsic module (and found the related PR99982).
I updated the patch accordingly and extended the testcase, see attached.
Regtests cleanly on x86_64-pc-linux-gnu.
Will wait for 24h for more comments.
Thanks,
Harald
From 3fa9d2ee99afa38f42c267d17aed5266daa22dbc Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Tue, 11 Apr 2023 16:44:32 +0200
Subject: [PATCH] Fortran: resolve correct generic with TYPE(C_PTR) arguments
[PR61615,PR99982]
gcc/fortran/ChangeLog:
PR fortran/61615
PR fortran/99982
* interface.cc (compare_parameter): Enable type and rank checks for
arguments of derived type from the intrinsic module ISO_C_BINDING.
gcc/testsuite/ChangeLog:
PR fortran/61615
PR fortran/99982
* gfortran.dg/interface_49.f90: New test.
---
gcc/fortran/interface.cc | 18 +++-
gcc/testsuite/gfortran.dg/interface_49.f90 | 95 ++
2 files changed, 112 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/interface_49.f90
diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index db79b104dc2..e9843e9549c 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -2361,7 +2361,23 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
&& formal->ts.u.derived && formal->ts.u.derived->ts.is_iso_c
&& actual->ts.type == BT_DERIVED
&& actual->ts.u.derived && actual->ts.u.derived->ts.is_iso_c)
-return true;
+{
+ if (formal->ts.u.derived->intmod_sym_id
+ != actual->ts.u.derived->intmod_sym_id)
+ return false;
+
+ if (ranks_must_agree
+ && symbol_rank (formal) != actual->rank
+ && symbol_rank (formal) != -1)
+ {
+ if (where)
+ argument_rank_mismatch (formal->name, &actual->where,
+symbol_rank (formal), actual->rank,
+NULL);
+ return false;
+ }
+ return true;
+}
if (formal->ts.type == BT_CLASS && actual->ts.type == BT_DERIVED)
/* Make sure the vtab symbol is present when
diff --git a/gcc/testsuite/gfortran.dg/interface_49.f90 b/gcc/testsuite/gfortran.dg/interface_49.f90
new file mode 100644
index 000..aef5e0c6609
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_49.f90
@@ -0,0 +1,95 @@
+! { dg-do run }
+! PR fortran/61615 - resolve correct generic with TYPE(C_PTR) arguments
+! PR fortran/99982 - dto. with C_PTR and C_FUNPTR
+! Contributed by Jacob Abel and Scot Breitenfeld
+
+MODULE foo
+ USE iso_c_binding, only : c_ptr, c_funptr
+ IMPLICIT NONE
+ integer :: rank = -99
+ character(8) :: ctyp = ""
+ INTERFACE bar
+MODULE PROCEDURE bar_s
+MODULE PROCEDURE bar_a1d
+MODULE PROCEDURE bar_a2d
+MODULE PROCEDURE bar_fp
+MODULE PROCEDURE bar_fp1
+MODULE PROCEDURE bar_fpx
+ END INTERFACE bar
+CONTAINS
+ SUBROUTINE bar_s(a)
+TYPE(c_ptr) :: a
+WRITE (0, *) 'in bar_s'
+rank = 0
+ctyp = "c_ptr"
+ END SUBROUTINE bar_s
+
+ SUBROUTINE bar_a1d(a)
+TYPE(c_ptr) :: a(:)
+WRITE (0, *) 'in bar_a1d'
+rank = 1
+ctyp = "c_ptr"
+ END SUBROUTINE bar_a1d
+
+ SUBROUTINE bar_a2d(a)
+TYPE(c_ptr) :: a(:,:)
+WRITE (0, *) 'in bar_a2d'
+rank = 2
+ctyp = "c_ptr"
+ END SUBROUTINE bar_a2d
+
+ SUBROUTINE bar_fp(a)
+TYPE(c_funptr) :: a
+WRITE (0, *) 'in bar_fp'
+rank = 0
+ctyp = "c_funptr"
+ END SUBROUTINE bar_fp
+
+ SUBROUTINE bar_fp1(a)
+TYPE(c_funptr) :: a(:)
+WRITE (0, *) 'in bar_fp1'
+rank = 1
+ctyp = "c_funptr"
+ END SUBROUTINE bar_fp1
+
+ SUBROUTINE bar_fpx(a, b)
+TYPE(c_funptr) :: a(..)
+TYPE(c_ptr):: b
+WRITE (0, *) 'in bar_fpx'
+rank = -1
+ctyp = "c_funptr"
+ END SUBROUTINE bar_fpx
+END MODULE foo
+
+PROGRAM cptr_array_vs_scalar_arg
+ USE foo
+ USE iso_c_binding, only : c_ptr, c_loc, c_funptr
+ IMPLICIT NONE
+ INTEGER, TARGET :: i
+ TYPE(c_ptr) :: a, b(1), c(1,1)
+ type(c_funptr) :: fp, fp1(1), fp2(1,1)
+ a= C_LOC(i)
+ b(1) = C_LOC(i)
+ CALL bar(a)
+ if (rank /= 0 .or. ctyp /= "c_ptr") stop 1
+ CALL bar(b)
+ if (rank /= 1 .or. ctyp /= "c_ptr") stop 2
+ CALL bar(c)
+ if (rank /= 2 .or. ctyp /= "c_ptr") stop 3
+ rank = -99
+ ctyp = ""
+ CALL bar((a))
+ if (rank /= 0 .or. ctyp /= "c_ptr") stop 4
+ CALL bar((b))
+ if (rank /= 1 .or. ctyp /= "c_ptr") stop 5
+ rank = -99
+ ctyp = ""
+ CALL bar
[PATCH] Fortran: fix functions with entry and pointer/allocatable result [PR104312]
Dear all,
the testcase in the PR by Gerhard exhibited a mis-treatment of
the function decl of the entry master if the function result
had a pointer attribute and the translation unit was compiled
with -ff2c. We actually should not use the peculiar special
treatment for default-real functions in that case, as -ff2c is
reserved for function results that can be expressed in Fortran77,
and POINTER was not allowed in that standard. Same for complex.
Furthermore, it turned out that ALLOCATABLE function results
were not yet handled for functions with entries, even without
-ff2c. Adding support for this was straightforward.
I also fixed a potential buffer overflow for a generated
internal symbol.
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
From 60e81b97cf3715347de30ed4fd579be54fdb1997 Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Tue, 11 Apr 2023 21:44:20 +0200
Subject: [PATCH] Fortran: fix functions with entry and pointer/allocatable
result [PR104312]
gcc/fortran/ChangeLog:
PR fortran/104312
* resolve.cc (resolve_entries): Handle functions with ENTRY and
ALLOCATABLE results.
* trans-expr.cc (gfc_conv_procedure_call): Functions with a result
with the POINTER or ALLOCATABLE attribute shall not get any special
treatment with -ff2c, as they cannot be written in Fortran 77.
* trans-types.cc (gfc_return_by_reference): Likewise.
(gfc_get_function_type): Likewise.
gcc/testsuite/ChangeLog:
PR fortran/104312
* gfortran.dg/entry_26.f90: New test.
* gfortran.dg/entry_27.f90: New test.
---
gcc/fortran/resolve.cc | 19 +++-
gcc/fortran/trans-expr.cc | 2 +
gcc/fortran/trans-types.cc | 4 ++
gcc/testsuite/gfortran.dg/entry_26.f90 | 64 ++
gcc/testsuite/gfortran.dg/entry_27.f90 | 64 ++
5 files changed, 152 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/entry_26.f90
create mode 100644 gcc/testsuite/gfortran.dg/entry_27.f90
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 6e42397c2ea..58013d48dff 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -702,7 +702,8 @@ resolve_entries (gfc_namespace *ns)
gfc_code *c;
gfc_symbol *proc;
gfc_entry_list *el;
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ /* Provide sufficient space to hold "master.%d.%s". */
+ char name[GFC_MAX_SYMBOL_LEN + 1 + 18];
static int master_count = 0;
if (ns->proc_name == NULL)
@@ -827,6 +828,9 @@ resolve_entries (gfc_namespace *ns)
"entries returning variables of different "
"string lengths", ns->entries->sym->name,
&ns->entries->sym->declared_at);
+ else if (el->sym->result->attr.allocatable
+ != ns->entries->sym->result->attr.allocatable)
+ break;
}
if (el == NULL)
@@ -838,6 +842,8 @@ resolve_entries (gfc_namespace *ns)
gfc_set_array_spec (proc, gfc_copy_array_spec (sym->as), NULL);
if (sym->attr.pointer)
gfc_add_pointer (&proc->attr, NULL);
+ if (sym->attr.allocatable)
+ gfc_add_allocatable (&proc->attr, NULL);
}
else
{
@@ -869,6 +875,17 @@ resolve_entries (gfc_namespace *ns)
"FUNCTION %s at %L", sym->name,
ns->entries->sym->name, &sym->declared_at);
}
+ else if (sym->attr.allocatable)
+ {
+ if (el == ns->entries)
+ gfc_error ("FUNCTION result %s cannot be ALLOCATABLE in "
+ "FUNCTION %s at %L", sym->name,
+ ns->entries->sym->name, &sym->declared_at);
+ else
+ gfc_error ("ENTRY result %s cannot be ALLOCATABLE in "
+ "FUNCTION %s at %L", sym->name,
+ ns->entries->sym->name, &sym->declared_at);
+ }
else
{
ts = &sym->ts;
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index f052d6b9440..79367fa2ae0 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -7800,6 +7800,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
*/
if (flag_f2c && sym->ts.type == BT_REAL
&& sym->ts.kind == gfc_default_real_kind
+ && !sym->attr.pointer
+ && !sym->attr.allocatable
&& !sym->attr.always_explicit)
se->expr = fold_convert (gfc_get_real_type (sym->ts.kind), se->expr);
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 9c9489a42bd..fc5c221a301 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2962,6 +2962,8 @@ gfc_return_by_reference (gfc_symbol * sym)
require an explicit interface, as no compatibility problems can
arise there. */
if (flag_f2c && sym->ts.type == BT_COMPLEX
+ && !sym->attr.pointer
+ && !sym->attr.allocatable
&& !sym->attr.intrinsic && !sym->attr.always_explicit)
return 1;
@@ -3273,6 +3275,8 @@ arg_type_list_done:
type = gfc_get_mixed_entry_union (sym->ns);
else if (flag_f2c && sym->ts.type == BT_REAL
&& sym->ts.kind == gfc_default_real_kind
+ && !sym->attr.pointer
+ && !sym->attr.
Re: [PATCH] Fortran: fix functions with entry and pointer/allocatable result [PR104312]
Hi Harald, The patch looks good to me - OK for mainline. Thanks Paul On Tue, 11 Apr 2023 at 21:12, Harald Anlauf via Fortran wrote: > Dear all, > > the testcase in the PR by Gerhard exhibited a mis-treatment of > the function decl of the entry master if the function result > had a pointer attribute and the translation unit was compiled > with -ff2c. We actually should not use the peculiar special > treatment for default-real functions in that case, as -ff2c is > reserved for function results that can be expressed in Fortran77, > and POINTER was not allowed in that standard. Same for complex. > > Furthermore, it turned out that ALLOCATABLE function results > were not yet handled for functions with entries, even without > -ff2c. Adding support for this was straightforward. > > I also fixed a potential buffer overflow for a generated > internal symbol. > > Regtested on x86_64-pc-linux-gnu. OK for mainline? > > Thanks, > Harald > > -- "If you can't explain it simply, you don't understand it well enough" - Albert Einstein
