Re: [patch, libgfortran] PR109358
Hi Jerry. Am 12.02.24 um 22:28 schrieb Jerry D: The attached patch fixes this PR by properly adjusting some variables When using stream io. See log below. New test case included. Regression tested on x86_64. OK for trunk and backport? the patch looks good to me. As it is simple and very local, feel free to backport at your discretion. Thanks for the patch! Harald Regards, Jerry ChangeLog: libgfortran: Adjust bytes_left and pos for access="STREAM". During tab edits, the pos (position) and bytes_used Variables were not being set correctly for stream I/O. Since stream I/O does not have 'real' records, the format buffer active length must be used instead of the record length variable. libgfortran/ChangeLog: PR libgfortran/109358 * io/transfer.c (formatted_transfer_scalar_write): Adjust bytes_used and pos variable for stream access. gcc/testsuite/ChangeLog: PR libgfortran/109358 * gfortran.dg/pr109358.f90: New test.
[patch, libgfortran] PR109358
The attached patch fixes this PR by properly adjusting some variables
When using stream io. See log below. New test case included.
Regression tested on x86_64.
OK for trunk and backport?
Regards,
Jerry
ChangeLog:
libgfortran: Adjust bytes_left and pos for access="STREAM".
During tab edits, the pos (position) and bytes_used
Variables were not being set correctly for stream I/O.
Since stream I/O does not have 'real' records, the
format buffer active length must be used instead of
the record length variable.
libgfortran/ChangeLog:
PR libgfortran/109358
* io/transfer.c (formatted_transfer_scalar_write): Adjust
bytes_used and pos variable for stream access.
gcc/testsuite/ChangeLog:
PR libgfortran/109358
* gfortran.dg/pr109358.f90: New test.
diff --git a/gcc/testsuite/gfortran.dg/pr109358.f90 b/gcc/testsuite/gfortran.dg/pr109358.f90
new file mode 100644
index 000..5013984095b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr109358.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! PR109358, test that tabs during stream io are correct.
+program tabs
+ implicit none
+ integer :: fd
+ character(64) :: line
+ open(newunit=fd, file="otabs.txt", form="formatted", access="stream")
+ write(fd, "(i4, t40, i4, t20, i5.5)") 1234, , 67890
+ close(fd)
+ open(newunit=fd, file="otabs.txt", form="formatted")
+ read(fd,"(a)") line
+ close(fd, status='delete')
+ if (line .ne. "1234 67890 ") stop 10
+end program tabs
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 80b60dfeb9f..99ef96a9e7c 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -2072,11 +2072,11 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
dtp->u.p.skips = dtp->u.p.pending_spaces = 0;
}
- bytes_used = dtp->u.p.current_unit->recl
- - dtp->u.p.current_unit->bytes_left;
-
if (is_stream_io(dtp))
- bytes_used = 0;
+ bytes_used = dtp->u.p.current_unit->fbuf->act;
+ else
+ bytes_used = dtp->u.p.current_unit->recl
+ - dtp->u.p.current_unit->bytes_left;
switch (t)
{
@@ -2452,7 +2452,11 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
p = ((char *) p) + size;
}
- pos = dtp->u.p.current_unit->recl - dtp->u.p.current_unit->bytes_left;
+ if (is_stream_io(dtp))
+ pos = dtp->u.p.current_unit->fbuf->act;
+ else
+ pos = dtp->u.p.current_unit->recl - dtp->u.p.current_unit->bytes_left;
+
dtp->u.p.max_pos = (dtp->u.p.max_pos > pos) ? dtp->u.p.max_pos : pos;
}
[PATCH] Fortran: fix passing of optional dummies to bind(c) procedures [PR113866]
Dear all,
the attached patch fixes a mis-handling of optional dummy arguments
passed to optional dummy arguments of procedures with the bind(c)
attribute. When those procedures are expecting CFI descriptors,
there is no special treatment like a presence check necessary
that by default passes a NULL pointer as default.
The testcase tries to exercise various combinations of passing
assumed-length character between bind(c) and non-bind(c), which
apparently was insufficiently covered in the testsuite.
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
From 87d1b973a4d6a561dc3f3a0c4c10f76d155fa000 Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Mon, 12 Feb 2024 21:39:09 +0100
Subject: [PATCH] Fortran: fix passing of optional dummies to bind(c)
procedures [PR113866]
PR fortran/113866
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_conv_procedure_call): When passing an optional
dummy argument to an optional dummy argument of a bind(c) procedure
and the dummy argument is passed via a CFI descriptor, no special
presence check and passing of a default NULL pointer is needed.
gcc/testsuite/ChangeLog:
* gfortran.dg/bind_c_optional-2.f90: New test.
---
gcc/fortran/trans-expr.cc | 6 +-
.../gfortran.dg/bind_c_optional-2.f90 | 104 ++
2 files changed, 108 insertions(+), 2 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/bind_c_optional-2.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 67abca9f6ba..a0593b76f18 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -7269,8 +7269,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
with an interface indicating an optional argument. When we call
an intrinsic subroutine, however, fsym is NULL, but we might still
have an optional argument, so we proceed to the substitution
- just in case. */
- if (e && (fsym == NULL || fsym->attr.optional))
+ just in case. Arguments passed to bind(c) procedures via CFI
+ descriptors are handled elsewhere. */
+ if (e && (fsym == NULL || fsym->attr.optional)
+ && !(sym->attr.is_bind_c && is_CFI_desc (fsym, NULL)))
{
/* If an optional argument is itself an optional dummy argument,
check its presence and substitute a null if absent. This is
diff --git a/gcc/testsuite/gfortran.dg/bind_c_optional-2.f90 b/gcc/testsuite/gfortran.dg/bind_c_optional-2.f90
new file mode 100644
index 000..b8b4c87775e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_optional-2.f90
@@ -0,0 +1,104 @@
+! { dg-do run }
+! PR fortran/113866
+!
+! Check interoperability of assumed-length character (optional and
+! non-optional) dummies between bind(c) and non-bind(c) procedures
+
+module bindcchar
+ implicit none
+ integer, parameter :: n = 100, l = 10
+contains
+ subroutine bindc_optional (c2, c4) bind(c)
+character(*), optional :: c2, c4(n)
+! print *, c2(1:3)
+! print *, c4(5)(1:3)
+if (.not. present (c2) .or. .not. present (c4)) stop 8
+if (c2(1:3)/= "a23") stop 1
+if (c4(5)(1:3) /= "bcd") stop 2
+if (len (c2) /= l .or. len (c4) /= l) stop 81
+ end
+
+ subroutine bindc (c2, c4) bind(c)
+character(*) :: c2, c4(n)
+if (c2(1:3)/= "a23") stop 3
+if (c4(5)(1:3) /= "bcd") stop 4
+if (len (c2) /= l .or. len (c4) /= l) stop 82
+call bindc_optional (c2, c4)
+ end
+
+ subroutine not_bindc_optional (c1, c3)
+character(*), optional :: c1, c3(n)
+if (.not. present (c1) .or. .not. present (c3)) stop 5
+call bindc_optional (c1, c3)
+call bindc (c1, c3)
+if (len (c1) /= l .or. len (c3) /= l) stop 83
+ end
+
+ subroutine not_bindc_optional_deferred (c5, c6)
+character(:), allocatable, optional :: c5, c6(:)
+if (.not. present (c5) .or. .not. present (c6)) stop 6
+call not_bindc_optional (c5, c6)
+call bindc_optional (c5, c6)
+call bindc (c5, c6)
+if (len (c5) /= l .or. len (c6) /= l) stop 84
+ end
+
+ subroutine not_bindc_optional2 (c7, c8)
+character(*), optional :: c7, c8(:)
+if (.not. present (c7) .or. .not. present (c8)) stop 7
+call bindc_optional (c7, c8)
+call bindc (c7, c8)
+if (len (c7) /= l .or. len (c8) /= l) stop 85
+ end
+
+ subroutine bindc_optional2 (c2, c4) bind(c)
+character(*), optional :: c2, c4(n)
+if (.not. present (c2) .or. .not. present (c4)) stop 8
+if (c2(1:3)/= "a23") stop 9
+if (c4(5)(1:3) /= "bcd") stop 10
+call bindc_optional (c2, c4)
+call not_bindc_optional (c2, c4)
+if (len (c2) /= l .or. len (c4) /= l) stop 86
+ end
+
+ subroutine bindc_optional_missing (c1, c2, c3, c4, c5) bind(c)
+character(*), optional :: c1, c2(n), c3(:), c4(..), c5(*)
+if (present (c1)) stop 11
+if (present (c2)) stop 12
+if (present (c3)) stop 13
+if (present (c4)) stop 14
+if (present (c5)) stop 15
+ end
+
+ subroutine non_bindc_optional_missing (c1, c2, c3, c4,
Re: [PATCH v2] openmp, fortran: Add Fortran support for indirect clause on the declare target directive
Hi Kwok,
Kwok Cheung Yeung wrote:
Oops. I thought exactly the same thing yesterday, but forgot to add
the changes to my commit! Here is the updated version.
I regard(ed) this change as obvious - hence, I missed to reply.
But for completeness: LGTM.
I think it would be useful to commit this now with an xfail
for the one failing testcase that depends on the review-pending libgomp
patch.
I mean something like:
--- a/libgomp/testsuite/libgomp.fortran/declare-target-indirect-2.f90
+++ b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-2.f90
@@ -1,2 +1,3 @@
! { dg-do run }
+! { dg-xfail-run-if "Requires libgomp bug fix pending review" { offload_device
} }
Thanks,
Tobias
On 06/02/2024 9:03 am, Tobias Burnus wrote:
LGTM. I just wonder whether there should be a value test and not just
a does-not-crash-when-called test for the latter testcase, i.e.
+++ b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-3.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+
+! Check that indirect calls work on procedures passed in via a
dummy argument
+
+module m
+contains
+ subroutine bar
+ !$omp declare target enter(bar) indirect
e.g. "integer function bar()" ... " bar = 42"
+ end subroutine
+
+ subroutine foo(f)
+ procedure(bar) :: f
+
+ !$omp target
+ call f
And then: if (f() /= 42) stop 1
+ !$omp end target
+ end subroutine
+end module
Thanks,
Tobias
