Re: [Patch, fortran] PR59104
Hi Paul,
your approach sounds entirely reasonable.
But as the following addition to the testcase shows, there seem to
be loopholes left.
When I add the following to function f:
integer :: l1(size(y))
integer :: l2(size(z))
print *, size (l1), size (l2), size (z)
I get:
0 0 3
Expected:
2 3 3
Can you please check?
Thanks,
Harald
Am 09.06.24 um 17:57 schrieb Paul Richard Thomas:
Hi All,
I have extended the testcase - see below and have
s/dependent_decls_2/dependent_decls_2.f90/ in the ChnageLog.
Cheers
Paul
! { dg-do run }
!
! Fix for PR59104 in which the dependence on the old style function result
! was not taken into account in the ordering of auto array allocation and
! characters with dependent lengths.
!
! Contributed by Tobias Burnus
!
module m
implicit none
integer, parameter :: dp = kind([double precision::])
contains
function f(x)
integer, intent(in) :: x
real(dp) f(x/2)
real(dp) g(x/2)
integer y(size (f)+1) ! This was the original problem
integer z(size (f) + size (y)) ! Found in development of the fix
integer w(size (f) + size (y) + x) ! Check dummy is OK
f = 10.0
y = 1! Stop -Wall from complaining
z = 1
g = 1
w = 1
if (size (f) .ne. 1) stop 1
if (size (g) .ne. 1) stop 2
if (size (y) .ne. 2) stop 3
if (size (z) .ne. 3) stop 4
if (size (w) .ne. 5) stop 5
end function f
function e(x) result(f)
integer, intent(in) :: x
real(dp) f(x/2)
real(dp) g(x/2)
integer y(size (f)+1)
integer z(size (f) + size (y)) ! As was this.
integer w(size (f) + size (y) + x)
f = 10.0
y = 1
z = 1
g = 1
w = 1
if (size (f) .ne. 2) stop 6
if (size (g) .ne. 2) stop 7
if (size (y) .ne. 3) stop 8
if (size (z) .ne. 5) stop 9
if (size (w) .ne. 9) stop 10
end function
function d(x) ! After fixes to arrays, what was needed was known!
integer, intent(in) :: x
character(len = x/2) :: d
character(len = len (d)) :: line
character(len = len (d) + len (line)) :: line2
character(len = len (d) + len (line) + x) :: line3
line = repeat ("a", len (d))
line2 = repeat ("b", x)
line3 = repeat ("c", len (line3))
if (len (line2) .ne. x) stop 11
if (line3 .ne. "") stop 12
d = line
end
end module m
program p
use m
implicit none
real(dp) y
y = sum (f (2))
if (int (y) .ne. 10) stop 13
y = sum (e (4))
if (int (y) .ne. 20) stop 14
if (d (4) .ne. "aa") stop 15
end program p
On Sun, 9 Jun 2024 at 07:14, Paul Richard Thomas <
paul.richard.tho...@gmail.com> wrote:
Hi All,
The attached fixes a problem that, judging by the comments, has been
looked at periodically over the last ten years but just looked to be too
fiendishly complicated to fix. This is not in small part because of the
confusing ordering of dummies in the tlink chain and the unintuitive
placement of all deferred initializations to the front of the init chain in
the wrapped block.
The result of the existing ordering is that the initialization code for
non-dummy variables that depends on the function result occurs before any
initialization code for the function result itself. The fix ensures that:
(i) These variables are placed correctly in the tlink chain, respecting
inter-dependencies; and (ii) The dependent initializations are placed at
the end of the wrapped block init chain. The details appear in the
comments in the patch. It is entirely possible that a less clunky fix
exists but I failed to find it.
OK for mainline?
Regards
Paul
Re: [Patch, fortran] PR59104
Hi All,
I have extended the testcase - see below and have
s/dependent_decls_2/dependent_decls_2.f90/ in the ChnageLog.
Cheers
Paul
! { dg-do run }
!
! Fix for PR59104 in which the dependence on the old style function result
! was not taken into account in the ordering of auto array allocation and
! characters with dependent lengths.
!
! Contributed by Tobias Burnus
!
module m
implicit none
integer, parameter :: dp = kind([double precision::])
contains
function f(x)
integer, intent(in) :: x
real(dp) f(x/2)
real(dp) g(x/2)
integer y(size (f)+1) ! This was the original problem
integer z(size (f) + size (y)) ! Found in development of the fix
integer w(size (f) + size (y) + x) ! Check dummy is OK
f = 10.0
y = 1! Stop -Wall from complaining
z = 1
g = 1
w = 1
if (size (f) .ne. 1) stop 1
if (size (g) .ne. 1) stop 2
if (size (y) .ne. 2) stop 3
if (size (z) .ne. 3) stop 4
if (size (w) .ne. 5) stop 5
end function f
function e(x) result(f)
integer, intent(in) :: x
real(dp) f(x/2)
real(dp) g(x/2)
integer y(size (f)+1)
integer z(size (f) + size (y)) ! As was this.
integer w(size (f) + size (y) + x)
f = 10.0
y = 1
z = 1
g = 1
w = 1
if (size (f) .ne. 2) stop 6
if (size (g) .ne. 2) stop 7
if (size (y) .ne. 3) stop 8
if (size (z) .ne. 5) stop 9
if (size (w) .ne. 9) stop 10
end function
function d(x) ! After fixes to arrays, what was needed was known!
integer, intent(in) :: x
character(len = x/2) :: d
character(len = len (d)) :: line
character(len = len (d) + len (line)) :: line2
character(len = len (d) + len (line) + x) :: line3
line = repeat ("a", len (d))
line2 = repeat ("b", x)
line3 = repeat ("c", len (line3))
if (len (line2) .ne. x) stop 11
if (line3 .ne. "") stop 12
d = line
end
end module m
program p
use m
implicit none
real(dp) y
y = sum (f (2))
if (int (y) .ne. 10) stop 13
y = sum (e (4))
if (int (y) .ne. 20) stop 14
if (d (4) .ne. "aa") stop 15
end program p
On Sun, 9 Jun 2024 at 07:14, Paul Richard Thomas <
paul.richard.tho...@gmail.com> wrote:
> Hi All,
>
> The attached fixes a problem that, judging by the comments, has been
> looked at periodically over the last ten years but just looked to be too
> fiendishly complicated to fix. This is not in small part because of the
> confusing ordering of dummies in the tlink chain and the unintuitive
> placement of all deferred initializations to the front of the init chain in
> the wrapped block.
>
> The result of the existing ordering is that the initialization code for
> non-dummy variables that depends on the function result occurs before any
> initialization code for the function result itself. The fix ensures that:
> (i) These variables are placed correctly in the tlink chain, respecting
> inter-dependencies; and (ii) The dependent initializations are placed at
> the end of the wrapped block init chain. The details appear in the
> comments in the patch. It is entirely possible that a less clunky fix
> exists but I failed to find it.
>
> OK for mainline?
>
> Regards
>
> Paul
>
>
>
>
Re: Fortran compiler
Hi FX, Thank you so much for your prompt response. Glad to know Gfortran is free. I really appreciate that you have shared the link with me. I will take a look. All the best, Zhenjin From: FX Coudert Sent: Sunday, June 9, 2024 4:07 AM To: Zhenjin Zhu Cc: Fortran List Subject: Re: Fortran compiler > I am interested in your company's Fortran Compiler. > Is it free? If not, how much for a permanent license? gfortran is free, part of GCC which is open source software. It is provided on your system: - for Windows see there: https://gcc.gnu.org/wiki/GFortranBinaries - for macOS, as part of Homebrew and Macports - for Linux, as part of gcc in your system package management Best regards, FX
Re: Fortran compiler
> I am interested in your company's Fortran Compiler. > Is it free? If not, how much for a permanent license? gfortran is free, part of GCC which is open source software. It is provided on your system: - for Windows see there: https://gcc.gnu.org/wiki/GFortranBinaries - for macOS, as part of Homebrew and Macports - for Linux, as part of gcc in your system package management Best regards, FX
[Patch, fortran] PR59104
Hi All,
The attached fixes a problem that, judging by the comments, has been looked
at periodically over the last ten years but just looked to be too
fiendishly complicated to fix. This is not in small part because of the
confusing ordering of dummies in the tlink chain and the unintuitive
placement of all deferred initializations to the front of the init chain in
the wrapped block.
The result of the existing ordering is that the initialization code for
non-dummy variables that depends on the function result occurs before any
initialization code for the function result itself. The fix ensures that:
(i) These variables are placed correctly in the tlink chain, respecting
inter-dependencies; and (ii) The dependent initializations are placed at
the end of the wrapped block init chain. The details appear in the
comments in the patch. It is entirely possible that a less clunky fix
exists but I failed to find it.
OK for mainline?
Regards
Paul
Change.Logs
Description: Binary data
diff --git a/gcc/fortran/dependency.cc b/gcc/fortran/dependency.cc
index bafe8cbc5bc..97ace8c778e 100644
--- a/gcc/fortran/dependency.cc
+++ b/gcc/fortran/dependency.cc
@@ -2497,3 +2497,63 @@ gfc_omp_expr_prefix_same (gfc_expr *lexpr, gfc_expr *rexpr)
return true;
}
+
+
+/* gfc_function_dependency returns true for non-dummy symbols with dependencies
+ on an old-fashioned function result (ie. proc_name = proc_name->result).
+ This is used to ensure that initialization code appears after the function
+ result is treated and that any mutual dependencies between these symbols are
+ respected. */
+
+static bool
+dependency_fcn (gfc_expr *e, gfc_symbol *sym,
+ int *f ATTRIBUTE_UNUSED)
+{
+ if (e == NULL)
+return false;
+
+ if (e && e->expr_type == EXPR_VARIABLE
+ && e->symtree
+ && e->symtree->n.sym == sym)
+return true;
+
+ return false;
+}
+
+
+bool
+gfc_function_dependency (gfc_symbol *sym, gfc_symbol *proc_name)
+{
+ bool front = false;
+
+ if (proc_name && proc_name->attr.function
+ && proc_name == proc_name->result
+ && !(sym->attr.dummy || sym->attr.result))
+{
+ if (sym->as && sym->as->type == AS_EXPLICIT)
+ {
+ for (int dim = 0; dim < sym->as->rank; dim++)
+ {
+ if (sym->as->lower[dim]
+ && sym->as->lower[dim]->expr_type != EXPR_CONSTANT)
+ front = gfc_traverse_expr (sym->as->lower[dim], proc_name,
+ dependency_fcn, 0);
+ if (front)
+ break;
+ if (sym->as->upper[dim]
+ && sym->as->upper[dim]->expr_type != EXPR_CONSTANT)
+ front = gfc_traverse_expr (sym->as->upper[dim], proc_name,
+ dependency_fcn, 0);
+ if (front)
+ break;
+ }
+ }
+
+ if (sym->ts.type == BT_CHARACTER
+ && sym->ts.u.cl && sym->ts.u.cl->length
+ && sym->ts.u.cl->length->expr_type != EXPR_CONSTANT)
+ front = gfc_traverse_expr (sym->ts.u.cl->length, proc_name,
+ dependency_fcn, 0);
+}
+ return front;
+ }
diff --git a/gcc/fortran/dependency.h b/gcc/fortran/dependency.h
index ea4bd04b0e8..0fa5f93d0fc 100644
--- a/gcc/fortran/dependency.h
+++ b/gcc/fortran/dependency.h
@@ -23,7 +23,7 @@ enum gfc_dep_check
{
NOT_ELEMENTAL,/* Not elemental case: normal dependency check. */
ELEM_CHECK_VARIABLE, /* Test whether variables overlap. */
- ELEM_DONT_CHECK_VARIABLE /* Test whether variables overlap only if used
+ ELEM_DONT_CHECK_VARIABLE /* Test whether variables overlap only if used
in an expression. */
};
@@ -43,3 +43,5 @@ bool gfc_are_equivalenced_arrays (gfc_expr *, gfc_expr *);
bool gfc_omp_expr_prefix_same (gfc_expr *, gfc_expr *);
gfc_expr * gfc_discard_nops (gfc_expr *);
+
+bool gfc_function_dependency (gfc_symbol *, gfc_symbol *);
\ No newline at end of file
diff --git a/gcc/fortran/error.cc b/gcc/fortran/error.cc
index 65e38b0e866..60f607ecc4f 100644
--- a/gcc/fortran/error.cc
+++ b/gcc/fortran/error.cc
@@ -892,7 +892,7 @@ error_print (const char *type, const char *format0, va_list argp)
#else
m = INTTYPE_MAXIMUM (ptrdiff_t);
#endif
- m = 2 * m + 1;
+ m = 2 * m + 1;
error_uinteger (a & m);
}
else
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 0a1646def67..7e39981e843 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -27,6 +27,7 @@ along with GCC; see the file COPYING3. If not see
#include "parse.h"
#include "match.h"
#include "constructor.h"
+#include "dependency.h"
/* Strings for all symbol attributes. We use these for dumping the
@@ -948,15 +949,18 @@ conflict_std:
void
gfc_set_sym_referenced (gfc_symbol *sym)
{
+ gfc_symbol *proc_name = sym->ns->proc_name ? sym->ns->proc_name : NULL;
if (sym->attr.referenced)
return;
sym->attr.referenced = 1;
- /* Remember which order dummy variables are accessed in. */
- if (sym->attr.dummy)
-sym->dummy_order = next_dummy_order++;
+ /* Remember which order dummy variables and symbols with function result
+ dependencies are accessed in.
