[gcc r12-10631] Fortran: character array constructor with >= 4 constant elements [PR103115]
https://gcc.gnu.org/g:ecc80e18f05b77a773c6d894871572029d4fc579
commit r12-10631-gecc80e18f05b77a773c6d894871572029d4fc579
Author: Harald Anlauf
Date: Thu Jul 18 21:15:48 2024 +0200
Fortran: character array constructor with >= 4 constant elements [PR103115]
gcc/fortran/ChangeLog:
PR fortran/103115
* trans-array.cc (gfc_trans_array_constructor_value): If the first
element of an array constructor is deferred-length character and
therefore does not have an element size known at compile time, do
not try to collect subsequent constant elements into a constructor
for optimization.
gcc/testsuite/ChangeLog:
PR fortran/103115
* gfortran.dg/string_array_constructor_4.f90: New test.
(cherry picked from commit c93be1606ecf8e0f65b96b67aa023fb456ceb3a3)
Diff:
---
gcc/fortran/trans-array.cc | 4 +-
.../gfortran.dg/string_array_constructor_4.f90 | 59 ++
2 files changed, 62 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index c82b1fa47e59..85c641b55c52 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -2114,7 +2114,9 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock,
tree type,
p = gfc_constructor_next (p);
n++;
}
- if (n < 4)
+ /* Constructor with few constant elements, or element size not
+known at compile time (e.g. deferred-length character). */
+ if (n < 4 || !INTEGER_CST_P (TYPE_SIZE_UNIT (type)))
{
/* Scalar values. */
gfc_init_se (, NULL);
diff --git a/gcc/testsuite/gfortran.dg/string_array_constructor_4.f90
b/gcc/testsuite/gfortran.dg/string_array_constructor_4.f90
new file mode 100644
index ..b5b81f07395a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_array_constructor_4.f90
@@ -0,0 +1,59 @@
+! { dg-do run }
+! PR fortran/103115 - character array constructor with >= 4 constant elements
+!
+! This used to ICE when the first element is deferred-length character
+! or could lead to wrong results.
+
+program pr103115
+ implicit none
+ integer :: i
+ character(*), parameter :: expect(*) = [ "1","2","3","4","5" ]
+ character(5):: abc = "12345"
+ character(5), parameter :: def = "12345"
+ character(:), dimension(:), allocatable :: list
+ character(:), dimension(:), allocatable :: titles
+ titles = ["1"]
+ titles = [ titles&
+,"2"&
+,"3"&
+,"4"&
+,"5"& ! used to ICE
+]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 1
+ if (any (titles /= expect)) stop 2
+ titles = ["1"]
+ titles = [ titles, (char(48+i),i=2,5) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 3
+ if (any (titles /= expect)) stop 4
+ titles = ["1"]
+ titles = [ titles, ("2345"(i:i),i=1,4) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 5
+ if (any (titles /= expect)) stop 6
+ titles = ["1"]
+ titles = [ titles, (def(i:i),i=2,5) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 7
+ if (any (titles /= expect)) stop 8
+ list = [ (char(48+i),i=1,5) ]
+ titles = [ list(1), (char(48+i),i=2,5) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 9
+ if (any (titles /= expect)) stop 10
+ titles = ["1"]
+ titles = [ titles, (abc(i:i),i=2,5) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 11
+ if (any (titles /= expect)) stop 12
+
+ ! with typespec:
+ list = [ (char(48+i),i=1,5) ]
+ titles = [ character(2) :: list(1), (char(48+i),i=2,5) ]
+ if (len (titles) /= 2 .or. size (titles) /= 5) stop 13
+ if (any (titles /= expect)) stop 14
+ titles = ["1"]
+ titles = [ character(2) :: titles, (char(48+i),i=2,5) ]
+ if (len (titles) /= 2 .or. size (titles) /= 5) stop 15
+ if (any (titles /= expect)) stop 16
+ titles = ["1"]
+ titles = [ character(2) :: titles, (def(i:i),i=2,5) ]
+ if (len (titles) /= 2 .or. size (titles) /= 5) stop 17
+ if (any (titles /= expect)) stop 18
+ deallocate (titles, list)
+end
[gcc r13-8930] Fortran: character array constructor with >= 4 constant elements [PR103115]
https://gcc.gnu.org/g:ae6d5dc35735168c13f4599e7cf3f32fbb3c06c9
commit r13-8930-gae6d5dc35735168c13f4599e7cf3f32fbb3c06c9
Author: Harald Anlauf
Date: Thu Jul 18 21:15:48 2024 +0200
Fortran: character array constructor with >= 4 constant elements [PR103115]
gcc/fortran/ChangeLog:
PR fortran/103115
* trans-array.cc (gfc_trans_array_constructor_value): If the first
element of an array constructor is deferred-length character and
therefore does not have an element size known at compile time, do
not try to collect subsequent constant elements into a constructor
for optimization.
gcc/testsuite/ChangeLog:
PR fortran/103115
* gfortran.dg/string_array_constructor_4.f90: New test.
(cherry picked from commit c93be1606ecf8e0f65b96b67aa023fb456ceb3a3)
Diff:
---
gcc/fortran/trans-array.cc | 4 +-
.../gfortran.dg/string_array_constructor_4.f90 | 59 ++
2 files changed, 62 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 9557cd14b5e0..4d42cf1131aa 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -2119,7 +2119,9 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock,
p = gfc_constructor_next (p);
n++;
}
- if (n < 4)
+ /* Constructor with few constant elements, or element size not
+known at compile time (e.g. deferred-length character). */
+ if (n < 4 || !INTEGER_CST_P (TYPE_SIZE_UNIT (type)))
{
/* Scalar values. */
gfc_init_se (, NULL);
diff --git a/gcc/testsuite/gfortran.dg/string_array_constructor_4.f90
b/gcc/testsuite/gfortran.dg/string_array_constructor_4.f90
new file mode 100644
index ..b5b81f07395a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_array_constructor_4.f90
@@ -0,0 +1,59 @@
+! { dg-do run }
+! PR fortran/103115 - character array constructor with >= 4 constant elements
+!
+! This used to ICE when the first element is deferred-length character
+! or could lead to wrong results.
+
+program pr103115
+ implicit none
+ integer :: i
+ character(*), parameter :: expect(*) = [ "1","2","3","4","5" ]
+ character(5):: abc = "12345"
+ character(5), parameter :: def = "12345"
+ character(:), dimension(:), allocatable :: list
+ character(:), dimension(:), allocatable :: titles
+ titles = ["1"]
+ titles = [ titles&
+,"2"&
+,"3"&
+,"4"&
+,"5"& ! used to ICE
+]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 1
+ if (any (titles /= expect)) stop 2
+ titles = ["1"]
+ titles = [ titles, (char(48+i),i=2,5) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 3
+ if (any (titles /= expect)) stop 4
+ titles = ["1"]
+ titles = [ titles, ("2345"(i:i),i=1,4) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 5
+ if (any (titles /= expect)) stop 6
+ titles = ["1"]
+ titles = [ titles, (def(i:i),i=2,5) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 7
+ if (any (titles /= expect)) stop 8
+ list = [ (char(48+i),i=1,5) ]
+ titles = [ list(1), (char(48+i),i=2,5) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 9
+ if (any (titles /= expect)) stop 10
+ titles = ["1"]
+ titles = [ titles, (abc(i:i),i=2,5) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 11
+ if (any (titles /= expect)) stop 12
+
+ ! with typespec:
+ list = [ (char(48+i),i=1,5) ]
+ titles = [ character(2) :: list(1), (char(48+i),i=2,5) ]
+ if (len (titles) /= 2 .or. size (titles) /= 5) stop 13
+ if (any (titles /= expect)) stop 14
+ titles = ["1"]
+ titles = [ character(2) :: titles, (char(48+i),i=2,5) ]
+ if (len (titles) /= 2 .or. size (titles) /= 5) stop 15
+ if (any (titles /= expect)) stop 16
+ titles = ["1"]
+ titles = [ character(2) :: titles, (def(i:i),i=2,5) ]
+ if (len (titles) /= 2 .or. size (titles) /= 5) stop 17
+ if (any (titles /= expect)) stop 18
+ deallocate (titles, list)
+end
[gcc r14-10475] Fortran: character array constructor with >= 4 constant elements [PR103115]
https://gcc.gnu.org/g:ca0fa18adda03faae3464d8f44c215672b71baa5
commit r14-10475-gca0fa18adda03faae3464d8f44c215672b71baa5
Author: Harald Anlauf
Date: Thu Jul 18 21:15:48 2024 +0200
Fortran: character array constructor with >= 4 constant elements [PR103115]
gcc/fortran/ChangeLog:
PR fortran/103115
* trans-array.cc (gfc_trans_array_constructor_value): If the first
element of an array constructor is deferred-length character and
therefore does not have an element size known at compile time, do
not try to collect subsequent constant elements into a constructor
for optimization.
gcc/testsuite/ChangeLog:
PR fortran/103115
* gfortran.dg/string_array_constructor_4.f90: New test.
(cherry picked from commit c93be1606ecf8e0f65b96b67aa023fb456ceb3a3)
Diff:
---
gcc/fortran/trans-array.cc | 4 +-
.../gfortran.dg/string_array_constructor_4.f90 | 59 ++
2 files changed, 62 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index d4b16772de21..16041b629c21 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -2137,7 +2137,9 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock,
p = gfc_constructor_next (p);
n++;
}
- if (n < 4)
+ /* Constructor with few constant elements, or element size not
+known at compile time (e.g. deferred-length character). */
+ if (n < 4 || !INTEGER_CST_P (TYPE_SIZE_UNIT (type)))
{
/* Scalar values. */
gfc_init_se (, NULL);
diff --git a/gcc/testsuite/gfortran.dg/string_array_constructor_4.f90
b/gcc/testsuite/gfortran.dg/string_array_constructor_4.f90
new file mode 100644
index ..b5b81f07395a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_array_constructor_4.f90
@@ -0,0 +1,59 @@
+! { dg-do run }
+! PR fortran/103115 - character array constructor with >= 4 constant elements
+!
+! This used to ICE when the first element is deferred-length character
+! or could lead to wrong results.
+
+program pr103115
+ implicit none
+ integer :: i
+ character(*), parameter :: expect(*) = [ "1","2","3","4","5" ]
+ character(5):: abc = "12345"
+ character(5), parameter :: def = "12345"
+ character(:), dimension(:), allocatable :: list
+ character(:), dimension(:), allocatable :: titles
+ titles = ["1"]
+ titles = [ titles&
+,"2"&
+,"3"&
+,"4"&
+,"5"& ! used to ICE
+]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 1
+ if (any (titles /= expect)) stop 2
+ titles = ["1"]
+ titles = [ titles, (char(48+i),i=2,5) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 3
+ if (any (titles /= expect)) stop 4
+ titles = ["1"]
+ titles = [ titles, ("2345"(i:i),i=1,4) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 5
+ if (any (titles /= expect)) stop 6
+ titles = ["1"]
+ titles = [ titles, (def(i:i),i=2,5) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 7
+ if (any (titles /= expect)) stop 8
+ list = [ (char(48+i),i=1,5) ]
+ titles = [ list(1), (char(48+i),i=2,5) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 9
+ if (any (titles /= expect)) stop 10
+ titles = ["1"]
+ titles = [ titles, (abc(i:i),i=2,5) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 11
+ if (any (titles /= expect)) stop 12
+
+ ! with typespec:
+ list = [ (char(48+i),i=1,5) ]
+ titles = [ character(2) :: list(1), (char(48+i),i=2,5) ]
+ if (len (titles) /= 2 .or. size (titles) /= 5) stop 13
+ if (any (titles /= expect)) stop 14
+ titles = ["1"]
+ titles = [ character(2) :: titles, (char(48+i),i=2,5) ]
+ if (len (titles) /= 2 .or. size (titles) /= 5) stop 15
+ if (any (titles /= expect)) stop 16
+ titles = ["1"]
+ titles = [ character(2) :: titles, (def(i:i),i=2,5) ]
+ if (len (titles) /= 2 .or. size (titles) /= 5) stop 17
+ if (any (titles /= expect)) stop 18
+ deallocate (titles, list)
+end
[gcc r15-2156] Fortran: character array constructor with >= 4 constant elements [PR103115]
https://gcc.gnu.org/g:c93be1606ecf8e0f65b96b67aa023fb456ceb3a3
commit r15-2156-gc93be1606ecf8e0f65b96b67aa023fb456ceb3a3
Author: Harald Anlauf
Date: Thu Jul 18 21:15:48 2024 +0200
Fortran: character array constructor with >= 4 constant elements [PR103115]
gcc/fortran/ChangeLog:
PR fortran/103115
* trans-array.cc (gfc_trans_array_constructor_value): If the first
element of an array constructor is deferred-length character and
therefore does not have an element size known at compile time, do
not try to collect subsequent constant elements into a constructor
for optimization.
gcc/testsuite/ChangeLog:
PR fortran/103115
* gfortran.dg/string_array_constructor_4.f90: New test.
Diff:
---
gcc/fortran/trans-array.cc | 4 +-
.../gfortran.dg/string_array_constructor_4.f90 | 59 ++
2 files changed, 62 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index dc3de6c3b149..c93a5f1e7543 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -2147,7 +2147,9 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock,
p = gfc_constructor_next (p);
n++;
}
- if (n < 4)
+ /* Constructor with few constant elements, or element size not
+known at compile time (e.g. deferred-length character). */
+ if (n < 4 || !INTEGER_CST_P (TYPE_SIZE_UNIT (type)))
{
/* Scalar values. */
gfc_init_se (, NULL);
diff --git a/gcc/testsuite/gfortran.dg/string_array_constructor_4.f90
b/gcc/testsuite/gfortran.dg/string_array_constructor_4.f90
new file mode 100644
index ..b5b81f07395a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_array_constructor_4.f90
@@ -0,0 +1,59 @@
+! { dg-do run }
+! PR fortran/103115 - character array constructor with >= 4 constant elements
+!
+! This used to ICE when the first element is deferred-length character
+! or could lead to wrong results.
+
+program pr103115
+ implicit none
+ integer :: i
+ character(*), parameter :: expect(*) = [ "1","2","3","4","5" ]
+ character(5):: abc = "12345"
+ character(5), parameter :: def = "12345"
+ character(:), dimension(:), allocatable :: list
+ character(:), dimension(:), allocatable :: titles
+ titles = ["1"]
+ titles = [ titles&
+,"2"&
+,"3"&
+,"4"&
+,"5"& ! used to ICE
+]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 1
+ if (any (titles /= expect)) stop 2
+ titles = ["1"]
+ titles = [ titles, (char(48+i),i=2,5) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 3
+ if (any (titles /= expect)) stop 4
+ titles = ["1"]
+ titles = [ titles, ("2345"(i:i),i=1,4) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 5
+ if (any (titles /= expect)) stop 6
+ titles = ["1"]
+ titles = [ titles, (def(i:i),i=2,5) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 7
+ if (any (titles /= expect)) stop 8
+ list = [ (char(48+i),i=1,5) ]
+ titles = [ list(1), (char(48+i),i=2,5) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 9
+ if (any (titles /= expect)) stop 10
+ titles = ["1"]
+ titles = [ titles, (abc(i:i),i=2,5) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 11
+ if (any (titles /= expect)) stop 12
+
+ ! with typespec:
+ list = [ (char(48+i),i=1,5) ]
+ titles = [ character(2) :: list(1), (char(48+i),i=2,5) ]
+ if (len (titles) /= 2 .or. size (titles) /= 5) stop 13
+ if (any (titles /= expect)) stop 14
+ titles = ["1"]
+ titles = [ character(2) :: titles, (char(48+i),i=2,5) ]
+ if (len (titles) /= 2 .or. size (titles) /= 5) stop 15
+ if (any (titles /= expect)) stop 16
+ titles = ["1"]
+ titles = [ character(2) :: titles, (def(i:i),i=2,5) ]
+ if (len (titles) /= 2 .or. size (titles) /= 5) stop 17
+ if (any (titles /= expect)) stop 18
+ deallocate (titles, list)
+end
[PATCH] Fortran: character array constructor with >= 4 constant elements [PR103115]
Dear all,
here's a quite obvious fix for an ICE when processing an array constructor
where the first element is of deferred length, and at least four constant
elements followed, or an iterator with at least four elements. There
is a code path that then tries to combine these constant elements and
take the element size of the first (variable length) element in the
constructor.
(For gcc with checking=release, no ICE occured; wrong code was generated
instead.)
Obvious fix: if we see that the element size is not constant, falls back
to the case handling the constructor element-wise.
Regtested on x86_64-pc-linux-gnu. OK for mainline / backports?
Thanks,
Harald
From 5b264e77b54e211c7781d2c2e5dc324846a774a1 Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Thu, 18 Jul 2024 21:15:48 +0200
Subject: [PATCH] Fortran: character array constructor with >= 4 constant
elements [PR103115]
gcc/fortran/ChangeLog:
PR fortran/103115
* trans-array.cc (gfc_trans_array_constructor_value): If the first
element of an array constructor is deferred-length character and
therefore does not have an element size known at compile time, do
not try to collect subsequent constant elements into a constructor
for optimization.
gcc/testsuite/ChangeLog:
PR fortran/103115
* gfortran.dg/string_array_constructor_4.f90: New test.
---
gcc/fortran/trans-array.cc| 4 +-
.../string_array_constructor_4.f90| 59 +++
2 files changed, 62 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/string_array_constructor_4.f90
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index dc3de6c3b14..c93a5f1e754 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -2147,7 +2147,9 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock,
p = gfc_constructor_next (p);
n++;
}
- if (n < 4)
+ /* Constructor with few constant elements, or element size not
+ known at compile time (e.g. deferred-length character). */
+ if (n < 4 || !INTEGER_CST_P (TYPE_SIZE_UNIT (type)))
{
/* Scalar values. */
gfc_init_se (, NULL);
diff --git a/gcc/testsuite/gfortran.dg/string_array_constructor_4.f90 b/gcc/testsuite/gfortran.dg/string_array_constructor_4.f90
new file mode 100644
index 000..b5b81f07395
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_array_constructor_4.f90
@@ -0,0 +1,59 @@
+! { dg-do run }
+! PR fortran/103115 - character array constructor with >= 4 constant elements
+!
+! This used to ICE when the first element is deferred-length character
+! or could lead to wrong results.
+
+program pr103115
+ implicit none
+ integer :: i
+ character(*), parameter :: expect(*) = [ "1","2","3","4","5" ]
+ character(5):: abc = "12345"
+ character(5), parameter :: def = "12345"
+ character(:), dimension(:), allocatable :: list
+ character(:), dimension(:), allocatable :: titles
+ titles = ["1"]
+ titles = [ titles&
+,"2"&
+,"3"&
+,"4"&
+,"5"& ! used to ICE
+]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 1
+ if (any (titles /= expect)) stop 2
+ titles = ["1"]
+ titles = [ titles, (char(48+i),i=2,5) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 3
+ if (any (titles /= expect)) stop 4
+ titles = ["1"]
+ titles = [ titles, ("2345"(i:i),i=1,4) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 5
+ if (any (titles /= expect)) stop 6
+ titles = ["1"]
+ titles = [ titles, (def(i:i),i=2,5) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 7
+ if (any (titles /= expect)) stop 8
+ list = [ (char(48+i),i=1,5) ]
+ titles = [ list(1), (char(48+i),i=2,5) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 9
+ if (any (titles /= expect)) stop 10
+ titles = ["1"]
+ titles = [ titles, (abc(i:i),i=2,5) ]
+ if (len (titles) /= 1 .or. size (titles) /= 5) stop 11
+ if (any (titles /= expect)) stop 12
+
+ ! with typespec:
+ list = [ (char(48+i),i=1,5) ]
+ titles = [ character(2) :: list(1), (char(48+i),i=2,5) ]
+ if (len (titles) /= 2 .or. size (titles) /= 5) stop 13
+ if (any (titles /= expect)) stop 14
+ titles = ["1"]
+ titles = [ character(2) :: titles, (char(48+i),i=2,5) ]
+ if (len (titles) /= 2 .or. size (titles) /= 5) stop 15
+ if (any (titles /= expect)) stop 16
+ titles = ["1"]
+ titles = [ character(2) :: titles, (def(i:i),i=2,5) ]
+ if (len (titles) /= 2 .or. size (titles) /= 5) stop 17
+ if (any (titles /= expect)) stop 18
+ deallocate (titles, list)
+end
--
2.35.3
Re: [Patch, fortran] PR84868 - [11/12/13/14/15 Regression] ICE in gfc_conv_descriptor_offset, at fortran/trans-array.c:208
Hi Paul, Am 16.07.24 um 18:35 schrieb Paul Richard Thomas: In answer to some of your latest points: Can we prevent the export of this artificial symbol? The export of this symbol is needed for interface mapping. Without it, the original bug would reappear. If such len_trim calls are made outside of specification expressions, the symbols are not exported as you verify with either the parse tree dump or direct inspection of the module files from the testcases. I was under the impression that an interface that is not visible at the top level of the module does not need to be exported. And a contained procedure would satisfy that, or doesn't it? The ICE I saw is actually a pre-existing issue reported by Gerhard: https://gcc.gnu.org/bugzilla/show_bug.cgi?id=100273 Cheers, Harald
Re: [Patch, fortran] PR84868 - [11/12/13/14/15 Regression] ICE in gfc_conv_descriptor_offset, at fortran/trans-array.c:208
Am 15.07.24 um 20:27 schrieb Harald Anlauf:
Replying to myself:
Am 15.07.24 um 19:35 schrieb Harald Anlauf:
For '_len_trim_c_k':
Breakpoint 1, gfc_create_module_variable (sym=0x32af2f0)
at ../../gcc-trunk/gcc/fortran/trans-decl.cc:5515
5515 gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE
(gdb) p sym->ns->proc_name->attr.flavor
$9 = FL_PROCEDURE
(gdb) p sym->ns->parent->proc_name->attr.flavor
$10 = FL_PROCEDURE
This is not good.
Can we prevent the export of this artificial symbol?
Like this here (to give an idea, but otherwise untested):
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 54ab60b4935..cc6ac7f192e 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -5455,6 +5468,13 @@ gfc_create_module_variable (gfc_symbol * sym)
&& !(sym->attr.flavor == FL_PROCEDURE && sym->attr.proc_pointer))
return;
+ /* Do not output artificially created parameters. */
+ if (sym->attr.flavor == FL_PARAMETER
+ && sym->name[0] == '_'
+ && sym->ns->proc_name->attr.flavor == FL_PROCEDURE
+ && sym->ns->parent->proc_name->attr.flavor == FL_PROCEDURE)
+ return;
+
if ((sym->attr.in_common || sym->attr.in_equivalence) &&
sym->backend_decl)
{
decl = sym->backend_decl;
Maybe one might mark the symbol already at creation time and
detect this mark here, too.
JFTR: this regtests cleanly here.
While looking over the last version of the patch again,
the following should be corrected:
@@ -4637,6 +4637,75 @@ gfc_simplify_len_trim (gfc_expr *e, gfc_expr *kind)
if (k == -1)
return _bad_expr;
+ if (e->expr_type == EXPR_VARIABLE
+ && e->ts.type == BT_CHARACTER
+ && e->symtree->n.sym->attr.flavor == FL_PARAMETER
+ && e->ref && e->ref->type == REF_ARRAY
+ && e->ref->u.ar.dimen_type[0] == DIMEN_ELEMENT
+ && e->symtree->n.sym->value)
+{
+ char name[2*GFC_MAX_SYMBOL_LEN + 10];
^^ this has to be 12 now
+ gfc_namespace *ns = e->symtree->n.sym->ns;
+ gfc_symtree *st;
+ gfc_expr *expr;
+ gfc_expr *p;
+ gfc_constructor *c;
+ int cnt = 0;
+
+ sprintf (name, "_len_trim_%s_%s", e->symtree->n.sym->name,
ns->proc_name->name);
Cheers,
Harald
[gcc r14-10423] Fortran: improve attribute conflict checking [PR93635]
https://gcc.gnu.org/g:71ec9ed7a7353f66d55b034a45336bf43a026b1d
commit r14-10423-g71ec9ed7a7353f66d55b034a45336bf43a026b1d
Author: Harald Anlauf
Date: Thu May 23 21:13:00 2024 +0200
Fortran: improve attribute conflict checking [PR93635]
gcc/fortran/ChangeLog:
PR fortran/93635
* symbol.cc (conflict_std): Helper function for reporting attribute
conflicts depending on the Fortran standard version.
(conf_std): Helper macro for checking standard-dependent conflicts.
(gfc_check_conflict): Use it.
gcc/testsuite/ChangeLog:
PR fortran/93635
* gfortran.dg/c-interop/c1255-2.f90: Adjust pattern.
* gfortran.dg/pr87907.f90: Likewise.
* gfortran.dg/pr93635.f90: New test.
Co-authored-by: Steven G. Kargl
(cherry picked from commit 9561cf550a66a89e7c8d31202a03c4fddf82a3f2)
Diff:
---
gcc/fortran/symbol.cc | 63 +++--
gcc/testsuite/gfortran.dg/c-interop/c1255-2.f90 | 4 +-
gcc/testsuite/gfortran.dg/pr87907.f90 | 8 ++--
gcc/testsuite/gfortran.dg/pr93635.f90 | 19
4 files changed, 54 insertions(+), 40 deletions(-)
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 0a1646def678..5db3c887127b 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -407,18 +407,36 @@ gfc_check_function_type (gfc_namespace *ns)
/ Symbol attribute stuff */
+/* Older standards produced conflicts for some attributes that are allowed
+ in newer standards. Check for the conflict and issue an error depending
+ on the standard in play. */
+
+static bool
+conflict_std (int standard, const char *a1, const char *a2, const char *name,
+ locus *where)
+{
+ if (name == NULL)
+{
+ return gfc_notify_std (standard, "%s attribute conflicts "
+"with %s attribute at %L", a1, a2,
+where);
+}
+ else
+{
+ return gfc_notify_std (standard, "%s attribute conflicts "
+"with %s attribute in %qs at %L",
+a1, a2, name, where);
+}
+}
+
/* This is a generic conflict-checker. We do this to avoid having a
single conflict in two places. */
#define conf(a, b) if (attr->a && attr->b) { a1 = a; a2 = b; goto conflict; }
#define conf2(a) if (attr->a) { a2 = a; goto conflict; }
-#define conf_std(a, b, std) if (attr->a && attr->b)\
- {\
-a1 = a;\
-a2 = b;\
-standard = std;\
-goto conflict_std;\
- }
+#define conf_std(a, b, std) if (attr->a && attr->b \
+ && !conflict_std (std, a, b, name, where)) \
+ return false;
bool
gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
@@ -451,7 +469,6 @@ gfc_check_conflict (symbol_attribute *attr, const char
*name, locus *where)
"OACC DECLARE DEVICE_RESIDENT";
const char *a1, *a2;
- int standard;
if (attr->artificial)
return true;
@@ -460,20 +477,10 @@ gfc_check_conflict (symbol_attribute *attr, const char
*name, locus *where)
where = _current_locus;
if (attr->pointer && attr->intent != INTENT_UNKNOWN)
-{
- a1 = pointer;
- a2 = intent;
- standard = GFC_STD_F2003;
- goto conflict_std;
-}
+conf_std (pointer, intent, GFC_STD_F2003);
- if (attr->in_namelist && (attr->allocatable || attr->pointer))
-{
- a1 = in_namelist;
- a2 = attr->allocatable ? allocatable : pointer;
- standard = GFC_STD_F2003;
- goto conflict_std;
-}
+ conf_std (in_namelist, allocatable, GFC_STD_F2003);
+ conf_std (in_namelist, pointer, GFC_STD_F2003);
/* Check for attributes not allowed in a BLOCK DATA. */
if (gfc_current_state () == COMP_BLOCK_DATA)
@@ -922,20 +929,6 @@ conflict:
a1, a2, name, where);
return false;
-
-conflict_std:
- if (name == NULL)
-{
- return gfc_notify_std (standard, "%s attribute conflicts "
- "with %s attribute at %L", a1, a2,
- where);
-}
- else
-{
- return gfc_notify_std (standard, "%s attribute conflicts "
-"with %s attribute in %qs at %L",
- a1, a2, name, where);
-}
}
#undef conf
diff --git a/gcc/testsuite/gfortran.dg/c-interop/c1255-2.f90
b/gcc/testsuite/gfortran.dg/c-interop/c1255-2.f90
index 0e5505a01835..feed2e7645fd 100644
Re: Lower zeroing array assignment to memset for allocatable arrays
Hi Prathamesh! Am 15.07.24 um 15:07 schrieb Prathamesh Kulkarni: -Original Message- From: Harald Anlauf I agree that it is reasonable to defer the handling of arrays as components of derived types, and recommend to do the following: - replace "&& gfc_is_simply_contiguous (expr, true, false))" in your last patch by "&& gfc_is_simply_contiguous (expr, false, false))", as that would also allow to treat z(:,::1,:) = 0 as contiguous if z is allocatable or a contiguous pointer. - open a PR in bugzilla to track the missed-optimization for the cases we discussed here, and link the discussion in the ML. Done: https://gcc.gnu.org/bugzilla/show_bug.cgi?id=115935 Your patch then will be OK for mainline. Thanks, does the attached version look OK ? Bootstrapped+tested on aarch64-linux-gnu, x86_64-linux-gnu. This is now OK. Thanks for the patch! Harald Thanks, Prathamesh
Re: [Patch, fortran] PR84868 - [11/12/13/14/15 Regression] ICE in gfc_conv_descriptor_offset, at fortran/trans-array.c:208
Replying to myself:
Am 15.07.24 um 19:35 schrieb Harald Anlauf:
For '_len_trim_c_k':
Breakpoint 1, gfc_create_module_variable (sym=0x32af2f0)
at ../../gcc-trunk/gcc/fortran/trans-decl.cc:5515
5515 gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE
(gdb) p sym->ns->proc_name->attr.flavor
$9 = FL_PROCEDURE
(gdb) p sym->ns->parent->proc_name->attr.flavor
$10 = FL_PROCEDURE
This is not good.
Can we prevent the export of this artificial symbol?
Like this here (to give an idea, but otherwise untested):
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 54ab60b4935..cc6ac7f192e 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -5455,6 +5468,13 @@ gfc_create_module_variable (gfc_symbol * sym)
&& !(sym->attr.flavor == FL_PROCEDURE && sym->attr.proc_pointer))
return;
+ /* Do not output artificially created parameters. */
+ if (sym->attr.flavor == FL_PARAMETER
+ && sym->name[0] == '_'
+ && sym->ns->proc_name->attr.flavor == FL_PROCEDURE
+ && sym->ns->parent->proc_name->attr.flavor == FL_PROCEDURE)
+return;
+
if ((sym->attr.in_common || sym->attr.in_equivalence) &&
sym->backend_decl)
{
decl = sym->backend_decl;
Maybe one might mark the symbol already at creation time and
detect this mark here, too.
Harald
Re: [Patch, fortran] PR84868 - [11/12/13/14/15 Regression] ICE in gfc_conv_descriptor_offset, at fortran/trans-array.c:208
Hi Paul, Andre, at the risk of getting stoned to death, here's an example: module m implicit none integer :: c contains function f(n) result(z) integer, intent(in) :: n character, parameter :: c(3) = ['x', 'y', 'z'] character(len_trim(c(n))) :: z z = c(n) end function h(n) result(z) integer, intent(in) :: n character, parameter :: c(3,3) = 'x' character(len_trim(c(n,n))) :: z z = c(n,n) contains function k(n) result(z) integer, intent(in) :: n character, parameter :: c(3) = ['*', '+', '-'] character(len_trim(c(n))) :: z z = c(n) end end end program p use m implicit none print *, f(2) print *, h(1) end % gfc-15 pr84868-z0.f90 -fdump-fortran-original Namespace: A-Z: (UNKNOWN 0) procedure name = m symtree: '@0' || symbol: '_len_trim_c_h' from namespace 'h' symtree: '@1' || symbol: '_len_trim_c_k' from namespace 'k' symtree: '@2' || symbol: '_len_trim_c_f' from namespace 'f' symtree: 'c' || symbol: 'c' [...] f951: internal compiler error: in gfc_create_module_variable, at fortran/trans-decl.cc:5515 0x2438776 internal_error(char const*, ...) ../../gcc-trunk/gcc/diagnostic-global-context.cc:491 0x96df24 fancy_abort(char const*, int, char const*) ../../gcc-trunk/gcc/diagnostic.cc:1725 0x752d8a gfc_create_module_variable ../../gcc-trunk/gcc/fortran/trans-decl.cc:5515 0x752d8a gfc_create_module_variable ../../gcc-trunk/gcc/fortran/trans-decl.cc:5428 [...] So you are very close! My example is likely very artificial, but nevertheless legal. We hit the following assert: gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE || (sym->ns->parent->proc_name->attr.flavor == FL_MODULE && sym->fn_result_spec)); For '_len_trim_c_k': Breakpoint 1, gfc_create_module_variable (sym=0x32af2f0) at ../../gcc-trunk/gcc/fortran/trans-decl.cc:5515 5515 gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE (gdb) p sym->ns->proc_name->attr.flavor $9 = FL_PROCEDURE (gdb) p sym->ns->parent->proc_name->attr.flavor $10 = FL_PROCEDURE This is not good. Can we prevent the export of this artificial symbol? Otherwise the patch is fine. Thanks, Harald Am 15.07.24 um 12:23 schrieb Andre Vehreschild: Hi Paul, I tried to "break" your patch, but I failed. (I tried having same function in both modules with identical signature; but I do not get a symbol collision). So to me the patch looks fine now. But you may want to give Harald some time for a look. Thanks for the patch, Andre On Mon, 15 Jul 2024 10:41:45 +0100 Paul Richard Thomas wrote: I've done it again! Patch duly added. Paul On Mon, 15 Jul 2024 at 09:21, Paul Richard Thomas < paul.richard.tho...@gmail.com> wrote: Hi Harald, Thank you for the review and for the testing to destruction. Both issues are fixed in the attached patch. Note the new function 'h', which both tests that the namespace confusion is fixed and that the elemental-ness of LEN_TRIM is respected. The patch continues to regtest OK. If I don't receive anymore comments/corrections, I will commit tomorrow morning. Regards Paul On Sun, 14 Jul 2024 at 19:50, Harald Anlauf wrote: Hi Paul, at first sight the patch seems to be the right approach, but it breaks for the following two variations: (1) LEN_TRIM is elemental, but the following is erroneously rejected: function g(n) result(z) integer, intent(in) :: n character, parameter :: d(3,3) = 'x' character(len_trim(d(n,n))) :: z z = d(n,n) end This is fixed here by commenting/removing the line expr->rank = 1; as the result shall have the same shape as the argument. Can you check? (2) The handling of namespaces is problematic: using the same name for a parameter within procedures in the same scope generates another ICE. The following testcase demonstrates this: module m implicit none integer :: c contains function f(n) result(z) integer, intent(in) :: n character, parameter :: c(3) = ['x', 'y', 'z'] character(len_trim(c(n))) :: z z = c(n) end function h(n) result(z) integer, intent(in) :: n character, parameter :: c(3,3) = 'x' character(len_trim(c(n,n))) :: z z = c(n,n) end end program p use m implicit none print *, f(2) print *, h(1) end I get: pr84868-z0.f90:22:15: 22 | print *, h(1) | 1 internal compiler error: in gfc_conv_descriptor_stride_get, at fortran/trans-array.cc:483 0x243e156 internal_error(char const*, ...) ../../gcc-trunk/gcc/diagnostic-global-context.cc:491 0x96dd70 fancy_abort(char const*, int, char const*) ../../gcc-trunk/gcc/diagnostic.cc:1725 0x749d68 gfc_conv_descriptor_stride_get(tree_node*, tree_node*) ../../gcc-trunk/gcc/fortran
Re: [Patch, fortran] PR84868 - [11/12/13/14/15 Regression] ICE in gfc_conv_descriptor_offset, at fortran/trans-array.c:208
Hi Paul, at first sight the patch seems to be the right approach, but it breaks for the following two variations: (1) LEN_TRIM is elemental, but the following is erroneously rejected: function g(n) result(z) integer, intent(in) :: n character, parameter :: d(3,3) = 'x' character(len_trim(d(n,n))) :: z z = d(n,n) end This is fixed here by commenting/removing the line expr->rank = 1; as the result shall have the same shape as the argument. Can you check? (2) The handling of namespaces is problematic: using the same name for a parameter within procedures in the same scope generates another ICE. The following testcase demonstrates this: module m implicit none integer :: c contains function f(n) result(z) integer, intent(in) :: n character, parameter :: c(3) = ['x', 'y', 'z'] character(len_trim(c(n))) :: z z = c(n) end function h(n) result(z) integer, intent(in) :: n character, parameter :: c(3,3) = 'x' character(len_trim(c(n,n))) :: z z = c(n,n) end end program p use m implicit none print *, f(2) print *, h(1) end I get: pr84868-z0.f90:22:15: 22 | print *, h(1) | 1 internal compiler error: in gfc_conv_descriptor_stride_get, at fortran/trans-array.cc:483 0x243e156 internal_error(char const*, ...) ../../gcc-trunk/gcc/diagnostic-global-context.cc:491 0x96dd70 fancy_abort(char const*, int, char const*) ../../gcc-trunk/gcc/diagnostic.cc:1725 0x749d68 gfc_conv_descriptor_stride_get(tree_node*, tree_node*) ../../gcc-trunk/gcc/fortran/trans-array.cc:483 [rest of traceback elided] Renaming the parameter array in h solves the problem. Am 13.07.24 um 17:57 schrieb Paul Richard Thomas: Hi All, Harald has pointed out that I attached the ChangeLog twice and the patch not at all :-( Please find the patch duly attached. Paul On Sat, 13 Jul 2024 at 10:58, Paul Richard Thomas < paul.richard.tho...@gmail.com> wrote: Hi All, After messing around with argument mapping, where I found and fixed another bug, I realised that the problem lay with simplification of len_trim with an argument that is the element of a parameter array. The fix was then a straightforward lift of existing code in expr.cc. The mapping bug is also fixed by supplying the se string length when building character typespecs. Regtests just fine. OK for mainline? I believe that this is safe for backporting to 14-branch before the 14.2 release - thoughts? If you manage to correct/fix the above issues, I am fine with backporting, as this appears a very reasonable fix. Thanks, Harald Regards Paul
Re: Lower zeroing array assignment to memset for allocatable arrays
Hi Prathamesh, Am 12.07.24 um 15:31 schrieb Prathamesh Kulkarni: It seems that component references are not currently handled even for static size arrays ? For eg: subroutine test_dt (dt, y) implicit none real :: y (10, 20, 30) type t real :: x(10, 20, 30) end type t type(t) :: dt y = 0 dt% x = 0 end subroutine With trunk, it generates memset for 'y' but not for dt%x. That happens because copyable_array_p returns false for dt%x, because expr->ref->next is non NULL: /* First check it's an array. */ if (expr->rank < 1 || !expr->ref || expr->ref->next) return false; and gfc_full_array_ref_p(expr) bails out if expr->ref->type != REF_ARRAY. Indeed that check (as is) prevents the use of component refs. (I just tried to modify the this part to cycle thru the refs, but then I get regressions in the testsuite for some of the coarray tests. Furthermore, gfc_trans_zero_assign would need further changes to handle even the constant shapes from above.) Looking thru git history, it seems both the checks were added in 18eaa2c0cd20 to fix PR33370. (Even after removing these checks, the previous patch bails out from gfc_trans_zero_assign because GFC_DESCRIPTOR_TYPE_P (type) returns false for component ref and ends up returning NULL_TREE) I am working on extending the patch to handle component refs for statically sized as well as allocatable arrays. Since it looks like a bigger change and an extension to current functionality, will it be OK to commit the previous patch as-is (if it looks correct) and address component refs in follow up one ? I agree that it is reasonable to defer the handling of arrays as components of derived types, and recommend to do the following: - replace "&& gfc_is_simply_contiguous (expr, true, false))" in your last patch by "&& gfc_is_simply_contiguous (expr, false, false))", as that would also allow to treat z(:,::1,:) = 0 as contiguous if z is allocatable or a contiguous pointer. - open a PR in bugzilla to track the missed-optimization for the cases we discussed here, and link the discussion in the ML. Your patch then will be OK for mainline. Thanks, Harald Thanks, Prathamesh Thanks, Harald Bootstrapped+tested on aarch64-linux-gnu. Does the attached patch look OK ? Signed-off-by: Prathamesh Kulkarni Thanks, Prathamesh Thanks, Harald Signed-off-by: Prathamesh Kulkarni Thanks, Prathamesh
Re: [PATCH] fortran: Factor the evaluation of MINLOCK/MAXLOC's BACK argument
Hi Mikael,
Am 11.07.24 um 21:55 schrieb Mikael Morin:
From: Mikael Morin
Hello,
I discovered this while testing the inline MINLOC/MAXLOC (aka PR90608) patches.
Regression tested on x86_64-linux.
OK for master?
this is a nice finding! (NAG seems to fail on the cases with
array size 0, while Intel gets it right.)
The commit message promises to cover all variations ("with/out NANs"?)
but I fail to see these. Were these removed in the submission?
Otherwise the patch looks pretty simple and is OK for mainline.
But do not forget to s/MINLOCK/MINLOC/ in the summary.
Thanks for the patch!
Harald
-- 8< --
Move the evaluation of the BACK argument out of the loop in the inline code
generated for MINLOC or MAXLOC. For that, add a new (scalar) element
associated with BACK to the scalarization loop chain, evaluate the argument
with the context of that element, and let the scalarizer do its job.
The problem was not only a missed optimisation, but also a wrong code
one in the cases where the expression associated with BACK is not free of
side-effects, making multiple evaluations observable.
The new tests check the evaluation count of the BACK argument, and try to
cover all the variations (with/out NANs, constant or unknown shape, absent
or scalar or array MASK) supported by the inline implementation of the
functions. Care has been taken to not check the case of a constant .FALSE.
MASK, for which the evaluation of BACK can be elided.
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Create a new
scalar scalarization chain element if BACK is present. Add it to
the loop. Set the scalarization chain before evaluating the
argument.
gcc/testsuite/ChangeLog:
* gfortran.dg/maxloc_5.f90: New test.
* gfortran.dg/minloc_5.f90: New test.
---
gcc/fortran/trans-intrinsic.cc | 10 +
gcc/testsuite/gfortran.dg/maxloc_5.f90 | 257 +
gcc/testsuite/gfortran.dg/minloc_5.f90 | 257 +
3 files changed, 524 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/maxloc_5.f90
create mode 100644 gcc/testsuite/gfortran.dg/minloc_5.f90
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 5ea10e84060..cadbd177452 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5325,6 +5325,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
gfc_actual_arglist *actual;
gfc_ss *arrayss;
gfc_ss *maskss;
+ gfc_ss *backss;
gfc_se arrayse;
gfc_se maskse;
gfc_expr *arrayexpr;
@@ -5390,6 +5391,11 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
&& maskexpr->symtree->n.sym->attr.dummy
&& maskexpr->symtree->n.sym->attr.optional;
backexpr = actual->next->next->expr;
+ if (backexpr)
+backss = gfc_get_scalar_ss (gfc_ss_terminator, backexpr);
+ else
+backss = nullptr;
+
nonempty = NULL;
if (maskexpr && maskexpr->rank != 0)
{
@@ -5449,6 +5455,9 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
if (maskss)
gfc_add_ss_to_loop (, maskss);
+ if (backss)
+gfc_add_ss_to_loop (, backss);
+
gfc_add_ss_to_loop (, arrayss);
/* Initialize the loop. */
@@ -5535,6 +5544,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
gfc_add_block_to_block (, );
gfc_init_se (, NULL);
+ backse.ss = backss;
gfc_conv_expr_val (, backexpr);
gfc_add_block_to_block (, );
diff --git a/gcc/testsuite/gfortran.dg/maxloc_5.f90
b/gcc/testsuite/gfortran.dg/maxloc_5.f90
new file mode 100644
index 000..5d722450c8f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxloc_5.f90
@@ -0,0 +1,257 @@
+! { dg-do run }
+!
+! Check that the evaluation of MAXLOC's BACK argument is made only once
+! before the scalarisation loops.
+
+program p
+ implicit none
+ integer, parameter :: data10(*) = (/ 7, 4, 7, 6, 6, 4, 6, 3, 9, 8 /)
+ logical, parameter :: mask10(*) = (/ .false., .true., .false., &
+ .false., .true., .true., &
+ .true. , .true., .false., &
+ .false. /)
+ integer :: calls_count = 0
+ call check_int_const_shape
+ call check_int_const_shape_scalar_mask
+ call check_int_const_shape_array_mask
+ call check_int_const_shape_optional_mask_present
+ call check_int_const_shape_optional_mask_absent
+ call check_int_const_shape_empty
+ call check_int_alloc
+ call check_int_alloc_scalar_mask
+ call check_int_alloc_array_mask
+ call check_int_alloc_empty
+ call check_real_const_shape
+ call check_real_const_shape_scalar_mask
+ call check_real_const_shape_array_mask
+ call check_real_const_shape_optional_mask_present
+ call check_real_const_shape_optional_mask_absent
+ call check_real_const_shape_empty
+ call check_real_alloc
Re: Lower zeroing array assignment to memset for allocatable arrays
Hi Prathamesh! Am 11.07.24 um 12:16 schrieb Prathamesh Kulkarni: -Original Message- From: Harald Anlauf Sent: Thursday, July 11, 2024 12:53 AM To: Prathamesh Kulkarni ; gcc- patc...@gcc.gnu.org; fort...@gcc.gnu.org Subject: Re: Lower zeroing array assignment to memset for allocatable arrays External email: Use caution opening links or attachments Hi Prathamesh, Am 10.07.24 um 13:22 schrieb Prathamesh Kulkarni: Hi, The attached patch lowers zeroing array assignment to memset for allocatable arrays. For example: subroutine test(z, n) implicit none integer :: n real(4), allocatable :: z(:,:,:) allocate(z(n, 8192, 2048)) z = 0 end subroutine results in following call to memset instead of 3 nested loops for z = 0: (void) __builtin_memset ((void *) z->data, 0, (unsigned long) MAX_EXPR dim[0].ubound - z->dim[0].lbound, -1> + 1) * (MAX_EXPR dim[1].ubound - z->dim[1].lbound, -1> + 1)) * (MAX_EXPR dim[2].ubound - z->dim[2].lbound, -1> + 1)) * 4)); The patch significantly improves speedup for an internal Fortran application on AArch64 -mcpu=grace (and potentially on other AArch64 cores too). Bootstrapped+tested on aarch64-linux-gnu. Does the patch look OK to commit ? no, it is NOT ok. Consider: subroutine test0 (n, z) implicit none integer :: n real, pointer :: z(:,:,:) ! need not be contiguous! z = 0 end subroutine After your patch this also generates a memset, but this cannot be true in general. One would need to have a test on contiguity of the array before memset can be used. In principle this is a nice idea, and IIRC there exists a very old PR on this (by Thomas König?). So it might be worth pursuing. Hi Harald, Thanks for the suggestions! The attached patch checks gfc_is_simply_contiguous(expr, true, false) before lowering to memset, which avoids generating memset for your example above. This is much better, as it avoids generating false memsets where it should not. However, you now miss cases where the array is a component reference, as in: subroutine test_dt (dt) implicit none type t real, allocatable :: x(:,:,:) ! contiguous! real, pointer, contiguous :: y(:,:,:) ! contiguous! real, pointer :: z(:,:,:) ! need not be contiguous! end type t type(t) :: dt dt% x = 0 ! memset possible! dt% y = 0 ! memset possible! dt% z = 0 ! memset NOT possible! end subroutine You'll need to cycle through the component references and apply the check for contiguity to the ultimate component, not the top level. Can you have another look? Thanks, Harald Bootstrapped+tested on aarch64-linux-gnu. Does the attached patch look OK ? Signed-off-by: Prathamesh Kulkarni Thanks, Prathamesh Thanks, Harald Signed-off-by: Prathamesh Kulkarni Thanks, Prathamesh
Re: Lower zeroing array assignment to memset for allocatable arrays
Hi Prathamesh, Am 10.07.24 um 13:22 schrieb Prathamesh Kulkarni: Hi, The attached patch lowers zeroing array assignment to memset for allocatable arrays. For example: subroutine test(z, n) implicit none integer :: n real(4), allocatable :: z(:,:,:) allocate(z(n, 8192, 2048)) z = 0 end subroutine results in following call to memset instead of 3 nested loops for z = 0: (void) __builtin_memset ((void *) z->data, 0, (unsigned long) MAX_EXPR dim[0].ubound - z->dim[0].lbound, -1> + 1) * (MAX_EXPR dim[1].ubound - z->dim[1].lbound, -1> + 1)) * (MAX_EXPR dim[2].ubound - z->dim[2].lbound, -1> + 1)) * 4)); The patch significantly improves speedup for an internal Fortran application on AArch64 -mcpu=grace (and potentially on other AArch64 cores too). Bootstrapped+tested on aarch64-linux-gnu. Does the patch look OK to commit ? no, it is NOT ok. Consider: subroutine test0 (n, z) implicit none integer :: n real, pointer :: z(:,:,:) ! need not be contiguous! z = 0 end subroutine After your patch this also generates a memset, but this cannot be true in general. One would need to have a test on contiguity of the array before memset can be used. In principle this is a nice idea, and IIRC there exists a very old PR on this (by Thomas König?). So it might be worth pursuing. Thanks, Harald Signed-off-by: Prathamesh Kulkarni Thanks, Prathamesh
Re: [Fortran, Patch, PR 96992, V4] Fix Class arrays of different ranks are rejected as storage association argument
Hi Andre,
Am 10.07.24 um 10:45 schrieb Andre Vehreschild:
Hi Harald,
thanks for the review. I totally agree, that this patch has gotten bigger than
I expected (and wanted). But things are as they are.
About the coding style: I have worked in so many projects, that I consider a
consistent coding style luxury. I esp. do not have my own one anymore. The
formating you are seeing in my patches is the result of clang-format with the
provided parameter file in contrib/clang-format. I was happy to have a tool
to do the formatting, that I could integrate into my IDE, because previously it
was hard to mimic the GNU style. I try to get to the GNU style as good as
possible, where I consider clang-format doing garbage.
I see that clang-format has a "very specific opinion" on how to format the
lines you mentioned, but it will "correct" them any time I change them and
touch them later. I now have forbidden clang-format to touch the code lines,
but this means to add formatter specific comments. Is this ok?
yes, this is much better now! Thanks.
(I entirely rely on Emacs' formatting when working with C. Sometimes
the indentation at first may appear unexpected, but in most of these
cases I find that it helps to just use explicit parentheses to convince
Emacs. This is documented.)
About the assumed size arrays, that was a small change and is added now.
Great!
Note, the runtime part of the patch (pr96992_3p1.patch) did not change and is
therefore not updated.
Regtests ok on x86_64-pc-linux-gnu/Fedora 39. Ok for mainline?
Yes, this is OK now.
Thanks for the patch and your patience ;-)
Harald
Regards,
Andre
On Fri, 5 Jul 2024 22:10:16 +0200
Harald Anlauf wrote:
Hi Andre,
Am 03.07.24 um 12:58 schrieb Andre Vehreschild:
Hi Harald,
I am sorry for the long delay, but fixing the negative stride lead from one
issue to the next. I finally got a version that does not regress. Please
have a look.
This patch has two parts:
1. The runtime library part in pr96992_3p1.patch and
2. the compiler changes in pr96992_3p2.patch.
In my branch also the two patches from Paul for pr59104 and pr102689 are
living, which might lead to small shifts during application of the patches.
NOTE, this patch adds internal packing and unpacking of class arrays
similar to the regular pack and unpack. I think this is necessary, because
the regular un-/pack does not use the vptr's _copy routine for moving data
and therefore may produce bugs.
The un-/pack_class routines are yet only used for converting a derived type
array to a class array. Extending their use when a UN-/PACK() is applied on
a class array is still to be done (as part of another PR).
Regtests fine on x86_64-pc-linux-gnu/ Fedora 39.
this is a really huge patch to review, and I am not sure that I can do
this without help from others. Paul? Anybody else?
As far as I can tell for now:
- pr96992_3p1.patch (the libgfortran part) looks good to me.
- git had some whitespace issues with pr96992_3p2.patch as attached,
but I could fix that locally and do some testing parallel to reading.
A few advance comments on the latter patch:
- my understanding is that the PR at the end of a summary line should be
like in:
Fortran: Fix rejecting class arrays of different ranks as storage
association argument [PR96992]
I was told that this helps people explicitly scanning for the PR
number in that place.
- some rewrites of logical conditions change the coding style from
what it recommended GNU coding style, and I find the more compact
way used in some places harder to grok (but that may be just me).
Example:
@@ -8850,20 +8857,24 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr
* expr, bool g77,
/* There is no need to pack and unpack the array, if it is contiguous
and not a deferred- or assumed-shape array, or if it is simply
contiguous. */
- no_pack = ((sym && sym->as
- && !sym->attr.pointer
- && sym->as->type != AS_DEFERRED
- && sym->as->type != AS_ASSUMED_RANK
- && sym->as->type != AS_ASSUMED_SHAPE)
- ||
-(ref && ref->u.ar.as
- && ref->u.ar.as->type != AS_DEFERRED
+ no_pack = false;
+ gfc_array_spec *as;
+ if (sym)
+{
+ symbol_attribute *attr
+ = &(IS_CLASS_ARRAY (sym) ? CLASS_DATA (sym)->attr : sym->attr);
+ as = IS_CLASS_ARRAY (sym) ? CLASS_DATA (sym)->as : sym->as;
+ no_pack
+ = (as && !attr->pointer && as->type != AS_DEFERRED
+ && as->type != AS_ASSUMED_RANK && as->type != AS_ASSUMED_SHAPE);
+}
+ if (ref && ref->u.ar.as)
+no_pack = no_pack
+ || (ref->u.ar.as->type != AS_DEFERRED
&& ref->u.ar.as->type !
[gcc r14-10387] Fortran: fix associate with assumed-length character array [PR115700]
https://gcc.gnu.org/g:36ca07f0a95c00cc985fc06e46df4028e6f2b77e
commit r14-10387-g36ca07f0a95c00cc985fc06e46df4028e6f2b77e
Author: Harald Anlauf
Date: Tue Jul 2 21:26:05 2024 +0200
Fortran: fix associate with assumed-length character array [PR115700]
gcc/fortran/ChangeLog:
PR fortran/115700
* trans-stmt.cc (trans_associate_var): When the associate target
is an array-valued character variable, the length is known at entry
of the associate block. Move setting of string length of the
selector to the initialization part of the block.
gcc/testsuite/ChangeLog:
PR fortran/115700
* gfortran.dg/associate_69.f90: New test.
(cherry picked from commit 7b7f203472d07a05d959a29638c7c95d98bf0c1c)
Diff:
---
gcc/fortran/trans-stmt.cc | 18
gcc/testsuite/gfortran.dg/associate_69.f90 | 33 ++
2 files changed, 47 insertions(+), 4 deletions(-)
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 1fd75c6a37c..59237b8cdfb 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -1911,6 +1911,8 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block
*block)
gfc_se se;
tree desc;
bool cst_array_ctor;
+ stmtblock_t init;
+ gfc_init_block ();
desc = sym->backend_decl;
cst_array_ctor = e->expr_type == EXPR_ARRAY
@@ -1935,10 +1937,17 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block
*block)
&& !sym->attr.select_type_temporary
&& sym->ts.u.cl->backend_decl
&& VAR_P (sym->ts.u.cl->backend_decl)
+ && se.string_length
&& se.string_length != sym->ts.u.cl->backend_decl)
- gfc_add_modify (, sym->ts.u.cl->backend_decl,
- fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl),
- se.string_length));
+ {
+ /* When the target is a variable, its length is already known. */
+ tree len = fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl),
+ se.string_length);
+ if (e->expr_type == EXPR_VARIABLE)
+ gfc_add_modify (, sym->ts.u.cl->backend_decl, len);
+ else
+ gfc_add_modify (, sym->ts.u.cl->backend_decl, len);
+ }
/* If we didn't already do the pointer assignment, set associate-name
descriptor to the one generated for the temporary. */
@@ -1978,7 +1987,8 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block
*block)
}
/* Done, register stuff as init / cleanup code. */
- gfc_add_init_cleanup (block, gfc_finish_block (),
+ gfc_add_block_to_block (, );
+ gfc_add_init_cleanup (block, gfc_finish_block (),
gfc_finish_block ());
}
diff --git a/gcc/testsuite/gfortran.dg/associate_69.f90
b/gcc/testsuite/gfortran.dg/associate_69.f90
new file mode 100644
index 000..28f488bb274
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_69.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-Og -Wuninitialized -Wmaybe-uninitialized
-fdump-tree-optimized" }
+!
+! PR fortran/115700 - Bogus warning for associate with assumed-length
character array
+!
+subroutine mvce(x)
+ implicit none
+ character(len=*), dimension(:), intent(in) :: x
+
+ associate (tmp1 => x)
+if (len (tmp1) /= len (x)) stop 1
+ end associate
+
+ associate (tmp2 => x(1:))
+if (len (tmp2) /= len (x)) stop 2
+ end associate
+
+ associate (tmp3 => x(1:)(:))
+if (len (tmp3) /= len (x)) stop 3
+ end associate
+
+! The following associate blocks still produce bogus warnings:
+
+! associate (tmp4 => x(:)(1:))
+! if (len (tmp4) /= len (x)) stop 4
+! end associate
+!
+! associate (tmp5 => x(1:)(1:))
+! if (len (tmp5) /= len (x)) stop 5
+! end associate
+end
+
+! { dg-final { scan-tree-dump-not " \\.tmp" "optimized" } }
Re: [Fortran, Patch, PR 96992, V3] Fix Class arrays of different ranks are rejected as storage association argument
Hi Andre,
Am 03.07.24 um 12:58 schrieb Andre Vehreschild:
Hi Harald,
I am sorry for the long delay, but fixing the negative stride lead from one
issue to the next. I finally got a version that does not regress. Please have a
look.
This patch has two parts:
1. The runtime library part in pr96992_3p1.patch and
2. the compiler changes in pr96992_3p2.patch.
In my branch also the two patches from Paul for pr59104 and pr102689 are
living, which might lead to small shifts during application of the patches.
NOTE, this patch adds internal packing and unpacking of class arrays similar to
the regular pack and unpack. I think this is necessary, because the regular
un-/pack does not use the vptr's _copy routine for moving data and therefore
may produce bugs.
The un-/pack_class routines are yet only used for converting a derived type
array to a class array. Extending their use when a UN-/PACK() is applied on a
class array is still to be done (as part of another PR).
Regtests fine on x86_64-pc-linux-gnu/ Fedora 39.
this is a really huge patch to review, and I am not sure that I can do
this without help from others. Paul? Anybody else?
As far as I can tell for now:
- pr96992_3p1.patch (the libgfortran part) looks good to me.
- git had some whitespace issues with pr96992_3p2.patch as attached,
but I could fix that locally and do some testing parallel to reading.
A few advance comments on the latter patch:
- my understanding is that the PR at the end of a summary line should be
like in:
Fortran: Fix rejecting class arrays of different ranks as storage
association argument [PR96992]
I was told that this helps people explicitly scanning for the PR
number in that place.
- some rewrites of logical conditions change the coding style from
what it recommended GNU coding style, and I find the more compact
way used in some places harder to grok (but that may be just me).
Example:
@@ -8850,20 +8857,24 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr
* expr, bool g77,
/* There is no need to pack and unpack the array, if it is contiguous
and not a deferred- or assumed-shape array, or if it is simply
contiguous. */
- no_pack = ((sym && sym->as
- && !sym->attr.pointer
- && sym->as->type != AS_DEFERRED
- && sym->as->type != AS_ASSUMED_RANK
- && sym->as->type != AS_ASSUMED_SHAPE)
- ||
-(ref && ref->u.ar.as
- && ref->u.ar.as->type != AS_DEFERRED
+ no_pack = false;
+ gfc_array_spec *as;
+ if (sym)
+{
+ symbol_attribute *attr
+ = &(IS_CLASS_ARRAY (sym) ? CLASS_DATA (sym)->attr : sym->attr);
+ as = IS_CLASS_ARRAY (sym) ? CLASS_DATA (sym)->as : sym->as;
+ no_pack
+ = (as && !attr->pointer && as->type != AS_DEFERRED
+ && as->type != AS_ASSUMED_RANK && as->type != AS_ASSUMED_SHAPE);
+}
+ if (ref && ref->u.ar.as)
+no_pack = no_pack
+ || (ref->u.ar.as->type != AS_DEFERRED
&& ref->u.ar.as->type != AS_ASSUMED_RANK
- && ref->u.ar.as->type != AS_ASSUMED_SHAPE)
- ||
-gfc_is_simply_contiguous (expr, false, true));
-
- no_pack = contiguous && no_pack;
+ && ref->u.ar.as->type != AS_ASSUMED_SHAPE);
+ no_pack
+= contiguous && (no_pack || gfc_is_simply_contiguous (expr, false,
true));
/* If we have an EXPR_OP or a function returning an explicit-shaped
or allocatable array, an array temporary will be generated which
I understand that this may be your personal coding style, but you
might keep in mind that reviewers have to understand the code, too...
I have not fully understood your logic when packing is now invoked.
We not only need to do it for explicit-size arrays, but also for
assumed-size. This still fails for my slightly extended testcase
(see attached) where I pass the class array via:
subroutine d4(x,n)
integer, intent(in) :: n
! class (foo), intent(inout) :: x(n) ! OK
class (foo), intent(inout) :: x(*) ! not OK
call d3(x,n)! Simply pass assumed-size array
end subroutine d4
I am unable to point to the places in your patch where you need to
handle that in addition.
Otherwise I was unable to see any obvious, major problem with the
patch, but then I am not fluent enough in class handling in the
gfortran FE. So if e.g. Paul jumps in here within the next 72 hours,
it would be great.
So here comes the issue with the attached code variant.
After your patch, this prints as last 4 relevant lines:
full: -43 44 45 -46 47
48 -49 50
d3_1: -43 44 45
d3_2: 43 -44 -45
full: 43 -44 -45 -46 47
48 -49 50
while when switching the declaration of the dummy argument of d4:
full: -43 44 45
[gcc r15-1826] Fortran: fix associate with assumed-length character array [PR115700]
https://gcc.gnu.org/g:7b7f203472d07a05d959a29638c7c95d98bf0c1c
commit r15-1826-g7b7f203472d07a05d959a29638c7c95d98bf0c1c
Author: Harald Anlauf
Date: Tue Jul 2 21:26:05 2024 +0200
Fortran: fix associate with assumed-length character array [PR115700]
gcc/fortran/ChangeLog:
PR fortran/115700
* trans-stmt.cc (trans_associate_var): When the associate target
is an array-valued character variable, the length is known at entry
of the associate block. Move setting of string length of the
selector to the initialization part of the block.
gcc/testsuite/ChangeLog:
PR fortran/115700
* gfortran.dg/associate_69.f90: New test.
Diff:
---
gcc/fortran/trans-stmt.cc | 18
gcc/testsuite/gfortran.dg/associate_69.f90 | 33 ++
2 files changed, 47 insertions(+), 4 deletions(-)
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 60275e18867..703a705e7ca 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -1911,6 +1911,8 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block
*block)
gfc_se se;
tree desc;
bool cst_array_ctor;
+ stmtblock_t init;
+ gfc_init_block ();
desc = sym->backend_decl;
cst_array_ctor = e->expr_type == EXPR_ARRAY
@@ -1935,10 +1937,17 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block
*block)
&& !sym->attr.select_type_temporary
&& sym->ts.u.cl->backend_decl
&& VAR_P (sym->ts.u.cl->backend_decl)
+ && se.string_length
&& se.string_length != sym->ts.u.cl->backend_decl)
- gfc_add_modify (, sym->ts.u.cl->backend_decl,
- fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl),
- se.string_length));
+ {
+ /* When the target is a variable, its length is already known. */
+ tree len = fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl),
+ se.string_length);
+ if (e->expr_type == EXPR_VARIABLE)
+ gfc_add_modify (, sym->ts.u.cl->backend_decl, len);
+ else
+ gfc_add_modify (, sym->ts.u.cl->backend_decl, len);
+ }
/* If we didn't already do the pointer assignment, set associate-name
descriptor to the one generated for the temporary. */
@@ -1978,7 +1987,8 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block
*block)
}
/* Done, register stuff as init / cleanup code. */
- gfc_add_init_cleanup (block, gfc_finish_block (),
+ gfc_add_block_to_block (, );
+ gfc_add_init_cleanup (block, gfc_finish_block (),
gfc_finish_block ());
}
diff --git a/gcc/testsuite/gfortran.dg/associate_69.f90
b/gcc/testsuite/gfortran.dg/associate_69.f90
new file mode 100644
index 000..28f488bb274
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_69.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-Og -Wuninitialized -Wmaybe-uninitialized
-fdump-tree-optimized" }
+!
+! PR fortran/115700 - Bogus warning for associate with assumed-length
character array
+!
+subroutine mvce(x)
+ implicit none
+ character(len=*), dimension(:), intent(in) :: x
+
+ associate (tmp1 => x)
+if (len (tmp1) /= len (x)) stop 1
+ end associate
+
+ associate (tmp2 => x(1:))
+if (len (tmp2) /= len (x)) stop 2
+ end associate
+
+ associate (tmp3 => x(1:)(:))
+if (len (tmp3) /= len (x)) stop 3
+ end associate
+
+! The following associate blocks still produce bogus warnings:
+
+! associate (tmp4 => x(:)(1:))
+! if (len (tmp4) /= len (x)) stop 4
+! end associate
+!
+! associate (tmp5 => x(1:)(1:))
+! if (len (tmp5) /= len (x)) stop 5
+! end associate
+end
+
+! { dg-final { scan-tree-dump-not " \\.tmp" "optimized" } }
[PATCH] Fortran: fix associate with assumed-length character array [PR115700]
Dear all,
the attached patch addresses an effectively bogus warning about
uninitialized temporary string lengths of associate selectors.
The primary reason is that the array descriptor for a character
array is created before the corresponding string length is set.
Moving the setting of the string length temporary to the beginning
of the block solves the issue.
The patch does not solve the case for the target containing
substring references. This needs to be addressed separately.
(So far I could not find a solution that does not regress.)
Regtested on x86_64-pc-linux-gnu. OK for mainline?
As the PR is marked as a regression, is it also OK for backporting?
Thanks,
Harald
From 930a1be8c623cf03f9b2e6dbddb45d0b69e152dd Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Tue, 2 Jul 2024 21:26:05 +0200
Subject: [PATCH] Fortran: fix associate with assumed-length character array
[PR115700]
gcc/fortran/ChangeLog:
PR fortran/115700
* trans-stmt.cc (trans_associate_var): When the associate target
is an array-valued character variable, the length is known at entry
of the associate block. Move setting of string length of the
selector to the initialization part of the block.
gcc/testsuite/ChangeLog:
PR fortran/115700
* gfortran.dg/associate_69.f90: New test.
---
gcc/fortran/trans-stmt.cc | 18 +---
gcc/testsuite/gfortran.dg/associate_69.f90 | 33 ++
2 files changed, 47 insertions(+), 4 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/associate_69.f90
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 60275e18867..703a705e7ca 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -1911,6 +1911,8 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
gfc_se se;
tree desc;
bool cst_array_ctor;
+ stmtblock_t init;
+ gfc_init_block ();
desc = sym->backend_decl;
cst_array_ctor = e->expr_type == EXPR_ARRAY
@@ -1935,10 +1937,17 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
&& !sym->attr.select_type_temporary
&& sym->ts.u.cl->backend_decl
&& VAR_P (sym->ts.u.cl->backend_decl)
+ && se.string_length
&& se.string_length != sym->ts.u.cl->backend_decl)
- gfc_add_modify (, sym->ts.u.cl->backend_decl,
- fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl),
- se.string_length));
+ {
+ /* When the target is a variable, its length is already known. */
+ tree len = fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl),
+ se.string_length);
+ if (e->expr_type == EXPR_VARIABLE)
+ gfc_add_modify (, sym->ts.u.cl->backend_decl, len);
+ else
+ gfc_add_modify (, sym->ts.u.cl->backend_decl, len);
+ }
/* If we didn't already do the pointer assignment, set associate-name
descriptor to the one generated for the temporary. */
@@ -1978,7 +1987,8 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
}
/* Done, register stuff as init / cleanup code. */
- gfc_add_init_cleanup (block, gfc_finish_block (),
+ gfc_add_block_to_block (, );
+ gfc_add_init_cleanup (block, gfc_finish_block (),
gfc_finish_block ());
}
diff --git a/gcc/testsuite/gfortran.dg/associate_69.f90 b/gcc/testsuite/gfortran.dg/associate_69.f90
new file mode 100644
index 000..28f488bb274
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_69.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-Og -Wuninitialized -Wmaybe-uninitialized -fdump-tree-optimized" }
+!
+! PR fortran/115700 - Bogus warning for associate with assumed-length character array
+!
+subroutine mvce(x)
+ implicit none
+ character(len=*), dimension(:), intent(in) :: x
+
+ associate (tmp1 => x)
+if (len (tmp1) /= len (x)) stop 1
+ end associate
+
+ associate (tmp2 => x(1:))
+if (len (tmp2) /= len (x)) stop 2
+ end associate
+
+ associate (tmp3 => x(1:)(:))
+if (len (tmp3) /= len (x)) stop 3
+ end associate
+
+! The following associate blocks still produce bogus warnings:
+
+! associate (tmp4 => x(:)(1:))
+! if (len (tmp4) /= len (x)) stop 4
+! end associate
+!
+! associate (tmp5 => x(1:)(1:))
+! if (len (tmp5) /= len (x)) stop 5
+! end associate
+end
+
+! { dg-final { scan-tree-dump-not " \\.tmp" "optimized" } }
--
2.35.3
[gcc r14-10364] Fortran: fix ALLOCATE with SOURCE of deferred character length [PR114019]
https://gcc.gnu.org/g:603b344c07aa55f8292446e8fd28f5da9a983a21
commit r14-10364-g603b344c07aa55f8292446e8fd28f5da9a983a21
Author: Harald Anlauf
Date: Fri Jun 28 21:44:06 2024 +0200
Fortran: fix ALLOCATE with SOURCE of deferred character length [PR114019]
gcc/fortran/ChangeLog:
PR fortran/114019
* trans-stmt.cc (gfc_trans_allocate): Fix handling of case of
scalar character expression being used for SOURCE.
gcc/testsuite/ChangeLog:
PR fortran/114019
* gfortran.dg/allocate_with_source_33.f90: New test.
(cherry picked from commit 7682d115402743090f20aca63a3b5e6c205dedff)
Diff:
---
gcc/fortran/trans-stmt.cc | 5 +-
.../gfortran.dg/allocate_with_source_33.f90| 69 ++
2 files changed, 73 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 87dd833872a..1fd75c6a37c 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -6464,7 +6464,10 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist
*omp_allocate)
else if (se.expr != NULL_TREE && temp_var_needed)
{
tree var, desc;
- tmp = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)) || is_coarray ?
+ tmp = (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr))
+|| is_coarray
+|| (code->expr3->ts.type == BT_CHARACTER
+&& code->expr3->rank == 0)) ?
se.expr
: build_fold_indirect_ref_loc (input_location, se.expr);
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_33.f90
b/gcc/testsuite/gfortran.dg/allocate_with_source_33.f90
new file mode 100644
index 000..43a03625950
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_33.f90
@@ -0,0 +1,69 @@
+! { dg-do compile }
+! { dg-options "-O0" }
+!
+! PR fortran/114019 - allocation with source of deferred character length
+
+subroutine s
+ implicit none
+ character(1) :: w = "4"
+ character(*), parameter :: str = "123"
+ character(5), pointer :: chr_pointer1
+ character(:), pointer :: chr_pointer2
+ character(:), pointer :: chr_ptr_arr(:)
+ character(5), allocatable :: chr_alloc1
+ character(:), allocatable :: chr_alloc2
+ character(:), allocatable :: chr_all_arr(:)
+ allocate (chr_pointer1, source=w// str//w)
+ allocate (chr_pointer2, source=w// str//w)
+ allocate (chr_ptr_arr, source=w//[str//w])
+ allocate (chr_alloc1, source=w// str//w)
+ allocate (chr_alloc2, source=w// str//w)
+ allocate (chr_all_arr, source=w//[str//w])
+ allocate (chr_pointer2, source=str)
+ allocate (chr_pointer2, source=w)
+ allocate (chr_alloc2, source=str)
+ allocate (chr_alloc2, source=w)
+ allocate (chr_pointer1, mold =w// str//w)
+ allocate (chr_pointer2, mold =w// str//w)
+ allocate (chr_ptr_arr, mold =w//[str//w])
+ allocate (chr_alloc1, mold =w// str//w)
+ allocate (chr_alloc2, mold =w// str//w)
+ allocate (chr_all_arr, mold =w//[str//w])
+ allocate (chr_pointer2, mold =str)
+ allocate (chr_pointer2, mold =w)
+ allocate (chr_alloc2, mold =str)
+ allocate (chr_alloc2, mold =w)
+end
+
+subroutine s2
+ implicit none
+ integer, parameter :: ck=4
+ character(kind=ck,len=1) :: w = ck_"4"
+ character(kind=ck,len=*), parameter :: str = ck_"123"
+ character(kind=ck,len=5), pointer :: chr_pointer1
+ character(kind=ck,len=:), pointer :: chr_pointer2
+ character(kind=ck,len=:), pointer :: chr_ptr_arr(:)
+ character(kind=ck,len=5), allocatable :: chr_alloc1
+ character(kind=ck,len=:), allocatable :: chr_alloc2
+ character(kind=ck,len=:), allocatable :: chr_all_arr(:)
+ allocate (chr_pointer1, source=w// str//w)
+ allocate (chr_pointer2, source=w// str//w)
+ allocate (chr_ptr_arr, source=w//[str//w])
+ allocate (chr_alloc1, source=w// str//w)
+ allocate (chr_alloc2, source=w// str//w)
+ allocate (chr_all_arr, source=w//[str//w])
+ allocate (chr_pointer2, source=str)
+ allocate (chr_pointer2, source=w)
+ allocate (chr_alloc2, source=str)
+ allocate (chr_alloc2, source=w)
+ allocate (chr_pointer1, mold =w// str//w)
+ allocate (chr_pointer2, mold =w// str//w)
+ allocate (chr_ptr_arr, mold =w//[str//w])
+ allocate (chr_alloc1, mold =w// str//w)
+ allocate (chr_alloc2, mold =w// str//w)
+ allocate (chr_all_arr, mold =w//[str//w])
+ allocate (chr_pointer2, mold =str)
+ allocate (chr_pointer2, mold =w)
+ allocate (chr_alloc2, mold =str)
+ allocate (chr_alloc2, mold =w)
+end
[gcc r14-10363] Fortran: fix passing of optional dummy as actual to optional argument [PR55978]
https://gcc.gnu.org/g:9f147487de660f026e2fb1281e1a1800f58b3bdd
commit r14-10363-g9f147487de660f026e2fb1281e1a1800f58b3bdd
Author: Harald Anlauf
Date: Sun Jun 23 22:36:43 2024 +0200
Fortran: fix passing of optional dummy as actual to optional argument
[PR55978]
gcc/fortran/ChangeLog:
PR fortran/55978
* trans-array.cc (gfc_conv_array_parameter): Do not dereference
data component of a missing allocatable dummy array argument for
passing as actual to optional dummy. Harden logic of presence
check for optional pointer dummy by using TRUTH_ANDIF_EXPR instead
of TRUTH_AND_EXPR.
gcc/testsuite/ChangeLog:
PR fortran/55978
* gfortran.dg/optional_absent_12.f90: New test.
(cherry picked from commit f02c70dafd384f0c44d7a0920f4a75a30e267045)
Diff:
---
gcc/fortran/trans-array.cc | 20
gcc/testsuite/gfortran.dg/optional_absent_12.f90 | 30
2 files changed, 46 insertions(+), 4 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index a15ff30e8f4..d4b16772de2 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8673,6 +8673,10 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr,
bool g77,
&& (sym->backend_decl != parent))
this_array_result = false;
+ /* Passing an optional dummy argument as actual to an optional dummy? */
+ bool pass_optional;
+ pass_optional = fsym && fsym->attr.optional && sym && sym->attr.optional;
+
/* Passing address of the array if it is not pointer or assumed-shape. */
if (full_array_var && g77 && !this_array_result
&& sym->ts.type != BT_DERIVED && sym->ts.type != BT_CLASS)
@@ -8710,6 +8714,14 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr,
bool g77,
if (size)
array_parameter_size (>pre, tmp, expr, size);
se->expr = gfc_conv_array_data (tmp);
+ if (pass_optional)
+ {
+ tree cond = gfc_conv_expr_present (sym);
+ se->expr = build3_loc (input_location, COND_EXPR,
+TREE_TYPE (se->expr), cond, se->expr,
+fold_convert (TREE_TYPE (se->expr),
+ null_pointer_node));
+ }
return;
}
}
@@ -8959,8 +8971,8 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr,
bool g77,
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
fold_convert (TREE_TYPE (tmp), ptr), tmp);
- if (fsym && fsym->attr.optional && sym && sym->attr.optional)
- tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+ if (pass_optional)
+ tmp = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
logical_type_node,
gfc_conv_expr_present (sym), tmp);
@@ -8994,8 +9006,8 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr,
bool g77,
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
fold_convert (TREE_TYPE (tmp), ptr), tmp);
- if (fsym && fsym->attr.optional && sym && sym->attr.optional)
- tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+ if (pass_optional)
+ tmp = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
logical_type_node,
gfc_conv_expr_present (sym), tmp);
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_12.f90
b/gcc/testsuite/gfortran.dg/optional_absent_12.f90
new file mode 100644
index 000..1e61d91fb6d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_12.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+! { dg-additional-options "-fcheck=array-temps" }
+!
+! PR fortran/55978 - comment#19
+!
+! Test passing of (missing) optional dummy to optional array argument
+
+program test
+ implicit none
+ integer, pointer :: p(:) => null()
+ call one (p)
+ call one (null())
+ call one ()
+ call three ()
+contains
+ subroutine one (y)
+integer, pointer, optional, intent(in) :: y(:)
+call two (y)
+ end subroutine one
+
+ subroutine three (z)
+integer, allocatable, optional, intent(in) :: z(:)
+call two (z)
+ end subroutine three
+
+ subroutine two (x)
+integer, optional, intent(in) :: x(*)
+if (present (x)) stop 1
+ end subroutine two
+end
[gcc r14-10362] Fortran: fix for CHARACTER(len=*) dummies with bind(C) [PR115390]
https://gcc.gnu.org/g:b31e1900fa0cffabb0702962d01ba3fe917fdf69
commit r14-10362-gb31e1900fa0cffabb0702962d01ba3fe917fdf69
Author: Harald Anlauf
Date: Tue Jun 18 21:57:19 2024 +0200
Fortran: fix for CHARACTER(len=*) dummies with bind(C) [PR115390]
gcc/fortran/ChangeLog:
PR fortran/115390
* trans-decl.cc (gfc_conv_cfi_to_gfc): Move derivation of type sizes
for character via gfc_trans_vla_type_sizes to after character length
has been set.
gcc/testsuite/ChangeLog:
PR fortran/115390
* gfortran.dg/bind_c_char_11.f90: New test.
(cherry picked from commit 954f9011c4923b72f42cc6ca8460333e7c7aad98)
Diff:
---
gcc/fortran/trans-decl.cc| 4 +--
gcc/testsuite/gfortran.dg/bind_c_char_11.f90 | 45
2 files changed, 47 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 301439baaf5..1a319b27449 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -7056,8 +7056,8 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t
*finally,
if (sym->ts.type == BT_CHARACTER
&& !INTEGER_CST_P (sym->ts.u.cl->backend_decl))
{
- gfc_conv_string_length (sym->ts.u.cl, NULL, init);
- gfc_trans_vla_type_sizes (sym, init);
+ gfc_conv_string_length (sym->ts.u.cl, NULL, );
+ gfc_trans_vla_type_sizes (sym, );
}
/* gfc->data = cfi->base_addr - or for scalars: gfc = cfi->base_addr.
diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_11.f90
b/gcc/testsuite/gfortran.dg/bind_c_char_11.f90
new file mode 100644
index 000..5ed8e82853b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_char_11.f90
@@ -0,0 +1,45 @@
+! { dg-do compile }
+! { dg-additional-options "-Wuninitialized" }
+!
+! PR fortran/115390 - fixes for CHARACTER(len=*) dummies with bind(C)
+
+module test
+ implicit none
+contains
+ subroutine bar(s,t) bind(c)
+character(*), intent(in) :: s,t
+optional :: t
+call foo(s,t)
+ end
+ subroutine bar1(s,t) bind(c)
+character(*), intent(in) :: s(:),t(:)
+optional :: t
+call foo1(s,t)
+ end
+ subroutine bar4(s,t) bind(c)
+character(len=*,kind=4), intent(in) :: s,t
+optional:: t
+call foo4(s,t)
+ end
+ subroutine bar5(s,t) bind(c)
+character(len=*,kind=4), intent(in) :: s(:),t(:)
+optional:: t
+call foo5(s,t)
+ end
+ subroutine foo(s,t)
+character(*), intent(in) :: s,t
+optional :: t
+ end
+ subroutine foo1(s,t)
+character(*), intent(in) :: s(:),t(:)
+optional :: t
+ end
+ subroutine foo4(s,t)
+character(len=*,kind=4), intent(in) :: s,t
+optional:: t
+ end
+ subroutine foo5(s,t)
+character(len=*,kind=4), intent(in) :: s(:),t(:)
+optional:: t
+ end
+end
[gcc r15-1722] Fortran: fix ALLOCATE with SOURCE of deferred character length [PR114019]
https://gcc.gnu.org/g:7682d115402743090f20aca63a3b5e6c205dedff
commit r15-1722-g7682d115402743090f20aca63a3b5e6c205dedff
Author: Harald Anlauf
Date: Fri Jun 28 21:44:06 2024 +0200
Fortran: fix ALLOCATE with SOURCE of deferred character length [PR114019]
gcc/fortran/ChangeLog:
PR fortran/114019
* trans-stmt.cc (gfc_trans_allocate): Fix handling of case of
scalar character expression being used for SOURCE.
gcc/testsuite/ChangeLog:
PR fortran/114019
* gfortran.dg/allocate_with_source_33.f90: New test.
Diff:
---
gcc/fortran/trans-stmt.cc | 5 +-
.../gfortran.dg/allocate_with_source_33.f90| 69 ++
2 files changed, 73 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 93b633e212e..60275e18867 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -6464,7 +6464,10 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist
*omp_allocate)
else if (se.expr != NULL_TREE && temp_var_needed)
{
tree var, desc;
- tmp = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)) || is_coarray ?
+ tmp = (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr))
+|| is_coarray
+|| (code->expr3->ts.type == BT_CHARACTER
+&& code->expr3->rank == 0)) ?
se.expr
: build_fold_indirect_ref_loc (input_location, se.expr);
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_33.f90
b/gcc/testsuite/gfortran.dg/allocate_with_source_33.f90
new file mode 100644
index 000..43a03625950
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_33.f90
@@ -0,0 +1,69 @@
+! { dg-do compile }
+! { dg-options "-O0" }
+!
+! PR fortran/114019 - allocation with source of deferred character length
+
+subroutine s
+ implicit none
+ character(1) :: w = "4"
+ character(*), parameter :: str = "123"
+ character(5), pointer :: chr_pointer1
+ character(:), pointer :: chr_pointer2
+ character(:), pointer :: chr_ptr_arr(:)
+ character(5), allocatable :: chr_alloc1
+ character(:), allocatable :: chr_alloc2
+ character(:), allocatable :: chr_all_arr(:)
+ allocate (chr_pointer1, source=w// str//w)
+ allocate (chr_pointer2, source=w// str//w)
+ allocate (chr_ptr_arr, source=w//[str//w])
+ allocate (chr_alloc1, source=w// str//w)
+ allocate (chr_alloc2, source=w// str//w)
+ allocate (chr_all_arr, source=w//[str//w])
+ allocate (chr_pointer2, source=str)
+ allocate (chr_pointer2, source=w)
+ allocate (chr_alloc2, source=str)
+ allocate (chr_alloc2, source=w)
+ allocate (chr_pointer1, mold =w// str//w)
+ allocate (chr_pointer2, mold =w// str//w)
+ allocate (chr_ptr_arr, mold =w//[str//w])
+ allocate (chr_alloc1, mold =w// str//w)
+ allocate (chr_alloc2, mold =w// str//w)
+ allocate (chr_all_arr, mold =w//[str//w])
+ allocate (chr_pointer2, mold =str)
+ allocate (chr_pointer2, mold =w)
+ allocate (chr_alloc2, mold =str)
+ allocate (chr_alloc2, mold =w)
+end
+
+subroutine s2
+ implicit none
+ integer, parameter :: ck=4
+ character(kind=ck,len=1) :: w = ck_"4"
+ character(kind=ck,len=*), parameter :: str = ck_"123"
+ character(kind=ck,len=5), pointer :: chr_pointer1
+ character(kind=ck,len=:), pointer :: chr_pointer2
+ character(kind=ck,len=:), pointer :: chr_ptr_arr(:)
+ character(kind=ck,len=5), allocatable :: chr_alloc1
+ character(kind=ck,len=:), allocatable :: chr_alloc2
+ character(kind=ck,len=:), allocatable :: chr_all_arr(:)
+ allocate (chr_pointer1, source=w// str//w)
+ allocate (chr_pointer2, source=w// str//w)
+ allocate (chr_ptr_arr, source=w//[str//w])
+ allocate (chr_alloc1, source=w// str//w)
+ allocate (chr_alloc2, source=w// str//w)
+ allocate (chr_all_arr, source=w//[str//w])
+ allocate (chr_pointer2, source=str)
+ allocate (chr_pointer2, source=w)
+ allocate (chr_alloc2, source=str)
+ allocate (chr_alloc2, source=w)
+ allocate (chr_pointer1, mold =w// str//w)
+ allocate (chr_pointer2, mold =w// str//w)
+ allocate (chr_ptr_arr, mold =w//[str//w])
+ allocate (chr_alloc1, mold =w// str//w)
+ allocate (chr_alloc2, mold =w// str//w)
+ allocate (chr_all_arr, mold =w//[str//w])
+ allocate (chr_pointer2, mold =str)
+ allocate (chr_pointer2, mold =w)
+ allocate (chr_alloc2, mold =str)
+ allocate (chr_alloc2, mold =w)
+end
[PATCH] Fortran: fix ALLOCATE with SOURCE of deferred character length [PR114019]
Dear all,
the attached patch fixes an ICE occuring for ALLOCATE with SOURCE
(or MOLD) of deferred character length in the scalar case, which
looked obscure because the ICE disappears at -O1 and higher.
The dump tree suggests that it is a wrong decl for the temporary
source that was e.g.
character(kind=1) source.2[1:];
whereas I had expected
character(kind=1)[1:] * source.2;
and which we now get after the patch. Or am I missing something?
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
From 4d12f6d0cf63ea6a2deb5398e6478dde114e76b8 Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Fri, 28 Jun 2024 21:44:06 +0200
Subject: [PATCH] Fortran: fix ALLOCATE with SOURCE of deferred character
length [PR114019]
gcc/fortran/ChangeLog:
PR fortran/114019
* trans-stmt.cc (gfc_trans_allocate): Fix handling of case of
scalar character expression being used for SOURCE.
gcc/testsuite/ChangeLog:
PR fortran/114019
* gfortran.dg/allocate_with_source_33.f90: New test.
---
gcc/fortran/trans-stmt.cc | 5 +-
.../gfortran.dg/allocate_with_source_33.f90 | 53 +++
2 files changed, 57 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/allocate_with_source_33.f90
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 93b633e212e..60275e18867 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -6464,7 +6464,10 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate)
else if (se.expr != NULL_TREE && temp_var_needed)
{
tree var, desc;
- tmp = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)) || is_coarray ?
+ tmp = (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr))
+ || is_coarray
+ || (code->expr3->ts.type == BT_CHARACTER
+ && code->expr3->rank == 0)) ?
se.expr
: build_fold_indirect_ref_loc (input_location, se.expr);
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_33.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_33.f90
new file mode 100644
index 000..7b1a26c464c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_33.f90
@@ -0,0 +1,53 @@
+! { dg-do compile }
+! { dg-options "-O0" }
+!
+! PR fortran/114019 - allocation with source of deferred character length
+
+subroutine s
+ implicit none
+ character(1) :: w = "4"
+ character(*), parameter :: str = "123"
+ character(5), pointer :: chr_pointer1
+ character(:), pointer :: chr_pointer2
+ character(:), pointer :: chr_ptr_arr(:)
+ character(5), allocatable :: chr_alloc1
+ character(:), allocatable :: chr_alloc2
+ character(:), allocatable :: chr_all_arr(:)
+ allocate (chr_pointer1, source=w// str//w)
+ allocate (chr_pointer2, source=w// str//w)
+ allocate (chr_ptr_arr, source=w//[str//w])
+ allocate (chr_alloc1, source=w// str//w)
+ allocate (chr_alloc2, source=w// str//w)
+ allocate (chr_all_arr, source=w//[str//w])
+ allocate (chr_pointer1, mold =w// str//w)
+ allocate (chr_pointer2, mold =w// str//w)
+ allocate (chr_ptr_arr, mold =w//[str//w])
+ allocate (chr_alloc1, mold =w// str//w)
+ allocate (chr_alloc2, mold =w// str//w)
+ allocate (chr_all_arr, mold =w//[str//w])
+end
+
+subroutine s2
+ implicit none
+ integer, parameter :: ck=4
+ character(kind=ck,len=1) :: w = ck_"4"
+ character(kind=ck,len=*), parameter :: str = ck_"123"
+ character(kind=ck,len=5), pointer :: chr_pointer1
+ character(kind=ck,len=:), pointer :: chr_pointer2
+ character(kind=ck,len=:), pointer :: chr_ptr_arr(:)
+ character(kind=ck,len=5), allocatable :: chr_alloc1
+ character(kind=ck,len=:), allocatable :: chr_alloc2
+ character(kind=ck,len=:), allocatable :: chr_all_arr(:)
+ allocate (chr_pointer1, source=w// str//w)
+ allocate (chr_pointer2, source=w// str//w)
+ allocate (chr_ptr_arr, source=w//[str//w])
+ allocate (chr_alloc1, source=w// str//w)
+ allocate (chr_alloc2, source=w// str//w)
+ allocate (chr_all_arr, source=w//[str//w])
+ allocate (chr_pointer1, mold =w// str//w)
+ allocate (chr_pointer2, mold =w// str//w)
+ allocate (chr_ptr_arr, mold =w//[str//w])
+ allocate (chr_alloc1, mold =w// str//w)
+ allocate (chr_alloc2, mold =w// str//w)
+ allocate (chr_all_arr, mold =w//[str//w])
+end
--
2.35.3
[gcc r15-1585] Fortran: fix passing of optional dummy as actual to optional argument [PR55978]
https://gcc.gnu.org/g:f02c70dafd384f0c44d7a0920f4a75a30e267045
commit r15-1585-gf02c70dafd384f0c44d7a0920f4a75a30e267045
Author: Harald Anlauf
Date: Sun Jun 23 22:36:43 2024 +0200
Fortran: fix passing of optional dummy as actual to optional argument
[PR55978]
gcc/fortran/ChangeLog:
PR fortran/55978
* trans-array.cc (gfc_conv_array_parameter): Do not dereference
data component of a missing allocatable dummy array argument for
passing as actual to optional dummy. Harden logic of presence
check for optional pointer dummy by using TRUTH_ANDIF_EXPR instead
of TRUTH_AND_EXPR.
gcc/testsuite/ChangeLog:
PR fortran/55978
* gfortran.dg/optional_absent_12.f90: New test.
Diff:
---
gcc/fortran/trans-array.cc | 20
gcc/testsuite/gfortran.dg/optional_absent_12.f90 | 30
2 files changed, 46 insertions(+), 4 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 19d69aec9c0..26237f43bec 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8703,6 +8703,10 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr,
bool g77,
&& (sym->backend_decl != parent))
this_array_result = false;
+ /* Passing an optional dummy argument as actual to an optional dummy? */
+ bool pass_optional;
+ pass_optional = fsym && fsym->attr.optional && sym && sym->attr.optional;
+
/* Passing address of the array if it is not pointer or assumed-shape. */
if (full_array_var && g77 && !this_array_result
&& sym->ts.type != BT_DERIVED && sym->ts.type != BT_CLASS)
@@ -8740,6 +8744,14 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr,
bool g77,
if (size)
array_parameter_size (>pre, tmp, expr, size);
se->expr = gfc_conv_array_data (tmp);
+ if (pass_optional)
+ {
+ tree cond = gfc_conv_expr_present (sym);
+ se->expr = build3_loc (input_location, COND_EXPR,
+TREE_TYPE (se->expr), cond, se->expr,
+fold_convert (TREE_TYPE (se->expr),
+ null_pointer_node));
+ }
return;
}
}
@@ -8989,8 +9001,8 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr,
bool g77,
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
fold_convert (TREE_TYPE (tmp), ptr), tmp);
- if (fsym && fsym->attr.optional && sym && sym->attr.optional)
- tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+ if (pass_optional)
+ tmp = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
logical_type_node,
gfc_conv_expr_present (sym), tmp);
@@ -9024,8 +9036,8 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr,
bool g77,
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
fold_convert (TREE_TYPE (tmp), ptr), tmp);
- if (fsym && fsym->attr.optional && sym && sym->attr.optional)
- tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+ if (pass_optional)
+ tmp = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
logical_type_node,
gfc_conv_expr_present (sym), tmp);
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_12.f90
b/gcc/testsuite/gfortran.dg/optional_absent_12.f90
new file mode 100644
index 000..1e61d91fb6d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_12.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+! { dg-additional-options "-fcheck=array-temps" }
+!
+! PR fortran/55978 - comment#19
+!
+! Test passing of (missing) optional dummy to optional array argument
+
+program test
+ implicit none
+ integer, pointer :: p(:) => null()
+ call one (p)
+ call one (null())
+ call one ()
+ call three ()
+contains
+ subroutine one (y)
+integer, pointer, optional, intent(in) :: y(:)
+call two (y)
+ end subroutine one
+
+ subroutine three (z)
+integer, allocatable, optional, intent(in) :: z(:)
+call two (z)
+ end subroutine three
+
+ subroutine two (x)
+integer, optional, intent(in) :: x(*)
+if (present (x)) stop 1
+ end subroutine two
+end
[PATCH] Fortran: fix passing of optional dummy as actual to optional argument [PR55978]
Dear all,
the attached patch fixes issues exhibited by the testcase in comment#19 of
PR55978.
First, when passing an allocatable optional dummy array to an optional dummy,
we need to prevent accessing the data component of the array when the argument
is not present, and pass a null pointer instead. This is straightforward.
Second, the case of a missing pointer optional dummy array should have worked,
but the presence check surprisingly did not work as expected at -O0 or -Og,
but at higher optimization levels. Interestingly, the dump-tree looked right,
but running under gdb or investigating the assembler revealed that the order
of tests in a logical AND expression was opposed to what the tree-dump looked
like. Replacing TRUTH_AND_EXPR by TRUTH_ANDIF_EXPR and checking the optimized
dump confirmed that this does fix the issue.
Note that the tree-dump is not changed by this replacement. Does this mean
thar AND and ANDIF currently are not differentiated at this level?
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Would it be ok to backport this to 14-branch, too?
Thanks,
Harald
From 94e4c66d8374a12be38637620f362acf1fba5343 Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Sun, 23 Jun 2024 22:36:43 +0200
Subject: [PATCH] Fortran: fix passing of optional dummy as actual to optional
argument [PR55978]
gcc/fortran/ChangeLog:
PR fortran/55978
* trans-array.cc (gfc_conv_array_parameter): Do not dereference
data component of a missing allocatable dummy array argument for
passing as actual to optional dummy. Harden logic of presence
check for optional pointer dummy by using TRUTH_ANDIF_EXPR instead
of TRUTH_AND_EXPR.
gcc/testsuite/ChangeLog:
PR fortran/55978
* gfortran.dg/optional_absent_12.f90: New test.
---
gcc/fortran/trans-array.cc| 20 ++---
.../gfortran.dg/optional_absent_12.f90| 30 +++
2 files changed, 46 insertions(+), 4 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/optional_absent_12.f90
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 19d69aec9c0..26237f43bec 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8703,6 +8703,10 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
&& (sym->backend_decl != parent))
this_array_result = false;
+ /* Passing an optional dummy argument as actual to an optional dummy? */
+ bool pass_optional;
+ pass_optional = fsym && fsym->attr.optional && sym && sym->attr.optional;
+
/* Passing address of the array if it is not pointer or assumed-shape. */
if (full_array_var && g77 && !this_array_result
&& sym->ts.type != BT_DERIVED && sym->ts.type != BT_CLASS)
@@ -8740,6 +8744,14 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
if (size)
array_parameter_size (>pre, tmp, expr, size);
se->expr = gfc_conv_array_data (tmp);
+ if (pass_optional)
+ {
+ tree cond = gfc_conv_expr_present (sym);
+ se->expr = build3_loc (input_location, COND_EXPR,
+ TREE_TYPE (se->expr), cond, se->expr,
+ fold_convert (TREE_TYPE (se->expr),
+ null_pointer_node));
+ }
return;
}
}
@@ -8989,8 +9001,8 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
fold_convert (TREE_TYPE (tmp), ptr), tmp);
- if (fsym && fsym->attr.optional && sym && sym->attr.optional)
- tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+ if (pass_optional)
+ tmp = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
logical_type_node,
gfc_conv_expr_present (sym), tmp);
@@ -9024,8 +9036,8 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
fold_convert (TREE_TYPE (tmp), ptr), tmp);
- if (fsym && fsym->attr.optional && sym && sym->attr.optional)
- tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+ if (pass_optional)
+ tmp = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
logical_type_node,
gfc_conv_expr_present (sym), tmp);
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_12.f90 b/gcc/testsuite/gfortran.dg/optional_absent_12.f90
new file mode 100644
index 000..1e61d91fb6d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_12.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+! { dg-additional-options "-fcheck=array-temps" }
+!
+! PR fortran/55978 - comment#19
+!
+! Test passing of (missing) optional dummy to optional array argument
+
+program test
+ implicit none
+ integer, pointer :: p(:) => null()
+ call one (p)
+ call one (null())
+ call one ()
+ call three ()
+contains
+ subroutine one (y)
[gcc r13-8857] Fortran: fix ALLOCATE with SOURCE=, zero-length character [PR83865]
https://gcc.gnu.org/g:0530884fbf49cc81119d66de7e4a48b47172ed4c
commit r13-8857-g0530884fbf49cc81119d66de7e4a48b47172ed4c
Author: Harald Anlauf
Date: Mon Jun 3 22:02:06 2024 +0200
Fortran: fix ALLOCATE with SOURCE=, zero-length character [PR83865]
gcc/fortran/ChangeLog:
PR fortran/83865
* trans-stmt.cc (gfc_trans_allocate): Restrict special case for
source-expression with zero-length character to rank 0, so that
the array shape is not discarded.
gcc/testsuite/ChangeLog:
PR fortran/83865
* gfortran.dg/allocate_with_source_32.f90: New test.
(cherry picked from commit 7f21aee0d4ef95eee7d9f7f42e9a056715836648)
Diff:
---
gcc/fortran/trans-stmt.cc | 3 +-
.../gfortran.dg/allocate_with_source_32.f90| 33 ++
2 files changed, 35 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 35eb1880539b..caa7b59e9129 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -6398,8 +6398,9 @@ gfc_trans_allocate (gfc_code * code)
else
gfc_add_block_to_block (, );
- /* Special case when string in expr3 is zero. */
+ /* Special case when string in expr3 is scalar and has length zero. */
if (code->expr3->ts.type == BT_CHARACTER
+ && code->expr3->rank == 0
&& integer_zerop (se.string_length))
{
gfc_init_se (, NULL);
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_32.f90
b/gcc/testsuite/gfortran.dg/allocate_with_source_32.f90
new file mode 100644
index ..4a9bd46da4d5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_32.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+!
+! PR fortran/83865
+!
+! Test ALLOCATE with SOURCE= of deferred length character, where
+! the source-expression is an array of character with length 0.
+
+program p
+ implicit none
+ character(:), allocatable :: z(:)
+ character(1) :: cc(4) = ""
+ allocate (z, source=[''])
+ if (len (z) /= 0 .or. size (z) /= 1) stop 1
+ deallocate (z)
+ allocate (z, source=['',''])
+ if (len (z) /= 0 .or. size (z) /= 2) stop 2
+ deallocate (z)
+ allocate (z, source=[ character(0) :: 'a','b','c'])
+ if (len (z) /= 0 .or. size (z) /= 3) stop 3
+ deallocate (z)
+ allocate (z, source=[ character(0) :: cc ])
+ if (len (z) /= 0 .or. size (z) /= 4) stop 4
+ deallocate (z)
+ associate (x => f())
+if (len (x) /= 0 .or. size (x) /= 1) stop 5
+if (x(1) /= '') stop 6
+ end associate
+contains
+ function f() result(z)
+character(:), allocatable :: z(:)
+allocate (z, source=[''])
+ end function f
+end
Re: [Fortran, Patch, PR 96992] Fix Class arrays of different ranks are rejected as storage association argument
Hi Andre, Am 19.06.24 um 09:07 schrieb Andre Vehreschild: Hi Harald, thank you for the investigation and useful tips. I had to figure what went wrong here, but I now figured, that the array needs repacking when a negative stride is used (or at least a call to that routine, which then fixes "stuff"). I have added it, freeing the memory allocated potentially by pack, and also updated the testcase to include the negative stride. hmmm, the pack does not always get generated: module foo_mod implicit none type foo integer :: i end type foo contains subroutine d1(x,n) integer, intent(in) :: n integer :: i class (foo), intent(out) :: x(n) select type(x) class is(foo) x(:)%i = (/ (42 + i, i = 1, n ) /) class default stop 1 end select end subroutine d1 subroutine d2(x,n) integer, intent(in) :: n integer :: i class (foo), intent(in) :: x(n,n,n) select type (x) class is (foo) print *,"d2: ", x%i if ( any( x%i /= reshape((/ (42 + i, i = 1, n ** 3 ) /), [n, n, n] ))) stop 2 class default stop 3 end select end subroutine d2 subroutine d3(x,n) integer, intent(in) :: n integer :: i class (foo), intent(inout) :: x(n) select type (x) class is (foo) print *,"d3_1:", x%i x%i = -x%i ! Simply negate elements print *,"d3_2:", x%i class default stop 33 end select end subroutine d3 end module foo_mod program main use foo_mod implicit none type (foo), dimension(:), allocatable :: f integer :: n, k, m n = 2 allocate (f(n*n*n)) ! Original testcase: call d1(f,n*n*n) print *, "d1->:", f%i call d2(f,n) ! Ensure that array f is ok: print *, "d2->:", f%i ! The following shows that no appropriate internal pack is generated: call d1(f,n*n*n) print *, "d1->:", f%i m = n*n*n k = 3 print *, "->d3:", f(1:m:k)%i call d3(f(1:m:k),1+(m-1)/k) print *, "d3->:", f(1:m:k)%i print *, "full:", f%i deallocate (f) end program main After the second version of your patch this prints: d1->: 43 44 45 46 47 48 49 50 d2:43 44 45 46 47 48 49 50 d2->: 43 44 45 46 47 48 49 50 d1->: 43 44 45 46 47 48 49 50 ->d3: 43 46 49 d3_1: 43 44 45 d3_2: -43 -44 -45 d3->: -43 46 49 full: -43 -44 -45 46 47 48 49 50 While the print properly handles f(1:m:k)%i, passing it as actual argument to subroutine d3 does not do pack/unpack. Can you have another look? Thanks, Harald Regtests fine on x86_64-pc-linux-gnu/Fedora 39. Ok for mainline? Regards, Andre On Sun, 16 Jun 2024 23:27:46 +0200 Harald Anlauf wrote: << snipped for brevity >>> -- Andre Vehreschild * Email: vehre ad gmx dot de
[gcc r15-1449] Fortran: fix for CHARACTER(len=*) dummies with bind(C) [PR115390]
https://gcc.gnu.org/g:954f9011c4923b72f42cc6ca8460333e7c7aad98
commit r15-1449-g954f9011c4923b72f42cc6ca8460333e7c7aad98
Author: Harald Anlauf
Date: Tue Jun 18 21:57:19 2024 +0200
Fortran: fix for CHARACTER(len=*) dummies with bind(C) [PR115390]
gcc/fortran/ChangeLog:
PR fortran/115390
* trans-decl.cc (gfc_conv_cfi_to_gfc): Move derivation of type sizes
for character via gfc_trans_vla_type_sizes to after character length
has been set.
gcc/testsuite/ChangeLog:
PR fortran/115390
* gfortran.dg/bind_c_char_11.f90: New test.
Diff:
---
gcc/fortran/trans-decl.cc| 4 +--
gcc/testsuite/gfortran.dg/bind_c_char_11.f90 | 45
2 files changed, 47 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 88538713a02b..f7fb6eec336a 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -7063,8 +7063,8 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t
*finally,
if (sym->ts.type == BT_CHARACTER
&& !INTEGER_CST_P (sym->ts.u.cl->backend_decl))
{
- gfc_conv_string_length (sym->ts.u.cl, NULL, init);
- gfc_trans_vla_type_sizes (sym, init);
+ gfc_conv_string_length (sym->ts.u.cl, NULL, );
+ gfc_trans_vla_type_sizes (sym, );
}
/* gfc->data = cfi->base_addr - or for scalars: gfc = cfi->base_addr.
diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_11.f90
b/gcc/testsuite/gfortran.dg/bind_c_char_11.f90
new file mode 100644
index ..5ed8e82853bf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_char_11.f90
@@ -0,0 +1,45 @@
+! { dg-do compile }
+! { dg-additional-options "-Wuninitialized" }
+!
+! PR fortran/115390 - fixes for CHARACTER(len=*) dummies with bind(C)
+
+module test
+ implicit none
+contains
+ subroutine bar(s,t) bind(c)
+character(*), intent(in) :: s,t
+optional :: t
+call foo(s,t)
+ end
+ subroutine bar1(s,t) bind(c)
+character(*), intent(in) :: s(:),t(:)
+optional :: t
+call foo1(s,t)
+ end
+ subroutine bar4(s,t) bind(c)
+character(len=*,kind=4), intent(in) :: s,t
+optional:: t
+call foo4(s,t)
+ end
+ subroutine bar5(s,t) bind(c)
+character(len=*,kind=4), intent(in) :: s(:),t(:)
+optional:: t
+call foo5(s,t)
+ end
+ subroutine foo(s,t)
+character(*), intent(in) :: s,t
+optional :: t
+ end
+ subroutine foo1(s,t)
+character(*), intent(in) :: s(:),t(:)
+optional :: t
+ end
+ subroutine foo4(s,t)
+character(len=*,kind=4), intent(in) :: s,t
+optional:: t
+ end
+ subroutine foo5(s,t)
+character(len=*,kind=4), intent(in) :: s(:),t(:)
+optional:: t
+ end
+end
[PATCH] Fortran: fix for CHARACTER(len=*) dummies with bind(C) [PR115390]
Dear all,
the attached simple patch fixes warnings for use of uninitialized
temporaries for the string length before being defined. The cause
is obvious: type sizes were being calculated before the temporaries
were set from the descriptor for the dummy passed to the BIND(C)
procedure. Wrong code might have been possible as well.
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
From 95a3cefd5e84cf0d393c2606757894389c08ebba Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Tue, 18 Jun 2024 21:57:19 +0200
Subject: [PATCH] Fortran: fix for CHARACTER(len=*) dummies with bind(C)
[PR115390]
gcc/fortran/ChangeLog:
PR fortran/115390
* trans-decl.cc (gfc_conv_cfi_to_gfc): Move derivation of type sizes
for character via gfc_trans_vla_type_sizes to after character length
has been set.
gcc/testsuite/ChangeLog:
PR fortran/115390
* gfortran.dg/bind_c_char_11.f90: New test.
---
gcc/fortran/trans-decl.cc| 4 +-
gcc/testsuite/gfortran.dg/bind_c_char_11.f90 | 45
2 files changed, 47 insertions(+), 2 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/bind_c_char_11.f90
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index dca7779528b..704f24be84a 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -7063,8 +7063,8 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally,
if (sym->ts.type == BT_CHARACTER
&& !INTEGER_CST_P (sym->ts.u.cl->backend_decl))
{
- gfc_conv_string_length (sym->ts.u.cl, NULL, init);
- gfc_trans_vla_type_sizes (sym, init);
+ gfc_conv_string_length (sym->ts.u.cl, NULL, );
+ gfc_trans_vla_type_sizes (sym, );
}
/* gfc->data = cfi->base_addr - or for scalars: gfc = cfi->base_addr.
diff --git a/gcc/testsuite/gfortran.dg/bind_c_char_11.f90 b/gcc/testsuite/gfortran.dg/bind_c_char_11.f90
new file mode 100644
index 000..5ed8e82853b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_char_11.f90
@@ -0,0 +1,45 @@
+! { dg-do compile }
+! { dg-additional-options "-Wuninitialized" }
+!
+! PR fortran/115390 - fixes for CHARACTER(len=*) dummies with bind(C)
+
+module test
+ implicit none
+contains
+ subroutine bar(s,t) bind(c)
+character(*), intent(in) :: s,t
+optional :: t
+call foo(s,t)
+ end
+ subroutine bar1(s,t) bind(c)
+character(*), intent(in) :: s(:),t(:)
+optional :: t
+call foo1(s,t)
+ end
+ subroutine bar4(s,t) bind(c)
+character(len=*,kind=4), intent(in) :: s,t
+optional:: t
+call foo4(s,t)
+ end
+ subroutine bar5(s,t) bind(c)
+character(len=*,kind=4), intent(in) :: s(:),t(:)
+optional:: t
+call foo5(s,t)
+ end
+ subroutine foo(s,t)
+character(*), intent(in) :: s,t
+optional :: t
+ end
+ subroutine foo1(s,t)
+character(*), intent(in) :: s(:),t(:)
+optional :: t
+ end
+ subroutine foo4(s,t)
+character(len=*,kind=4), intent(in) :: s,t
+optional:: t
+ end
+ subroutine foo5(s,t)
+character(len=*,kind=4), intent(in) :: s(:),t(:)
+optional:: t
+ end
+end
--
2.35.3
Re: [Patch, Fortran, 96418] Fix Test coarray_alloc_comp_4.f08 ICEs
Hi Andre, Am 17.06.24 um 09:51 schrieb Andre Vehreschild: Regarding your question on the coarray-tests that are not in the coarray-directory: These test in most cases test only one method of implementing coarrays. I.e., they are either testing just -fcoarray=single or -fcoarray=lib -lcaf_single, which are two different approaches. The tests in the coarray-directory test all available methods to implement coarrays. Pushing ah, that explains it. I only looked at some of the test sources, but did not think of looking at caf.exp ... all coarray-tests into the coarray-directory will fail a lot of them, because the behavior of -fcoarray=single and -fcoarray=lib -lcaf_single is different in some corner cases. That's why the coarray-tests in the main gfortran-dir are separate. I do understand why it may be confusing, but I don't see an easy solution. Does this answer your question? Indeed it does! Thanks, Harald
Re: [Fortran, Patch, PR 96992] Fix Class arrays of different ranks are rejected as storage association argument
Hi Andre, Am 14.06.24 um 17:05 schrieb Andre Vehreschild: Hi all, I somehow got assigned to this PR so I fixed it. GFortran was ICEing because of the ASSUME_RANK in a derived to class conversion. After fixing this, storage association was producing segfaults. The "shape conversion" of the class array as dummy argument was not initializing the dim 0 stride and with that grabbing into the memory somewhere. This is now fixed and regtests fine on x86_64 Fedora 39. Ok for mainline? the patch fixes the testcase in your submission, but not the following slight variation of the main program: module foo_mod implicit none type foo integer :: i end type foo contains subroutine d1(x,n) integer, intent(in) :: n integer :: i class (foo), intent(out) :: x(n) select type(x) class is(foo) x(:)%i = (/ (42 + i, i = 1, n ) /) class default stop 1 end select end subroutine d1 subroutine d2(x,n) integer, intent(in) :: n integer :: i class (foo), intent(in) :: x(n,n,n) select type (x) class is (foo) print *,x%i if ( any( x%i /= reshape((/ (42 + i, i = 1, n ** 3 ) /), [n, n, n] ))) stop 2 class default stop 3 end select end subroutine d2 end module foo_mod program main use foo_mod implicit none type (foo), dimension(:), allocatable :: f integer :: n n = 2 allocate (f(n*n*n)) ! Original testcase: call d1(f,n*n*n) call d2(f,n) ! OK call d1(f(1:n*n*n),n*n*n) print *, "After call d1(f(1:n*n*n:1),n*n*n):" print *, f%i call d2(f(1:n*n*n),n) ! OK ! Using stride -1: call d1(f(n*n*n:1:-1),n*n*n) print *, "After call d1(f(n*n*n:1:-1),n*n*n):" print *, f%i call d2(f(n*n*n:1:-1),n) ! not OK deallocate (f) end program main While this runs fine with the latest Intel compiler, gfortran including your patch prints: 43 44 45 46 47 48 49 50 After call d1(f(1:n*n*n:1),n*n*n): 43 44 45 46 47 48 49 50 43 44 45 46 47 48 49 50 After call d1(f(n*n*n:1:-1),n*n*n): 50 49 48 47 46 45 44 43 43 0 0 49 0 34244976 034238480 STOP 2 So while the negative stride (-1) in the call to d1 appears to work as it should, it does not work properly for the call to d2. The first array element is fine in d2, but anything else isn't. Do you see what goes wrong here? (This may be a more general, pre-existing issue in a different place.) Thanks, Harald P.S.: regarding your commit message, I think the reference to the pr in brackets should be moved to the end of the summary line, i.e. for Fortran: [PR96992] Fix rejecting class arrays of different ranks as storage association argument. the "[PR96992" should be moved. Makes it also easier to read. I assume this patch could be fixing some other PRs with class array's parameter passing, too. If that sounds familiar, feel free to point me to them. Regards, Andre -- Andre Vehreschild * Email: vehre ad gmx dot de
Re: [Patch, fortran] PR59104
Hi Paul,
this looks good to me and is OK for mainline. When it has survived a
week or two, backporting at least to 14-branch (ideally before 14.2
release) would be a good thing!
Regarding the following excerpt of the testcase:
+! Commented out lines give implicit type warnings with gfortran and nagfor
+!character(len = len (d)) :: line4 (len (line3))
+character(len = len (line3)) :: line4 (len (line3))
+!character(len = size(len4, 1)) :: line5
I guess the last commented line should have referred to size(line4, 1),
right? The lexical distance of len4 and line4 can be small after
long coding...
The first commented line gives no warning here, but is simply
inconsistent with a test later on, since len (d) < len (line3).
What exactly was the issue?
***
A minor nit: while you were fixing whitespace issues in the source,
you missed an indent with spaces here:
@@ -857,12 +873,26 @@ gfc_defer_symbol_init (gfc_symbol * sym)
/* Find the first dummy arg seen after us, or the first
non-dummy arg.
This is a circular list, so don't go past the head. */
while (p != head
- && (!p->attr.dummy || p->dummy_order > sym->dummy_order))
+ && (!p->attr.dummy || decl_order (p, sym)))
{
At least on my side there is no tab...
(It is fine in a similar code later on.)
***
Finally a big thanks for the patch!
Harald
Am 13.06.24 um 23:43 schrieb Paul Richard Thomas:
Hi Both,
Thanks for the highly constructive comments. I think that I have
incorporated them fully in the attached.
OK for mainline and ...?
Paul
On Mon, 10 Jun 2024 at 08:19, Andre Vehreschild wrote:
Hi Paul,
while looking at your patch I see calls to gfc_add_init_cleanup (...,
back),
while the function signature is gfc_add_init_cleanup (..., bool front).
This
slightly confuses me. I would at least expect to see
gfc_add_init_cleanup(...,
!back) calls. Just to get the semantics right.
Then I wonder why not doing:
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)
+{
+ return (e && e->expr_type == EXPR_VARIABLE
+ && e->symtree
+ && e->symtree->n.sym == sym);
+}
Instead of the multiple if-statements?
+
+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);
This can overwrite a previous front == true, right? Is this intended?
+}
+ return front;
+ }
The rest - besides the front-back confusion - looks fine to me. Thanks for
the
patch.
Regards,
Andre
On Sun, 9 Jun 2024 07:14:39 +0100
Paul Richard Thomas 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
Re: [Patch, Fortran, 96418] Fix Test coarray_alloc_comp_4.f08 ICEs
Hi Andre, the patch looks fairly simple and obvious, so OK from my side. *** Regarding the testsuite: since you renamed one of the testcases gfortran.dg/coarray_alloc_comp_* and moved it to gfortran.dg/coarray/, I checked and noticed that there are other similar runtime tests for coarrays (while some are compile-time only tests). Do we plan to "clean" this up and move more/all related runtime tests to the coarray/ subdirectory? What is the general opinion on this? *** Thanks for the patch! Harald Am 14.06.24 um 09:22 schrieb Andre Vehreschild: Hi all, I messed up renaming of the coarray_alloc_comp-test. This is fixed in the second version of the patch. Sorry for the inconvenience. Additionally I figured that this patch also fixed PR fortran/103112. Regtests ok on x86_64 Fedora 39. Ok for mainline? Regards, Andre On Tue, 11 Jun 2024 16:12:38 +0200 Andre Vehreschild wrote: Hi all, attached patch has already been present in 2020, but lost my attention. It fixes an ICE in the testsuite. The old mails description is: attached patch fixes PR96418 where the code in the testsuite when compiled with -fcoarray=single lead to an ICE. The reason was that the coarray object was derefed as an array, but it was no array. Introducing the test for the descriptor removes the ICE. Regtests ok on x86_64-linux/Fedora 39. Ok for mainline? Regards, Andre -- Andre Vehreschild * Email: vehre ad gmx dot de -- Andre Vehreschild * Email: vehre ad gmx dot de
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
[gcc r14-10291] Fortran: fix ALLOCATE with SOURCE=, zero-length character [PR83865]
https://gcc.gnu.org/g:c3e16edcf2c8429da2cb479d8941397f4300e0c4
commit r14-10291-gc3e16edcf2c8429da2cb479d8941397f4300e0c4
Author: Harald Anlauf
Date: Mon Jun 3 22:02:06 2024 +0200
Fortran: fix ALLOCATE with SOURCE=, zero-length character [PR83865]
gcc/fortran/ChangeLog:
PR fortran/83865
* trans-stmt.cc (gfc_trans_allocate): Restrict special case for
source-expression with zero-length character to rank 0, so that
the array shape is not discarded.
gcc/testsuite/ChangeLog:
PR fortran/83865
* gfortran.dg/allocate_with_source_32.f90: New test.
(cherry picked from commit 7f21aee0d4ef95eee7d9f7f42e9a056715836648)
Diff:
---
gcc/fortran/trans-stmt.cc | 3 +-
.../gfortran.dg/allocate_with_source_32.f90| 33 ++
2 files changed, 35 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index d355009fa5e..87dd833872a 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -6449,8 +6449,9 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist
*omp_allocate)
else
gfc_add_block_to_block (, );
- /* Special case when string in expr3 is zero. */
+ /* Special case when string in expr3 is scalar and has length zero. */
if (code->expr3->ts.type == BT_CHARACTER
+ && code->expr3->rank == 0
&& integer_zerop (se.string_length))
{
gfc_init_se (, NULL);
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_32.f90
b/gcc/testsuite/gfortran.dg/allocate_with_source_32.f90
new file mode 100644
index 000..4a9bd46da4d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_32.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+!
+! PR fortran/83865
+!
+! Test ALLOCATE with SOURCE= of deferred length character, where
+! the source-expression is an array of character with length 0.
+
+program p
+ implicit none
+ character(:), allocatable :: z(:)
+ character(1) :: cc(4) = ""
+ allocate (z, source=[''])
+ if (len (z) /= 0 .or. size (z) /= 1) stop 1
+ deallocate (z)
+ allocate (z, source=['',''])
+ if (len (z) /= 0 .or. size (z) /= 2) stop 2
+ deallocate (z)
+ allocate (z, source=[ character(0) :: 'a','b','c'])
+ if (len (z) /= 0 .or. size (z) /= 3) stop 3
+ deallocate (z)
+ allocate (z, source=[ character(0) :: cc ])
+ if (len (z) /= 0 .or. size (z) /= 4) stop 4
+ deallocate (z)
+ associate (x => f())
+if (len (x) /= 0 .or. size (x) /= 1) stop 5
+if (x(1) /= '') stop 6
+ end associate
+contains
+ function f() result(z)
+character(:), allocatable :: z(:)
+allocate (z, source=[''])
+ end function f
+end
[gcc r15-1018] Fortran: fix ALLOCATE with SOURCE=, zero-length character [PR83865]
https://gcc.gnu.org/g:7f21aee0d4ef95eee7d9f7f42e9a056715836648
commit r15-1018-g7f21aee0d4ef95eee7d9f7f42e9a056715836648
Author: Harald Anlauf
Date: Mon Jun 3 22:02:06 2024 +0200
Fortran: fix ALLOCATE with SOURCE=, zero-length character [PR83865]
gcc/fortran/ChangeLog:
PR fortran/83865
* trans-stmt.cc (gfc_trans_allocate): Restrict special case for
source-expression with zero-length character to rank 0, so that
the array shape is not discarded.
gcc/testsuite/ChangeLog:
PR fortran/83865
* gfortran.dg/allocate_with_source_32.f90: New test.
Diff:
---
gcc/fortran/trans-stmt.cc | 3 +-
.../gfortran.dg/allocate_with_source_32.f90| 33 ++
2 files changed, 35 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 9b497d6bdc6..93b633e212e 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -6449,8 +6449,9 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist
*omp_allocate)
else
gfc_add_block_to_block (, );
- /* Special case when string in expr3 is zero. */
+ /* Special case when string in expr3 is scalar and has length zero. */
if (code->expr3->ts.type == BT_CHARACTER
+ && code->expr3->rank == 0
&& integer_zerop (se.string_length))
{
gfc_init_se (, NULL);
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_32.f90
b/gcc/testsuite/gfortran.dg/allocate_with_source_32.f90
new file mode 100644
index 000..4a9bd46da4d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_32.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+!
+! PR fortran/83865
+!
+! Test ALLOCATE with SOURCE= of deferred length character, where
+! the source-expression is an array of character with length 0.
+
+program p
+ implicit none
+ character(:), allocatable :: z(:)
+ character(1) :: cc(4) = ""
+ allocate (z, source=[''])
+ if (len (z) /= 0 .or. size (z) /= 1) stop 1
+ deallocate (z)
+ allocate (z, source=['',''])
+ if (len (z) /= 0 .or. size (z) /= 2) stop 2
+ deallocate (z)
+ allocate (z, source=[ character(0) :: 'a','b','c'])
+ if (len (z) /= 0 .or. size (z) /= 3) stop 3
+ deallocate (z)
+ allocate (z, source=[ character(0) :: cc ])
+ if (len (z) /= 0 .or. size (z) /= 4) stop 4
+ deallocate (z)
+ associate (x => f())
+if (len (x) /= 0 .or. size (x) /= 1) stop 5
+if (x(1) /= '') stop 6
+ end associate
+contains
+ function f() result(z)
+character(:), allocatable :: z(:)
+allocate (z, source=[''])
+ end function f
+end
[PATCH] Fortran: fix ALLOCATE with SOURCE=, zero-length character [PR83865]
Dear all,
the attached simple patch fixes an ICE for ALLOCATE with SOURCE=
of a deferred-length character array with source-expression
being an array of character with length zero. The reason was
that the array descriptor of the source-expression was discarded
in the special case of length 0.
Solution: restrict special case to rank 0.
Regtested on x86_64-pc-linux-gnu. OK for mainline?
The offending code was introduced during 7-development,
so it is technically a regression. I would therefore
like to backport after waiting for a week or two.
Thanks,
Harald
From ae5e3654d30d17584cfcfc3bbcc48cf75cb7453c Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Mon, 3 Jun 2024 22:02:06 +0200
Subject: [PATCH] Fortran: fix ALLOCATE with SOURCE=, zero-length character
[PR83865]
gcc/fortran/ChangeLog:
PR fortran/83865
* trans-stmt.cc (gfc_trans_allocate): Restrict special case for
source-expression with zero-length character to rank 0, so that
the array shape is not discarded.
gcc/testsuite/ChangeLog:
PR fortran/83865
* gfortran.dg/allocate_with_source_32.f90: New test.
---
gcc/fortran/trans-stmt.cc | 3 +-
.../gfortran.dg/allocate_with_source_32.f90 | 33 +++
2 files changed, 35 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/allocate_with_source_32.f90
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 9b497d6bdc6..93b633e212e 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -6449,8 +6449,9 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate)
else
gfc_add_block_to_block (, );
- /* Special case when string in expr3 is zero. */
+ /* Special case when string in expr3 is scalar and has length zero. */
if (code->expr3->ts.type == BT_CHARACTER
+ && code->expr3->rank == 0
&& integer_zerop (se.string_length))
{
gfc_init_se (, NULL);
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_32.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_32.f90
new file mode 100644
index 000..4a9bd46da4d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_32.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+!
+! PR fortran/83865
+!
+! Test ALLOCATE with SOURCE= of deferred length character, where
+! the source-expression is an array of character with length 0.
+
+program p
+ implicit none
+ character(:), allocatable :: z(:)
+ character(1) :: cc(4) = ""
+ allocate (z, source=[''])
+ if (len (z) /= 0 .or. size (z) /= 1) stop 1
+ deallocate (z)
+ allocate (z, source=['',''])
+ if (len (z) /= 0 .or. size (z) /= 2) stop 2
+ deallocate (z)
+ allocate (z, source=[ character(0) :: 'a','b','c'])
+ if (len (z) /= 0 .or. size (z) /= 3) stop 3
+ deallocate (z)
+ allocate (z, source=[ character(0) :: cc ])
+ if (len (z) /= 0 .or. size (z) /= 4) stop 4
+ deallocate (z)
+ associate (x => f())
+if (len (x) /= 0 .or. size (x) /= 1) stop 5
+if (x(1) /= '') stop 6
+ end associate
+contains
+ function f() result(z)
+character(:), allocatable :: z(:)
+allocate (z, source=[''])
+ end function f
+end
--
2.35.3
Re: [PATCH 03/52] fortran: Replace uses of {FLOAT, {, LONG_}DOUBLE}_TYPE_SIZE
Hi,
Am 03.06.24 um 05:00 schrieb Kewen Lin:
Joseph pointed out "floating types should have their mode,
not a poorly defined precision value" in the discussion[1],
as he and Richi suggested, the existing macros
{FLOAT,{,LONG_}DOUBLE}_TYPE_SIZE will be replaced with a
hook mode_for_floating_type. To be prepared for that, this
patch is to replace use of {FLOAT,{,LONG_}DOUBLE}_TYPE_SIZE
in fortran with TYPE_PRECISION of
{float,{,long_}double}_type_node.
[1] https://gcc.gnu.org/pipermail/gcc-patches/2024-May/651209.html
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (build_round_expr): Use TYPE_PRECISION of
long_double_type_node to replace LONG_DOUBLE_TYPE_SIZE.
* trans-types.cc (gfc_build_real_type): Use TYPE_PRECISION of
{float,double,long_double}_type_node to replace
{FLOAT,DOUBLE,LONG_DOUBLE}_TYPE_SIZE.
---
gcc/fortran/trans-intrinsic.cc | 3 ++-
gcc/fortran/trans-types.cc | 10 ++
2 files changed, 8 insertions(+), 5 deletions(-)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 912c1000e18..96839705112 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -395,7 +395,8 @@ build_round_expr (tree arg, tree restype)
don't have an appropriate function that converts directly to the integer
type (such as kind == 16), just use ROUND, and then convert the result to
an integer. We might also need to convert the result afterwards. */
- if (resprec <= INT_TYPE_SIZE && argprec <= LONG_DOUBLE_TYPE_SIZE)
+ if (resprec <= INT_TYPE_SIZE
+ && argprec <= TYPE_PRECISION (long_double_type_node))
fn = builtin_decl_for_precision (BUILT_IN_IROUND, argprec);
else if (resprec <= LONG_TYPE_SIZE)
fn = builtin_decl_for_precision (BUILT_IN_LROUND, argprec);
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 8466c595e06..0ef67723fcd 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -873,13 +873,15 @@ gfc_build_real_type (gfc_real_info *info)
int mode_precision = info->mode_precision;
tree new_type;
- if (mode_precision == FLOAT_TYPE_SIZE)
+ if (mode_precision == TYPE_PRECISION (float_type_node))
info->c_float = 1;
- if (mode_precision == DOUBLE_TYPE_SIZE)
+ if (mode_precision == TYPE_PRECISION (double_type_node))
info->c_double = 1;
- if (mode_precision == LONG_DOUBLE_TYPE_SIZE && !info->c_float128)
+ if (mode_precision == TYPE_PRECISION (long_double_type_node)
+ && !info->c_float128)
info->c_long_double = 1;
- if (mode_precision != LONG_DOUBLE_TYPE_SIZE && mode_precision == 128)
+ if (mode_precision != TYPE_PRECISION (long_double_type_node)
+ && mode_precision == 128)
{
/* TODO: see PR101835. */
info->c_float128 = 1;
the Fortran part looks good to me.
Thanks,
Harald
Re: [Patch, PR Fortran/90069] Polymorphic Return Type Memory Leak Without Intermediate Variable
Hi Andre, On 5/28/24 14:10, Andre Vehreschild wrote: Hi all, the attached patch fixes a memory leak with unlimited polymorphic return types. The leak occurred, because an expression with side-effects was evaluated twice. I have substituted the check for non-variable expressions followed by creating a SAVE_EXPR with checking for trees with side effects and creating temp. variable and freeing the memory. this looks good to me. It also solves the runtime memory leak in testcase pr114012.f90 . Nice! Btw, I do not get the SAVE_EXPR in the old code. Is there something missing to manifest it or is a SAVE_EXPR not meant to be evaluated twice? I was assuming that the comment in gcc/tree.h applies here: /* save_expr (EXP) returns an expression equivalent to EXP but it can be used multiple times within context CTX and only evaluate EXP once. */ I do not know what the practical difference between a SAVE_EXPR and a temporary explicitly evaluated once (which you have now) is, except that you can free the temporary cleanly. Anyway, regtested ok on Linux-x86_64-Fedora_39. Ok for master? Yes, this is fine from my side. If you are inclined to backport to e.g. 14-branch after a grace period, that would be great. This work is funded by the Souvereign Tech Fund. Yes, the funding has been granted and Nicolas, Mikael and me will be working on some Fortran topics in the next 12-18 months. This is really great news! Regards, Andre Thanks for the patch! Harald -- Andre Vehreschild * Email: vehre ad gmx dot de
[gcc r14-10244] Fortran: fix bounds check for assignment, class component [PR86100]
https://gcc.gnu.org/g:b0b21d5bdfbc7d417b70010a11354b44968bb184
commit r14-10244-gb0b21d5bdfbc7d417b70010a11354b44968bb184
Author: Harald Anlauf
Date: Mon May 13 22:06:33 2024 +0200
Fortran: fix bounds check for assignment, class component [PR86100]
gcc/fortran/ChangeLog:
PR fortran/86100
* trans-array.cc (gfc_conv_ss_startstride): Use abridged_ref_name
to generate a more user-friendly name for bounds-check messages.
* trans-expr.cc (gfc_copy_class_to_class): Fix bounds check for
rank>1 by looping over the dimensions.
gcc/testsuite/ChangeLog:
PR fortran/86100
* gfortran.dg/bounds_check_25.f90: New test.
(cherry picked from commit 93765736815a049e14d985b758a213cfe60c1e1c)
Diff:
---
gcc/fortran/trans-array.cc| 7 -
gcc/fortran/trans-expr.cc | 40 +++
gcc/testsuite/gfortran.dg/bounds_check_25.f90 | 32 +
3 files changed, 60 insertions(+), 19 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 7ec33fb1598..a15ff30e8f4 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -4911,6 +4911,7 @@ done:
gfc_expr *expr;
locus *expr_loc;
const char *expr_name;
+ char *ref_name = NULL;
ss_info = ss->info;
if (ss_info->type != GFC_SS_SECTION)
@@ -4922,7 +4923,10 @@ done:
expr = ss_info->expr;
expr_loc = >where;
- expr_name = expr->symtree->name;
+ if (expr->ref)
+ expr_name = ref_name = abridged_ref_name (expr, NULL);
+ else
+ expr_name = expr->symtree->name;
gfc_start_block ();
@@ -5134,6 +5138,7 @@ done:
gfc_add_expr_to_block (, tmp);
+ free (ref_name);
}
tmp = gfc_finish_block ();
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index bc8eb419cff..d5fd6e39996 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1518,7 +1518,6 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems,
bool unlimited)
stmtblock_t body;
stmtblock_t ifbody;
gfc_loopinfo loop;
- tree orig_nelems = nelems; /* Needed for bounds check. */
gfc_init_block ();
tmp = fold_build2_loc (input_location, MINUS_EXPR,
@@ -1550,27 +1549,32 @@ gfc_copy_class_to_class (tree from, tree to, tree
nelems, bool unlimited)
/* Add bounds check. */
if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) > 0 && is_from_desc)
{
- char *msg;
const char *name = "<>";
- tree from_len;
+ int dim, rank;
if (DECL_P (to))
- name = (const char *)(DECL_NAME (to)->identifier.id.str);
-
- from_len = gfc_conv_descriptor_size (from_data, 1);
- from_len = fold_convert (TREE_TYPE (orig_nelems), from_len);
- tmp = fold_build2_loc (input_location, NE_EXPR,
- logical_type_node, from_len, orig_nelems);
- msg = xasprintf ("Array bound mismatch for dimension %d "
- "of array '%s' (%%ld/%%ld)",
- 1, name);
-
- gfc_trans_runtime_check (true, false, tmp, ,
- _current_locus, msg,
-fold_convert (long_integer_type_node, orig_nelems),
- fold_convert (long_integer_type_node, from_len));
+ name = IDENTIFIER_POINTER (DECL_NAME (to));
- free (msg);
+ rank = GFC_TYPE_ARRAY_RANK (TREE_TYPE (from_data));
+ for (dim = 1; dim <= rank; dim++)
+ {
+ tree from_len, to_len, cond;
+ char *msg;
+
+ from_len = gfc_conv_descriptor_size (from_data, dim);
+ from_len = fold_convert (long_integer_type_node, from_len);
+ to_len = gfc_conv_descriptor_size (to_data, dim);
+ to_len = fold_convert (long_integer_type_node, to_len);
+ msg = xasprintf ("Array bound mismatch for dimension %d "
+ "of array '%s' (%%ld/%%ld)",
+ dim, name);
+ cond = fold_build2_loc (input_location, NE_EXPR,
+ logical_type_node, from_len, to_len);
+ gfc_trans_runtime_check (true, false, cond, ,
+ _current_locus, msg,
+ to_len, from_len);
+ free (msg);
+ }
}
tmp = build_call_vec (fcn_type, fcn, args);
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_25.f90
b/gcc/testsuite/gfortran.dg/bounds_check_25.f90
new file mode 100644
index 000..cc2247597f9
--- /dev/nu
[gcc r15-828] Fortran: improve attribute conflict checking [PR93635]
https://gcc.gnu.org/g:9561cf550a66a89e7c8d31202a03c4fddf82a3f2
commit r15-828-g9561cf550a66a89e7c8d31202a03c4fddf82a3f2
Author: Harald Anlauf
Date: Thu May 23 21:13:00 2024 +0200
Fortran: improve attribute conflict checking [PR93635]
gcc/fortran/ChangeLog:
PR fortran/93635
* symbol.cc (conflict_std): Helper function for reporting attribute
conflicts depending on the Fortran standard version.
(conf_std): Helper macro for checking standard-dependent conflicts.
(gfc_check_conflict): Use it.
gcc/testsuite/ChangeLog:
PR fortran/93635
* gfortran.dg/c-interop/c1255-2.f90: Adjust pattern.
* gfortran.dg/pr87907.f90: Likewise.
* gfortran.dg/pr93635.f90: New test.
Co-authored-by: Steven G. Kargl
Diff:
---
gcc/fortran/symbol.cc | 63 +++--
gcc/testsuite/gfortran.dg/c-interop/c1255-2.f90 | 4 +-
gcc/testsuite/gfortran.dg/pr87907.f90 | 8 ++--
gcc/testsuite/gfortran.dg/pr93635.f90 | 19
4 files changed, 54 insertions(+), 40 deletions(-)
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 0a1646def67..5db3c887127 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -407,18 +407,36 @@ gfc_check_function_type (gfc_namespace *ns)
/ Symbol attribute stuff */
+/* Older standards produced conflicts for some attributes that are allowed
+ in newer standards. Check for the conflict and issue an error depending
+ on the standard in play. */
+
+static bool
+conflict_std (int standard, const char *a1, const char *a2, const char *name,
+ locus *where)
+{
+ if (name == NULL)
+{
+ return gfc_notify_std (standard, "%s attribute conflicts "
+"with %s attribute at %L", a1, a2,
+where);
+}
+ else
+{
+ return gfc_notify_std (standard, "%s attribute conflicts "
+"with %s attribute in %qs at %L",
+a1, a2, name, where);
+}
+}
+
/* This is a generic conflict-checker. We do this to avoid having a
single conflict in two places. */
#define conf(a, b) if (attr->a && attr->b) { a1 = a; a2 = b; goto conflict; }
#define conf2(a) if (attr->a) { a2 = a; goto conflict; }
-#define conf_std(a, b, std) if (attr->a && attr->b)\
- {\
-a1 = a;\
-a2 = b;\
-standard = std;\
-goto conflict_std;\
- }
+#define conf_std(a, b, std) if (attr->a && attr->b \
+ && !conflict_std (std, a, b, name, where)) \
+ return false;
bool
gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
@@ -451,7 +469,6 @@ gfc_check_conflict (symbol_attribute *attr, const char
*name, locus *where)
"OACC DECLARE DEVICE_RESIDENT";
const char *a1, *a2;
- int standard;
if (attr->artificial)
return true;
@@ -460,20 +477,10 @@ gfc_check_conflict (symbol_attribute *attr, const char
*name, locus *where)
where = _current_locus;
if (attr->pointer && attr->intent != INTENT_UNKNOWN)
-{
- a1 = pointer;
- a2 = intent;
- standard = GFC_STD_F2003;
- goto conflict_std;
-}
+conf_std (pointer, intent, GFC_STD_F2003);
- if (attr->in_namelist && (attr->allocatable || attr->pointer))
-{
- a1 = in_namelist;
- a2 = attr->allocatable ? allocatable : pointer;
- standard = GFC_STD_F2003;
- goto conflict_std;
-}
+ conf_std (in_namelist, allocatable, GFC_STD_F2003);
+ conf_std (in_namelist, pointer, GFC_STD_F2003);
/* Check for attributes not allowed in a BLOCK DATA. */
if (gfc_current_state () == COMP_BLOCK_DATA)
@@ -922,20 +929,6 @@ conflict:
a1, a2, name, where);
return false;
-
-conflict_std:
- if (name == NULL)
-{
- return gfc_notify_std (standard, "%s attribute conflicts "
- "with %s attribute at %L", a1, a2,
- where);
-}
- else
-{
- return gfc_notify_std (standard, "%s attribute conflicts "
-"with %s attribute in %qs at %L",
- a1, a2, name, where);
-}
}
#undef conf
diff --git a/gcc/testsuite/gfortran.dg/c-interop/c1255-2.f90
b/gcc/testsuite/gfortran.dg/c-interop/c1255-2.f90
index 0e5505a0183..feed2e7645f 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/c1255-2.f90
+++ b/gcc/testsuite/gfortran.dg
[gcc r15-827] Fortran: fix bounds check for assignment, class component [PR86100]
https://gcc.gnu.org/g:93765736815a049e14d985b758a213cfe60c1e1c
commit r15-827-g93765736815a049e14d985b758a213cfe60c1e1c
Author: Harald Anlauf
Date: Mon May 13 22:06:33 2024 +0200
Fortran: fix bounds check for assignment, class component [PR86100]
gcc/fortran/ChangeLog:
PR fortran/86100
* trans-array.cc (gfc_conv_ss_startstride): Use abridged_ref_name
to generate a more user-friendly name for bounds-check messages.
* trans-expr.cc (gfc_copy_class_to_class): Fix bounds check for
rank>1 by looping over the dimensions.
gcc/testsuite/ChangeLog:
PR fortran/86100
* gfortran.dg/bounds_check_25.f90: New test.
Diff:
---
gcc/fortran/trans-array.cc| 7 -
gcc/fortran/trans-expr.cc | 40 +++
gcc/testsuite/gfortran.dg/bounds_check_25.f90 | 32 +
3 files changed, 60 insertions(+), 19 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index c5b56f4e273..eec62c296ff 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -4911,6 +4911,7 @@ done:
gfc_expr *expr;
locus *expr_loc;
const char *expr_name;
+ char *ref_name = NULL;
ss_info = ss->info;
if (ss_info->type != GFC_SS_SECTION)
@@ -4922,7 +4923,10 @@ done:
expr = ss_info->expr;
expr_loc = >where;
- expr_name = expr->symtree->name;
+ if (expr->ref)
+ expr_name = ref_name = abridged_ref_name (expr, NULL);
+ else
+ expr_name = expr->symtree->name;
gfc_start_block ();
@@ -5134,6 +5138,7 @@ done:
gfc_add_expr_to_block (, tmp);
+ free (ref_name);
}
tmp = gfc_finish_block ();
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index e315e2d3370..dfc5b8e9b4a 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1520,7 +1520,6 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems,
bool unlimited)
stmtblock_t body;
stmtblock_t ifbody;
gfc_loopinfo loop;
- tree orig_nelems = nelems; /* Needed for bounds check. */
gfc_init_block ();
tmp = fold_build2_loc (input_location, MINUS_EXPR,
@@ -1552,27 +1551,32 @@ gfc_copy_class_to_class (tree from, tree to, tree
nelems, bool unlimited)
/* Add bounds check. */
if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) > 0 && is_from_desc)
{
- char *msg;
const char *name = "<>";
- tree from_len;
+ int dim, rank;
if (DECL_P (to))
- name = (const char *)(DECL_NAME (to)->identifier.id.str);
-
- from_len = gfc_conv_descriptor_size (from_data, 1);
- from_len = fold_convert (TREE_TYPE (orig_nelems), from_len);
- tmp = fold_build2_loc (input_location, NE_EXPR,
- logical_type_node, from_len, orig_nelems);
- msg = xasprintf ("Array bound mismatch for dimension %d "
- "of array '%s' (%%ld/%%ld)",
- 1, name);
-
- gfc_trans_runtime_check (true, false, tmp, ,
- _current_locus, msg,
-fold_convert (long_integer_type_node, orig_nelems),
- fold_convert (long_integer_type_node, from_len));
+ name = IDENTIFIER_POINTER (DECL_NAME (to));
- free (msg);
+ rank = GFC_TYPE_ARRAY_RANK (TREE_TYPE (from_data));
+ for (dim = 1; dim <= rank; dim++)
+ {
+ tree from_len, to_len, cond;
+ char *msg;
+
+ from_len = gfc_conv_descriptor_size (from_data, dim);
+ from_len = fold_convert (long_integer_type_node, from_len);
+ to_len = gfc_conv_descriptor_size (to_data, dim);
+ to_len = fold_convert (long_integer_type_node, to_len);
+ msg = xasprintf ("Array bound mismatch for dimension %d "
+ "of array '%s' (%%ld/%%ld)",
+ dim, name);
+ cond = fold_build2_loc (input_location, NE_EXPR,
+ logical_type_node, from_len, to_len);
+ gfc_trans_runtime_check (true, false, cond, ,
+ _current_locus, msg,
+ to_len, from_len);
+ free (msg);
+ }
}
tmp = build_call_vec (fcn_type, fcn, args);
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_25.f90
b/gcc/testsuite/gfortran.dg/bounds_check_25.f90
new file mode 100644
index 000..cc2247597f9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_25.f90
@@ -0,0 +1,32 @@
+! { dg-do run
Re: [PATCH, v2] Fortran: improve attribute conflict checking [PR93635]
Hi Mikael, On 5/24/24 20:17, Mikael Morin wrote: Le 23/05/2024 à 21:15, Harald Anlauf a écrit : Hi Mikael, On 5/23/24 09:49, Mikael Morin wrote: Le 13/05/2024 à 09:25, Mikael Morin a écrit : Le 10/05/2024 à 21:56, Harald Anlauf a écrit : Am 10.05.24 um 21:48 schrieb Harald Anlauf: Hi Mikael, Am 10.05.24 um 11:45 schrieb Mikael Morin: Le 09/05/2024 à 22:30, Harald Anlauf a écrit : I'll stop here... Thanks. Go figure, I have no problem reproducing today. It's PR99798 (and there is even a patch for it). this patch has rotten a bit: the type of gfc_reluease_symbol has changed to bool, this can be fixed. Unfortunately, applying the patch does not remove the ICEs here... Oops, I take that back! There was an error on my side applying the patch; and now it does fix the ICEs after correcting that hickup Now the PR99798 patch is ready to be pushed, but I won't be available for a few days. We can finish our discussion on this topic afterwards. Hello, I'm coming back to this. I think either one of Steve's patch or your variant in the PR is a better fix for the ICE as a first step; they seem less fragile at least. Then we can look at a possible reordering of conflict checks as with the patch you originally submitted in this thread. like the attached variant? Yes. The churn in the testsuite is actually not that bad. OK for master, thanks for the patch. thanks, will do. I wouldn't push for backporting, but if you feel like doing it, it seems safe enough (depending on my own backport for PR99798 of course). There's no pressing need. I'll mark the patch as backportable with dependency in my own list, in case the question comes up. Regarding the conflict check reordering, I'm tempted to just drop it at this point, or do you think it remains worth it? I don't really have a showcase where this would bring a benefit now, so I'm dropping this idea. There are issues where specifying a standard version changes the error recovery path (or rather lead to an ICE), but as some of these are due to emitting an error during parsing instead of during resolution, my suggestion does not help there. If you look for an example: this one is taken from pr101281 subroutine a3pr (xn) bind(C) character(len=n), pointer :: xn(..) end vs. subroutine a3pr (xn) bind(C) character(len=n), pointer :: xn dimension :: xn(..) end The first one gives lots of invalid reads in valgrind with -std=f2008, or ICEs, while the second does not. Thanks, Harald
[PATCH, v2] Fortran: improve attribute conflict checking [PR93635]
Hi Mikael,
On 5/23/24 09:49, Mikael Morin wrote:
Le 13/05/2024 à 09:25, Mikael Morin a écrit :
Le 10/05/2024 à 21:56, Harald Anlauf a écrit :
Am 10.05.24 um 21:48 schrieb Harald Anlauf:
Hi Mikael,
Am 10.05.24 um 11:45 schrieb Mikael Morin:
Le 09/05/2024 à 22:30, Harald Anlauf a écrit :
I'll stop here...
Thanks. Go figure, I have no problem reproducing today.
It's PR99798 (and there is even a patch for it).
this patch has rotten a bit: the type of gfc_reluease_symbol
has changed to bool, this can be fixed.
Unfortunately, applying the patch does not remove the ICEs here...
Oops, I take that back! There was an error on my side applying the
patch; and now it does fix the ICEs after correcting that hickup
Now the PR99798 patch is ready to be pushed, but I won't be available
for a few days. We can finish our discussion on this topic afterwards.
Hello,
I'm coming back to this.
I think either one of Steve's patch or your variant in the PR is a
better fix for the ICE as a first step; they seem less fragile at least.
Then we can look at a possible reordering of conflict checks as with the
patch you originally submitted in this thread.
like the attached variant?
Harald
Mikael
From 68d73e6e2efa692afff10ea16eafb88236cbe69c Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Thu, 23 May 2024 21:13:00 +0200
Subject: [PATCH] Fortran: improve attribute conflict checking [PR93635]
gcc/fortran/ChangeLog:
PR fortran/93635
* symbol.cc (conflict_std): Helper function for reporting attribute
conflicts depending on the Fortran standard version.
(conf_std): Helper macro for checking standard-dependent conflicts.
(gfc_check_conflict): Use it.
gcc/testsuite/ChangeLog:
PR fortran/93635
* gfortran.dg/c-interop/c1255-2.f90: Adjust pattern.
* gfortran.dg/pr87907.f90: Likewise.
* gfortran.dg/pr93635.f90: New test.
Co-authored-by: Steven G. Kargl
---
gcc/fortran/symbol.cc | 63 +--
.../gfortran.dg/c-interop/c1255-2.f90 | 4 +-
gcc/testsuite/gfortran.dg/pr87907.f90 | 8 ++-
gcc/testsuite/gfortran.dg/pr93635.f90 | 19 ++
4 files changed, 54 insertions(+), 40 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/pr93635.f90
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 0a1646def67..5db3c887127 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -407,18 +407,36 @@ gfc_check_function_type (gfc_namespace *ns)
/ Symbol attribute stuff */
+/* Older standards produced conflicts for some attributes that are allowed
+ in newer standards. Check for the conflict and issue an error depending
+ on the standard in play. */
+
+static bool
+conflict_std (int standard, const char *a1, const char *a2, const char *name,
+ locus *where)
+{
+ if (name == NULL)
+{
+ return gfc_notify_std (standard, "%s attribute conflicts "
+ "with %s attribute at %L", a1, a2,
+ where);
+}
+ else
+{
+ return gfc_notify_std (standard, "%s attribute conflicts "
+ "with %s attribute in %qs at %L",
+ a1, a2, name, where);
+}
+}
+
/* This is a generic conflict-checker. We do this to avoid having a
single conflict in two places. */
#define conf(a, b) if (attr->a && attr->b) { a1 = a; a2 = b; goto conflict; }
#define conf2(a) if (attr->a) { a2 = a; goto conflict; }
-#define conf_std(a, b, std) if (attr->a && attr->b)\
- {\
-a1 = a;\
-a2 = b;\
-standard = std;\
-goto conflict_std;\
- }
+#define conf_std(a, b, std) if (attr->a && attr->b \
+&& !conflict_std (std, a, b, name, where)) \
+return false;
bool
gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
@@ -451,7 +469,6 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
"OACC DECLARE DEVICE_RESIDENT";
const char *a1, *a2;
- int standard;
if (attr->artificial)
return true;
@@ -460,20 +477,10 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
where = _current_locus;
if (attr->pointer && attr->intent != INTENT_UNKNOWN)
-{
- a1 = pointer;
- a2 = intent;
- standard = GFC_STD_F2003;
- goto conflict_std;
-}
+conf_std (pointer, intent, GFC_STD_F2003);
- if (attr->in_namelist && (attr->allocatable || attr->pointer))
-{
- a1 = in_namelist;
- a2 = attr->allocatable ? allocatable : pointer;
- standard = GFC_STD_F2003;
- goto conflict_std;
-}
+ conf_std (in_namelist, allocatable, GFC_STD_F2003);
+ conf_std (in_namelist, pointer, GFC_STD_F2003);
/* Check fo
[gcc r13-8794] Fortran: fix issues with class(*) assignment [PR114827]
https://gcc.gnu.org/g:f0b88ec4ae829798cb533618f781ca467bab6b9b
commit r13-8794-gf0b88ec4ae829798cb533618f781ca467bab6b9b
Author: Harald Anlauf
Date: Mon Apr 29 19:52:52 2024 +0200
Fortran: fix issues with class(*) assignment [PR114827]
gcc/fortran/ChangeLog:
PR fortran/114827
* trans-array.cc (gfc_alloc_allocatable_for_assignment): Take into
account _len of unlimited polymorphic entities when calculating
the effective element size for allocation size and array span.
Set _len of lhs to _len of rhs.
* trans-expr.cc (trans_class_assignment): Take into account _len
of unlimited polymorphic entities for allocation size.
gcc/testsuite/ChangeLog:
PR fortran/114827
* gfortran.dg/asan/unlimited_polymorphic_34.f90: New test.
(cherry picked from commit 21e7aa5f3ea44ca2fef8deb8788edffc04901b5c)
Diff:
---
gcc/fortran/trans-array.cc | 16 +++
gcc/fortran/trans-expr.cc | 13 ++
.../gfortran.dg/asan/unlimited_polymorphic_34.f90 | 135 +
3 files changed, 164 insertions(+)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 5eef4b4ec87..f38e872f5d9 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -11008,6 +11008,19 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
gfc_add_modify (, linfo->delta[dim], tmp);
}
+ /* Take into account _len of unlimited polymorphic entities, so that span
+ for array descriptors and allocation sizes are computed correctly. */
+ if (UNLIMITED_POLY (expr2))
+{
+ tree len = gfc_class_len_get (TREE_OPERAND (desc2, 0));
+ len = fold_build2_loc (input_location, MAX_EXPR, size_type_node,
+fold_convert (size_type_node, len),
+size_one_node);
+ elemsize2 = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, elemsize2,
+ fold_convert (gfc_array_index_type, len));
+}
+
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
gfc_conv_descriptor_span_set (, desc, elemsize2);
@@ -11054,6 +11067,9 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
gfc_add_modify (, tmp,
fold_convert (TREE_TYPE (tmp),
TYPE_SIZE_UNIT (type)));
+ else if (UNLIMITED_POLY (expr2))
+ gfc_add_modify (, tmp,
+ gfc_class_len_get (TREE_OPERAND (desc2, 0)));
else
gfc_add_modify (, tmp,
build_int_cst (TREE_TYPE (tmp), 0));
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 2b2dceb8d0f..5946aa81391 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11668,6 +11668,19 @@ trans_class_assignment (stmtblock_t *block, gfc_expr
*lhs, gfc_expr *rhs,
old_vptr = build_int_cst (TREE_TYPE (vptr), 0);
size = gfc_vptr_size_get (rhs_vptr);
+
+ /* Take into account _len of unlimited polymorphic entities.
+TODO: handle class(*) allocatable function results on rhs. */
+ if (UNLIMITED_POLY (rhs) && rhs->expr_type == EXPR_VARIABLE)
+ {
+ tree len = trans_get_upoly_len (block, rhs);
+ len = fold_build2_loc (input_location, MAX_EXPR, size_type_node,
+fold_convert (size_type_node, len),
+size_one_node);
+ size = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (size),
+ size, fold_convert (TREE_TYPE (size), len));
+ }
+
tmp = lse->expr;
class_han = GFC_CLASS_TYPE_P (TREE_TYPE (tmp))
? gfc_class_data_get (tmp) : tmp;
diff --git a/gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90
b/gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90
new file mode 100644
index 000..c69158a1b55
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90
@@ -0,0 +1,135 @@
+! { dg-do run }
+! PR fortran/114827 - issues with class(*) assignment found by valgrind
+!
+! Contributed by Neil Carlson
+
+program main
+ implicit none
+ call run
+ call run1
+ call run2
+contains
+ ! Scalar tests
+ subroutine run ()
+character(*),parameter :: c = 'fubarfubarfubarfubarfubarfu'
+character(*,kind=4), parameter :: d = 4_"abcdef"
+complex, parameter :: z = (1.,2.)
+class(*), allocatable :: y
+
+call foo (c, y)
+select type (y)
+type is (character(*))
+! print *, y(5:6) ! ICE (-> pr114874)
+ if (y /= c) stop 1
+class default
+ stop 2
+end select
+
+call foo (z, y)
+select type (y)
+type is (complex)
+ if (y /
[gcc r13-8793] Fortran: fix reallocation on assignment of polymorphic variables [PR110415]
https://gcc.gnu.org/g:2ebf3af1f84d54fbda172eff105a8842c685d11d
commit r13-8793-g2ebf3af1f84d54fbda172eff105a8842c685d11d
Author: Andrew Jenner
Date: Tue Nov 28 15:27:05 2023 +
Fortran: fix reallocation on assignment of polymorphic variables [PR110415]
This patch fixes two bugs related to polymorphic class assignment in the
Fortran front-end. One (described in PR110415) is an issue with the malloc
and realloc calls using the size from the old vptr rather than the new one.
The other is caused by the return value from the realloc call being ignored.
Testcases are added for these issues.
2023-11-28 Andrew Jenner
gcc/fortran/
PR fortran/110415
* trans-expr.cc (trans_class_vptr_len_assignment): Add
from_vptrp parameter. Populate it. Don't check for DECL_P
when deciding whether to create temporary.
(trans_class_pointer_fcn, gfc_trans_pointer_assignment): Add
NULL argument to trans_class_vptr_len_assignment calls.
(trans_class_assignment): Get rhs_vptr from
trans_class_vptr_len_assignment and use it for determining size
for allocation/reallocation. Use return value from realloc.
gcc/testsuite/
PR fortran/110415
* gfortran.dg/pr110415.f90: New test.
* gfortran.dg/asan/pr110415-2.f90: New test.
* gfortran.dg/asan/pr110415-3.f90: New test.
Co-Authored-By: Tobias Burnus
(cherry picked from commit b247e917ff13328298c1eecf8563b12edd7ade04)
Diff:
---
gcc/fortran/trans-expr.cc | 39 +
gcc/testsuite/gfortran.dg/asan/pr110415-2.f90 | 45
gcc/testsuite/gfortran.dg/asan/pr110415-3.f90 | 49 +++
gcc/testsuite/gfortran.dg/pr110415.f90| 20 +++
4 files changed, 139 insertions(+), 14 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index cfe03252582..2b2dceb8d0f 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -9748,7 +9748,8 @@ trans_get_upoly_len (stmtblock_t *block, gfc_expr *expr)
static tree
trans_class_vptr_len_assignment (stmtblock_t *block, gfc_expr * le,
gfc_expr * re, gfc_se *rse,
-tree * to_lenp, tree * from_lenp)
+tree * to_lenp, tree * from_lenp,
+tree * from_vptrp)
{
gfc_se se;
gfc_expr * vptr_expr;
@@ -9756,10 +9757,11 @@ trans_class_vptr_len_assignment (stmtblock_t *block,
gfc_expr * le,
bool set_vptr = false, temp_rhs = false;
stmtblock_t *pre = block;
tree class_expr = NULL_TREE;
+ tree from_vptr = NULL_TREE;
/* Create a temporary for complicated expressions. */
if (re->expr_type != EXPR_VARIABLE && re->expr_type != EXPR_NULL
- && rse->expr != NULL_TREE && !DECL_P (rse->expr))
+ && rse->expr != NULL_TREE)
{
if (re->ts.type == BT_CLASS && !GFC_CLASS_TYPE_P (TREE_TYPE (rse->expr)))
class_expr = gfc_get_class_from_expr (rse->expr);
@@ -9856,6 +9858,7 @@ trans_class_vptr_len_assignment (stmtblock_t *block,
gfc_expr * le,
tmp = rse->expr;
se.expr = gfc_class_vptr_get (tmp);
+ from_vptr = se.expr;
if (UNLIMITED_POLY (re))
from_len = gfc_class_len_get (tmp);
@@ -9877,6 +9880,7 @@ trans_class_vptr_len_assignment (stmtblock_t *block,
gfc_expr * le,
gfc_free_expr (vptr_expr);
gfc_add_block_to_block (block, );
gcc_assert (se.post.head == NULL_TREE);
+ from_vptr = se.expr;
}
gfc_add_modify (pre, lhs_vptr, fold_convert (TREE_TYPE (lhs_vptr),
se.expr));
@@ -9905,11 +9909,13 @@ trans_class_vptr_len_assignment (stmtblock_t *block,
gfc_expr * le,
}
}
- /* Return the _len trees only, when requested. */
+ /* Return the _len and _vptr trees only, when requested. */
if (to_lenp)
*to_lenp = to_len;
if (from_lenp)
*from_lenp = from_len;
+ if (from_vptrp)
+*from_vptrp = from_vptr;
return lhs_vptr;
}
@@ -9978,7 +9984,7 @@ trans_class_pointer_fcn (stmtblock_t *block, gfc_se *lse,
gfc_se *rse,
{
expr1_vptr = trans_class_vptr_len_assignment (block, expr1,
expr2, rse,
- NULL, NULL);
+ NULL, NULL, NULL);
gfc_add_block_to_block (block, >pre);
tmp = gfc_create_var (TREE_TYPE (rse->expr), "ptrtemp");
gfc_add_modify (>pre, tmp, rse->expr);
@@ -10054,7 +10060,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1,
gfc_expr * expr2)
if (non_proc_ptr_assign && expr1->ts.type == BT_CLASS)
{
trans_class_vptr_len_assignment (, expr1, expr2, ,
[gcc r13-8786] Fortran: fix dependency checks for inquiry refs [PR115039]
https://gcc.gnu.org/g:5ed32d00a7b408baa48d85e841740e73c8504d7a
commit r13-8786-g5ed32d00a7b408baa48d85e841740e73c8504d7a
Author: Harald Anlauf
Date: Fri May 10 21:18:03 2024 +0200
Fortran: fix dependency checks for inquiry refs [PR115039]
gcc/fortran/ChangeLog:
PR fortran/115039
* expr.cc (gfc_traverse_expr): An inquiry ref does not constitute
a dependency and cannot collide with a symbol.
gcc/testsuite/ChangeLog:
PR fortran/115039
* gfortran.dg/statement_function_5.f90: New test.
(cherry picked from commit d4974fd22730014e337fd7ec2471945ba8afb00e)
Diff:
---
gcc/fortran/expr.cc| 2 +-
gcc/testsuite/gfortran.dg/statement_function_5.f90 | 20
2 files changed, 21 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index a6c4dccb125..4a9b29c7e9d 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -5483,7 +5483,7 @@ gfc_traverse_expr (gfc_expr *expr, gfc_symbol *sym,
break;
case REF_INQUIRY:
- return true;
+ return false;
default:
gcc_unreachable ();
diff --git a/gcc/testsuite/gfortran.dg/statement_function_5.f90
b/gcc/testsuite/gfortran.dg/statement_function_5.f90
new file mode 100644
index 000..bc5a5dba7a0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/statement_function_5.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! PR fortran/115039
+!
+! Check that inquiry refs work with statement functions
+!
+! { dg-additional-options "-std=legacy -fdump-tree-optimized" }
+! { dg-prune-output " Obsolescent feature" }
+! { dg-final { scan-tree-dump-not "_gfortran_stop_numeric" "optimized" } }
+
+program testit
+ implicit none
+ complex :: x
+ real:: im
+ integer :: slen
+ character(5) :: s
+ im(x) = x%im + x%re + x%kind
+ slen(s) = s%len
+ if (im((1.0,3.0) + (2.0,4.0)) /= 14.) stop 1
+ if (slen('abcdef') /= 5) stop 2
+end program testit
[gcc r14-10225] Fortran: fix dependency checks for inquiry refs [PR115039]
https://gcc.gnu.org/g:edde60a53c7d4ee5a58c9835c8e1e1758ba636f7
commit r14-10225-gedde60a53c7d4ee5a58c9835c8e1e1758ba636f7
Author: Harald Anlauf
Date: Fri May 10 21:18:03 2024 +0200
Fortran: fix dependency checks for inquiry refs [PR115039]
gcc/fortran/ChangeLog:
PR fortran/115039
* expr.cc (gfc_traverse_expr): An inquiry ref does not constitute
a dependency and cannot collide with a symbol.
gcc/testsuite/ChangeLog:
PR fortran/115039
* gfortran.dg/statement_function_5.f90: New test.
(cherry picked from commit d4974fd22730014e337fd7ec2471945ba8afb00e)
Diff:
---
gcc/fortran/expr.cc| 2 +-
gcc/testsuite/gfortran.dg/statement_function_5.f90 | 20
2 files changed, 21 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 09d1ebd95d2..50e32a7a3b7 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -5491,7 +5491,7 @@ gfc_traverse_expr (gfc_expr *expr, gfc_symbol *sym,
break;
case REF_INQUIRY:
- return true;
+ return false;
default:
gcc_unreachable ();
diff --git a/gcc/testsuite/gfortran.dg/statement_function_5.f90
b/gcc/testsuite/gfortran.dg/statement_function_5.f90
new file mode 100644
index 000..bc5a5dba7a0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/statement_function_5.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! PR fortran/115039
+!
+! Check that inquiry refs work with statement functions
+!
+! { dg-additional-options "-std=legacy -fdump-tree-optimized" }
+! { dg-prune-output " Obsolescent feature" }
+! { dg-final { scan-tree-dump-not "_gfortran_stop_numeric" "optimized" } }
+
+program testit
+ implicit none
+ complex :: x
+ real:: im
+ integer :: slen
+ character(5) :: s
+ im(x) = x%im + x%re + x%kind
+ slen(s) = s%len
+ if (im((1.0,3.0) + (2.0,4.0)) /= 14.) stop 1
+ if (slen('abcdef') /= 5) stop 2
+end program testit
Re: [Patch, fortran] PR103312 - [11/12/13/14/15 Regression] ICE in gfc_find_component since r9-1098-g3cf89a7b992d483e
Hi Paul,
Am 20.05.24 um 11:06 schrieb Paul Richard Thomas:
Hi All,
I don't think that this PR is really a regression although the fact that it
is marked as such brought it to my attention :-)
The fix turned out to be remarkably simple. It was found after going down a
silly number of rabbit holes, though!
The chunk in dependency.cc is probably more elaborate than it needs to be.
Returning -2 is sufficient for the testcase to work. Otherwise, the
comments in the patch say it all.
this part looks OK, but can you elaborate on this change to expr.cc:
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index c883966646c..4ee2ad55915 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -3210,6 +3210,11 @@ gfc_reduce_init_expr (gfc_expr *expr)
{
bool t;
+ /* It is far too early to resolve a class compcall. Punt to
resolution. */
+ if (expr && expr->expr_type == EXPR_COMPCALL
+ && expr->symtree->n.sym->ts.type == BT_CLASS)
+return true;
+
I would have expected to return 'false' here, as we do not
have an expression that reduces to a constant. What am I
missing?
(The testcase compiles and works here also when using 'false'.)
OK for mainline? I will delay for a month before backporting.
OK if can you show me wrong...
Thanks,
Harald
Regards
Paul
[PING] [PATCH] Fortran: fix bounds check for assignment, class component [PR86100]
Am 13.05.24 um 22:27 schrieb Harald Anlauf: Dear all, the attached patch does two things: - it fixes a bogus array bounds check when deep-copying a class component of a derived type and the class component has rank > 1, the reason being that the previous code compared the full size of one side with the size of the first dimension of the other - the bounds-check error message that was generated e.g. by an allocate statement with conflicting sizes in the allocation and the source-expr will now use an improved abbreviated name pointing to the component involved, which was introduced in 14-development. What I could not resolve: a deep copy may still create no useful array name in the error message (which I am now unable to trigger). If someone sees how to extract it reliably from the tree, please let me know. Regtested on x86_64-pc-linux-gnu. OK for mainline? I would like to backport this to 14-branch after a decent delay. Thanks, Harald
Re: [Patch, fortran] PR114874 - [14/15 Regression] ICE with select type, type is (character(*)), and substring
Hi Paul!
Am 15.05.24 um 19:07 schrieb Paul Richard Thomas:
Hi All,
I have been around several circuits with a patch for this regression. I
posted one in Bugzilla but rejected it because it was not direct enough.
This one, however, is more to my liking and fixes another bug lurking in
the shadows.
The way in which select type has been implemented is a bit weird in that
the select type temporaries don't get their assoc set until resolution.
Therefore, if the selector is of inferred type, the namespace is tagged by
setting 'assoc_name_inferred'. This narrows down the range of select type
temporaries that are picked out by the chunk in primary.cc, thereby fixing
the problem.
I think that is a most reasonable approach. I like it!
What I find hard to read is the logic in match.cc that sets
gfc_current_ns->assoc_name_inferred. I wonder if reordering the
outer if-conditions and adding a comment might be a good thing:
@@ -6721,6 +6721,20 @@ gfc_match_select_type (void)
goto cleanup;
}
+ if (expr2 && expr2->expr_type == EXPR_VARIABLE
+ && expr2->symtree->n.sym->assoc)
+{
+ if (expr2->symtree->n.sym->assoc->inferred_type)
+ gfc_current_ns->assoc_name_inferred = 1;
+ else if (expr2->symtree->n.sym->assoc->target
+ && expr2->symtree->n.sym->assoc->target->ts.type ==
BT_UNKNOWN)
+ gfc_current_ns->assoc_name_inferred = 1;
+}
+ else if (!expr2
+ && expr1->symtree->n.sym->assoc
+ && expr1->symtree->n.sym->assoc->inferred_type)
+gfc_current_ns->assoc_name_inferred = 1;
As the second part refers to the case there is only a selector
and no associate-name, i.e. the simple case, have it first?
Otherwise it looks very good.
The chunks in resolve.cc fix a problem found on the way, where invalid
array references, either cause an ICE or were silently absorbed.
OK for mainline and 14-branch?
Yes.
Thanks for the patch!
Harald
Paul
Fortran: Fix select type regression due to r14-9489 [PR114874]
2024-05-15 Paul Thomas
gcc/fortran
PR fortran/114874
* gfortran.h: Add 'assoc_name_inferred' to gfc_namespace.
* match.cc (gfc_match_select_type) : Set 'assoc_name_inferred'
in select type namespace if the selector has inferred type.
* primary.cc (gfc_match_varspec): If a select type temporary
is apparently scalar and '(' has been detected, check to see if
the current name space has 'assoc_name_inferred' set. If so,
set inferred_type.
* resolve.cc (resolve_variable): If the namespace of a select
type temporary is marked with 'assoc_name_inferred' call
gfc_fixup_inferred_type_refs to ensure references are OK.
(gfc_fixup_inferred_type_refs): Catch invalid array refs..
gcc/testsuite/
PR fortran/114874
* gfortran.dg/pr114874_1.f90: New test for valid code.
* gfortran.dg/pr114874_2.f90: New test for invalid code.
[PATCH] Fortran: fix bounds check for assignment, class component [PR86100]
Dear all,
the attached patch does two things:
- it fixes a bogus array bounds check when deep-copying a class component
of a derived type and the class component has rank > 1, the reason being
that the previous code compared the full size of one side with the size
of the first dimension of the other
- the bounds-check error message that was generated e.g. by an allocate
statement with conflicting sizes in the allocation and the source-expr
will now use an improved abbreviated name pointing to the component
involved, which was introduced in 14-development.
What I could not resolve: a deep copy may still create no useful array
name in the error message (which I am now unable to trigger). If someone
sees how to extract it reliably from the tree, please let me know.
Regtested on x86_64-pc-linux-gnu. OK for mainline?
I would like to backport this to 14-branch after a decent delay.
Thanks,
Harald
From e187285dfd83da2f69cfd50854c701744dc8acc5 Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Mon, 13 May 2024 22:06:33 +0200
Subject: [PATCH] Fortran: fix bounds check for assignment, class component
[PR86100]
gcc/fortran/ChangeLog:
PR fortran/86100
* trans-array.cc (gfc_conv_ss_startstride): Use abridged_ref_name
to generate a more user-friendly name for bounds-check messages.
* trans-expr.cc (gfc_copy_class_to_class): Fix bounds check for
rank>1 by looping over the dimensions.
gcc/testsuite/ChangeLog:
PR fortran/86100
* gfortran.dg/bounds_check_25.f90: New test.
---
gcc/fortran/trans-array.cc| 7 +++-
gcc/fortran/trans-expr.cc | 40 ++-
gcc/testsuite/gfortran.dg/bounds_check_25.f90 | 32 +++
3 files changed, 60 insertions(+), 19 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/bounds_check_25.f90
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index c5b56f4e273..eec62c296ff 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -4911,6 +4911,7 @@ done:
gfc_expr *expr;
locus *expr_loc;
const char *expr_name;
+ char *ref_name = NULL;
ss_info = ss->info;
if (ss_info->type != GFC_SS_SECTION)
@@ -4922,7 +4923,10 @@ done:
expr = ss_info->expr;
expr_loc = >where;
- expr_name = expr->symtree->name;
+ if (expr->ref)
+ expr_name = ref_name = abridged_ref_name (expr, NULL);
+ else
+ expr_name = expr->symtree->name;
gfc_start_block ();
@@ -5134,6 +5138,7 @@ done:
gfc_add_expr_to_block (, tmp);
+ free (ref_name);
}
tmp = gfc_finish_block ();
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index e315e2d3370..dfc5b8e9b4a 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1520,7 +1520,6 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
stmtblock_t body;
stmtblock_t ifbody;
gfc_loopinfo loop;
- tree orig_nelems = nelems; /* Needed for bounds check. */
gfc_init_block ();
tmp = fold_build2_loc (input_location, MINUS_EXPR,
@@ -1552,27 +1551,32 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
/* Add bounds check. */
if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) > 0 && is_from_desc)
{
- char *msg;
const char *name = "<>";
- tree from_len;
+ int dim, rank;
if (DECL_P (to))
- name = (const char *)(DECL_NAME (to)->identifier.id.str);
-
- from_len = gfc_conv_descriptor_size (from_data, 1);
- from_len = fold_convert (TREE_TYPE (orig_nelems), from_len);
- tmp = fold_build2_loc (input_location, NE_EXPR,
- logical_type_node, from_len, orig_nelems);
- msg = xasprintf ("Array bound mismatch for dimension %d "
- "of array '%s' (%%ld/%%ld)",
- 1, name);
-
- gfc_trans_runtime_check (true, false, tmp, ,
- _current_locus, msg,
- fold_convert (long_integer_type_node, orig_nelems),
- fold_convert (long_integer_type_node, from_len));
+ name = IDENTIFIER_POINTER (DECL_NAME (to));
- free (msg);
+ rank = GFC_TYPE_ARRAY_RANK (TREE_TYPE (from_data));
+ for (dim = 1; dim <= rank; dim++)
+ {
+ tree from_len, to_len, cond;
+ char *msg;
+
+ from_len = gfc_conv_descriptor_size (from_data, dim);
+ from_len = fold_convert (long_integer_type_node, from_len);
+ to_len = gfc_conv_descriptor_size (to_data, dim);
+ to_len = fold_convert (long_integer_type_node, to_len);
+ msg = xasprintf ("Array bound mismatch for dimension %d "
+ "of array '%s' (%%ld/%%ld)",
+ dim, name);
+ cond = fold_build2_loc (input_location, NE_EXPR,
+ logical_type_node, from_len, to_len);
+ gfc_trans_runtime_check (true, false, cond, ,
+ _current_locus, msg,
+ to_len, from_len);
+ free (msg);
+ }
}
tmp = bu
Re: [Patch, fortran] PR113363 - ICE on ASSOCIATE and unlimited polymorphic function
Hi Paul, this looks all good now, and is OK for mainline as well as backporting! *** While playing with the testcase, I found 3 remaining smaller issues that are pre-existing, so they should not delay your present work. To make it clear: these are not regressions. When "maliciously" perturbing the testcase by adding parentheses in the right places, I see the following: Replacing associate (var => foo ()) ! OK after r14-9489-g3fd46d859cda10 by associate (var => (foo ())) gives an ICE here with 14-branch and 15-mainline. Similarly replacing allocate (y, source = x(1)) ! Gave zero length here by allocate (y, source = (x(1))) Furthermore, replacing allocate(x, source = foo ()) by allocate(x, source = (foo ())) gives a runtime segfault with both 14-branch and 15-mainline. So this is something for another day... Thanks for the patch! Harald Am 12.05.24 um 13:27 schrieb Paul Richard Thomas: Hi Harald, Please find attached my resubmission for pr113363. The changes are as follows: (i) The chunk in gfc_conv_procedure_call is new. This was the source of one of the memory leaks; (ii) The incorporation of the _len field in trans_class_assignment was done for the pr84006 patch; (iii) The source of all the invalid memory accesses and so on was down to the use of realloc. I tried all sorts of workarounds such as testing the vptrs and the sizes but only free followed by malloc worked. I have no idea at all why this is the case; and (iv) I took account of your remarks about the chunk in trans-array.cc by removing it and that the chunk in trans-stmt.cc would leak frontend memory. OK for mainline (and -14 branch after a few-weeks)? Regards Paul Fortran: Fix wrong code in unlimited polymorphic assignment [PR113363] 2024-05-12 Paul Thomas gcc/fortran PR fortran/113363 * trans-array.cc (gfc_array_init_size): Use the expr3 dtype so that the correct element size is used. * trans-expr.cc (gfc_conv_procedure_call): Remove restriction that ss and ss->loop be present for the finalization of class array function results. (trans_class_assignment): Use free and malloc, rather than realloc, for character expressions assigned to unlimited poly entities. * trans-stmt.cc (gfc_trans_allocate): Build a correct rhs for the assignment of an unlimited polymorphic 'source'. gcc/testsuite/ PR fortran/113363 * gfortran.dg/pr113363.f90: New test. The first chunk in trans-array.cc ensures that the array dtype is set to the source dtype. The second chunk ensures that the lhs _len field does not default to zero and so is specific to dynamic types of character. Why the two gfc_copy_ref? valgrind pointed my to the tail of gfc_copy_ref which already has: dest->next = gfc_copy_ref (src->next); so this looks redundant and leaks frontend memory? *** Playing with the testcase, I find several invalid writes with valgrind, or a heap buffer overflow with -fsanitize=address .
[PATCH, committed] Fortran: fix frontend memleak
Dear all, the attached obvious patch fixes a frontend memleak that was introduced recently, and which shows up when checking for inquiry references. I came across it when working on pr115039. Committed after regtesting as r15-391-g13b6ac4ebd04f0. Thanks, Harald From 13b6ac4ebd04f0703d92828c9268b0b216890b0d Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Sun, 12 May 2024 21:48:03 +0200 Subject: [PATCH] Fortran: fix frontend memleak gcc/fortran/ChangeLog: * primary.cc (gfc_match_varspec): Replace 'ref' argument to is_inquiry_ref() by NULL when the result is not needed to avoid a memleak. --- gcc/fortran/primary.cc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc index 606e84432be..8e7833769a8 100644 --- a/gcc/fortran/primary.cc +++ b/gcc/fortran/primary.cc @@ -2250,7 +2250,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, can be found. If this was an inquiry reference with the same name as a derived component and the associate-name type is not derived or class, this is fixed up in 'gfc_fixup_inferred_type_refs'. */ - if (mm == MATCH_YES && is_inquiry_ref (name, ) + if (mm == MATCH_YES && is_inquiry_ref (name, NULL) && !(sym->ts.type == BT_UNKNOWN && gfc_find_derived_types (sym, gfc_current_ns, name))) inquiry = true; -- 2.35.3
[gcc r15-391] Fortran: fix frontend memleak
https://gcc.gnu.org/g:13b6ac4ebd04f0703d92828c9268b0b216890b0d commit r15-391-g13b6ac4ebd04f0703d92828c9268b0b216890b0d Author: Harald Anlauf Date: Sun May 12 21:48:03 2024 +0200 Fortran: fix frontend memleak gcc/fortran/ChangeLog: * primary.cc (gfc_match_varspec): Replace 'ref' argument to is_inquiry_ref() by NULL when the result is not needed to avoid a memleak. Diff: --- gcc/fortran/primary.cc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc index 606e84432be6..8e7833769a8f 100644 --- a/gcc/fortran/primary.cc +++ b/gcc/fortran/primary.cc @@ -2250,7 +2250,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, can be found. If this was an inquiry reference with the same name as a derived component and the associate-name type is not derived or class, this is fixed up in 'gfc_fixup_inferred_type_refs'. */ - if (mm == MATCH_YES && is_inquiry_ref (name, ) + if (mm == MATCH_YES && is_inquiry_ref (name, NULL) && !(sym->ts.type == BT_UNKNOWN && gfc_find_derived_types (sym, gfc_current_ns, name))) inquiry = true;
Re: [Patch, fortran] PR84006 [11/12/13/14/15 Regression] ICE in storage_size() with CLASS entity
Hi Paul, Am 11.05.24 um 08:20 schrieb Paul Richard Thomas: Hi Harald, Thanks for the review. The attached resubmission fixes all the invalid accesses, memory leaks and puts right the incorrect result. In the course of fixing the fix, I found that deferred character length MOLDs gave an ICE because reallocation on assign was using 'dest_word_len' before it was defined. This is fixed by not fixing 'dest_word_len' for these MOLDs. Unfortunately, the same did not work for unlimited polymorphic MOLD expressions and so I added a TODO error in iresolve.cc since it results in all manner of memory errors in runtime. I will return to this another day. A resubmission of the patch for PR113363 will follow since it depends on this one to fix all the memory problems. OK for mainline? this is OK from my side. One minor nit: the updated testcase transfer_class_4.f90 has if (sz /= storage_size (real32)/8) stop 1 I think you meant either storage_size (r) or storage_size (1._real32) instead of checking the storage size of the integer real32 here... Thanks for the patch! Harald Regards Paul On Thu, 9 May 2024 at 08:52, Paul Richard Thomas < paul.richard.tho...@gmail.com> wrote: Hi Harald, The Linaro people caught that as well. Thanks. Interestingly, I was about to re-submit the patch for PR113363, in which all the invalid accesses and memory leaks are fixed but requires this patch to do so. The final transfer was thrown in because it seemed to be working out of the box but should be checked anyway. Inserting your print statements, my test shows the difference in size(chr_a) but prints chr_a as "abcdefgjj" no matter what I do. Needless to say, the latter was the only check that I did. The problem, I suspect, lies somewhere in the murky depths of trans-array.cc(gfc_alloc_allocatable_for_assignment) or in the array part of intrinsic_transfer, untouched by either patch, and is present in 13- and 14-branches. I am onto it. Cheers Paul On Wed, 8 May 2024 at 22:06, Harald Anlauf wrote: Hi Paul, this looks mostly good, but the new testcase transfer_class_4.f90 does exhibit a problem with your patch. Run it with valgrind, or with -fcheck=bounds, or with -fsanitize=address, or add the following around the final transfer: print *, storage_size (star_a), storage_size (chr_a), size (chr_a), len (chr_a) chr_a = transfer (star_a, chr_a) print *, storage_size (star_a), storage_size (chr_a), size (chr_a), len (chr_a) print *, ">", chr_a, "<" This prints for me: 40 40 2 5$ 40 40 4 5$ >abcdefghij^@^@^@^@^@^@^@^@^@^@<$ So since the physical representation of chr_a is sufficient to hold star_a (F2023:16.9.212), no reallocation with a wrong calculated size should happen. (Intel and NAG get this right.) Can you check again? Thanks, Harald
[gcc r15-385] Fortran: fix dependency checks for inquiry refs [PR115039]
https://gcc.gnu.org/g:d4974fd22730014e337fd7ec2471945ba8afb00e
commit r15-385-gd4974fd22730014e337fd7ec2471945ba8afb00e
Author: Harald Anlauf
Date: Fri May 10 21:18:03 2024 +0200
Fortran: fix dependency checks for inquiry refs [PR115039]
gcc/fortran/ChangeLog:
PR fortran/115039
* expr.cc (gfc_traverse_expr): An inquiry ref does not constitute
a dependency and cannot collide with a symbol.
gcc/testsuite/ChangeLog:
PR fortran/115039
* gfortran.dg/statement_function_5.f90: New test.
Diff:
---
gcc/fortran/expr.cc| 2 +-
gcc/testsuite/gfortran.dg/statement_function_5.f90 | 20
2 files changed, 21 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 66edad58278a..c883966646cb 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -5500,7 +5500,7 @@ gfc_traverse_expr (gfc_expr *expr, gfc_symbol *sym,
break;
case REF_INQUIRY:
- return true;
+ return false;
default:
gcc_unreachable ();
diff --git a/gcc/testsuite/gfortran.dg/statement_function_5.f90
b/gcc/testsuite/gfortran.dg/statement_function_5.f90
new file mode 100644
index ..bc5a5dba7a0f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/statement_function_5.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! PR fortran/115039
+!
+! Check that inquiry refs work with statement functions
+!
+! { dg-additional-options "-std=legacy -fdump-tree-optimized" }
+! { dg-prune-output " Obsolescent feature" }
+! { dg-final { scan-tree-dump-not "_gfortran_stop_numeric" "optimized" } }
+
+program testit
+ implicit none
+ complex :: x
+ real:: im
+ integer :: slen
+ character(5) :: s
+ im(x) = x%im + x%re + x%kind
+ slen(s) = s%len
+ if (im((1.0,3.0) + (2.0,4.0)) /= 14.) stop 1
+ if (slen('abcdef') /= 5) stop 2
+end program testit
Re: [PATCH] Fortran: improve attribute conflict checking [PR93635]
Am 10.05.24 um 21:48 schrieb Harald Anlauf: Hi Mikael, Am 10.05.24 um 11:45 schrieb Mikael Morin: Le 09/05/2024 à 22:30, Harald Anlauf a écrit : I'll stop here... Thanks. Go figure, I have no problem reproducing today. It's PR99798 (and there is even a patch for it). this patch has rotten a bit: the type of gfc_reluease_symbol has changed to bool, this can be fixed. Unfortunately, applying the patch does not remove the ICEs here... Oops, I take that back! There was an error on my side applying the patch; and now it does fix the ICEs after correcting that hickup We currently do not recover well from errors, and the prevention of corrupted namespaces is apparently a goal we aim at. Yes, and we are not there yet. But at least there is a sensible error message before the crash. True. But having a sensible error before ICEing does not improve user experience either. Are you planning to work again on PR99798? Cheers, Harald Cheers, Harald The patch therefore does not require any testsuite update and should not give any other surprises, so it should be very safe. The plan is also to leave the PR open for the time being. Regtesting on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald
Re: [PATCH] Fortran: improve attribute conflict checking [PR93635]
Hi Mikael, Am 10.05.24 um 11:45 schrieb Mikael Morin: Le 09/05/2024 à 22:30, Harald Anlauf a écrit : I'll stop here... Thanks. Go figure, I have no problem reproducing today. It's PR99798 (and there is even a patch for it). this patch has rotten a bit: the type of gfc_reluease_symbol has changed to bool, this can be fixed. Unfortunately, applying the patch does not remove the ICEs here... We currently do not recover well from errors, and the prevention of corrupted namespaces is apparently a goal we aim at. Yes, and we are not there yet. But at least there is a sensible error message before the crash. True. But having a sensible error before ICEing does not improve user experience either. Are you planning to work again on PR99798? Cheers, Harald Cheers, Harald The patch therefore does not require any testsuite update and should not give any other surprises, so it should be very safe. The plan is also to leave the PR open for the time being. Regtesting on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald
[PATCH] Fortran: fix dependency checks for inquiry refs [PR115039]
Dear all,
the attached simple and obvious patch fixes a bogus recursion error
with inquiry refs used statement functions. The commit message
says all there is to say...
Regtested on x86_64-pc-linux-gnu.
I intend to commit to mainline within the next 24 hours unless someone
screams... Will also backport to 14-branch after a decent delay.
Thanks,
Harald
From 8bb31eb3d7f8ea6d21066380c36abf53f7b64156 Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Fri, 10 May 2024 21:18:03 +0200
Subject: [PATCH] Fortran: fix dependency checks for inquiry refs [PR115039]
gcc/fortran/ChangeLog:
PR fortran/115039
* expr.cc (gfc_traverse_expr): An inquiry ref does not constitute
a dependency and cannot collide with a symbol.
gcc/testsuite/ChangeLog:
PR fortran/115039
* gfortran.dg/statement_function_5.f90: New test.
---
gcc/fortran/expr.cc | 3 ++-
.../gfortran.dg/statement_function_5.f90 | 20 +++
2 files changed, 22 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/statement_function_5.f90
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 66edad58278..8e29535b0f7 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -5500,7 +5500,8 @@ gfc_traverse_expr (gfc_expr *expr, gfc_symbol *sym,
break;
case REF_INQUIRY:
- return true;
+ /* An inquiry_ref does not collide with a symbol. */
+ return false;
default:
gcc_unreachable ();
diff --git a/gcc/testsuite/gfortran.dg/statement_function_5.f90 b/gcc/testsuite/gfortran.dg/statement_function_5.f90
new file mode 100644
index 000..bc5a5dba7a0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/statement_function_5.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! PR fortran/115039
+!
+! Check that inquiry refs work with statement functions
+!
+! { dg-additional-options "-std=legacy -fdump-tree-optimized" }
+! { dg-prune-output " Obsolescent feature" }
+! { dg-final { scan-tree-dump-not "_gfortran_stop_numeric" "optimized" } }
+
+program testit
+ implicit none
+ complex :: x
+ real:: im
+ integer :: slen
+ character(5) :: s
+ im(x) = x%im + x%re + x%kind
+ slen(s) = s%len
+ if (im((1.0,3.0) + (2.0,4.0)) /= 14.) stop 1
+ if (slen('abcdef') /= 5) stop 2
+end program testit
--
2.35.3
Re: [PATCH] Fortran: improve attribute conflict checking [PR93635]
Hi Mikael,
Am 09.05.24 um 21:51 schrieb Mikael Morin:
Hello,
Le 06/05/2024 à 21:33, Harald Anlauf a écrit :
Dear all,
I've been contemplating whether to submit the attached patch.
It addresses an ICE-on-invalid as reported in the PR, and also
fixes an accepts-invalid (see testcase), plus maybe some more,
related due to incomplete checking of symbol attribute conflicts.
The fix does not fully address the general issue, which is
analyzed by Steve: some of the checks do depend on the selected
Fortran standard, and under circumstances such as in the testcase
the checking of other, standard-version-independent conflicts
simply does not occur.
Steve's solution would fix that, but unfortunately leads to issues
with error recovery in notoriously fragile parts of the FE: e.g.
testcase pr87907.f90 needs adjusting, and minor variations
of it will lead to various other horrendous ICEs that remind
of existing PRs where parsing or resolution goes sideways.
I therefore propose a much simpler approach: move - if possible -
selected of the standard-version-dependent checks after the
version-independent ones. I think this could help in getting more
consistent error reporting and recovery. However, I did *not*
move those checks that are critical when processing interfaces.
(-> pr87907.f90 / (sub)modules)
Your patch looks clean, but I'm concerned that the order of the checks
should be the important ones first, regardless of their standard
version. I'm trying to look at the ICE caused by your other tentative
patch at https://gcc.gnu.org/bugzilla/show_bug.cgi?id=93635#c6 but I
can't reproduce the problem. Do you by any chance have around some of
the variations causing "horrendous" ICEs?
Oh, that's easy. Just move the block
conf_std (allocatable, dummy, GFC_STD_F2003);
conf_std (allocatable, function, GFC_STD_F2003);
conf_std (allocatable, result, GFC_STD_F2003);
towards the end of the gfc_check_conflict before the return true.
While the error messages for the original gfortran.dg/pr87907.f90
look harmless, commenting out the main program p I get:
pr87907.f90:15:18:
15 | subroutine g(x) ! { dg-error "mismatch in argument" }
| 1
Error: FUNCTION attribute conflicts with SUBROUTINE attribute in 'g' at (1)
f951: internal compiler error: Segmentation fault
0x13b8ec2 crash_signal
../../gcc-trunk/gcc/toplev.cc:319
0xba530e free_sym_tree
../../gcc-trunk/gcc/fortran/symbol.cc:4026
0xba5319 free_sym_tree
../../gcc-trunk/gcc/fortran/symbol.cc:4026
0xba5319 free_sym_tree
../../gcc-trunk/gcc/fortran/symbol.cc:4026
0xba5319 free_sym_tree
../../gcc-trunk/gcc/fortran/symbol.cc:4026
0xba5609 gfc_free_namespace(gfc_namespace*&)
../../gcc-trunk/gcc/fortran/symbol.cc:4168
0xba39c1 gfc_free_symbol(gfc_symbol*&)
../../gcc-trunk/gcc/fortran/symbol.cc:3173
0xba3b89 gfc_release_symbol(gfc_symbol*&)
../../gcc-trunk/gcc/fortran/symbol.cc:3216
0xba5339 free_sym_tree
../../gcc-trunk/gcc/fortran/symbol.cc:4029
0xba5609 gfc_free_namespace(gfc_namespace*&)
../../gcc-trunk/gcc/fortran/symbol.cc:4168
0xba58ef gfc_symbol_done_2()
../../gcc-trunk/gcc/fortran/symbol.cc:4236
0xb12ec8 gfc_done_2()
../../gcc-trunk/gcc/fortran/misc.cc:387
0xb4ac7f clean_up_modules
../../gcc-trunk/gcc/fortran/parse.cc:7057
0xb4af02 translate_all_program_units
../../gcc-trunk/gcc/fortran/parse.cc:7122
0xb4b735 gfc_parse_file()
../../gcc-trunk/gcc/fortran/parse.cc:7413
0xbb626f gfc_be_parse_file
../../gcc-trunk/gcc/fortran/f95-lang.cc:241
Restoring the main program but simply adding "end subroutine g"
where it is naively expected gives:
pr87907.f90:15:18:
15 | subroutine g(x) ! { dg-error "mismatch in argument" }
| 1
Error: FUNCTION attribute conflicts with SUBROUTINE attribute in 'g' at (1)
pr87907.f90:16:9:
16 | end subroutine g
| 1
Error: Expecting END SUBMODULE statement at (1)
pr87907.f90:20:7:
20 |use m! { dg-error "has a type" }
| 1
21 |integer :: x = 3
22 |call g(x)! { dg-error "which is not consistent
with" }
|
2
Error: 'g' at (1) has a type, which is not consistent with the CALL at (2)
f951: internal compiler error: in gfc_free_namespace, at
fortran/symbol.cc:4164
0xba55e1 gfc_free_namespace(gfc_namespace*&)
../../gcc-trunk/gcc/fortran/symbol.cc:4164
0xba39c1 gfc_free_symbol(gfc_symbol*&)
../../gcc-trunk/gcc/fortran/symbol.cc:3173
0xba3b89 gfc_release_symbol(gfc_symbol*&)
../../gcc-trunk/gcc/fortran/symbol.cc:3216
0xba5339 free_sym_tree
../../gcc-trunk/gcc/fortran/symbol.cc:4029
0xba5609 gfc_free_namespace(gfc_namespace*&)
../../gcc-trunk/gcc/fortran/symbol.cc:4168
0xba58ef gfc_symbol_done_2()
../../gcc-trunk/g
[gcc r14-10191] Fortran: fix issues with class(*) assignment [PR114827]
https://gcc.gnu.org/g:a5046235509caa10a4dc309ca0a8e67892b27750
commit r14-10191-ga5046235509caa10a4dc309ca0a8e67892b27750
Author: Harald Anlauf
Date: Mon Apr 29 19:52:52 2024 +0200
Fortran: fix issues with class(*) assignment [PR114827]
gcc/fortran/ChangeLog:
PR fortran/114827
* trans-array.cc (gfc_alloc_allocatable_for_assignment): Take into
account _len of unlimited polymorphic entities when calculating
the effective element size for allocation size and array span.
Set _len of lhs to _len of rhs.
* trans-expr.cc (trans_class_assignment): Take into account _len
of unlimited polymorphic entities for allocation size.
gcc/testsuite/ChangeLog:
PR fortran/114827
* gfortran.dg/asan/unlimited_polymorphic_34.f90: New test.
(cherry picked from commit 21e7aa5f3ea44ca2fef8deb8788edffc04901b5c)
Diff:
---
gcc/fortran/trans-array.cc | 16 +++
gcc/fortran/trans-expr.cc | 13 ++
.../gfortran.dg/asan/unlimited_polymorphic_34.f90 | 135 +
3 files changed, 164 insertions(+)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 30b84762346d..7ec33fb15986 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -11278,6 +11278,19 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
gfc_add_modify (, linfo->delta[dim], tmp);
}
+ /* Take into account _len of unlimited polymorphic entities, so that span
+ for array descriptors and allocation sizes are computed correctly. */
+ if (UNLIMITED_POLY (expr2))
+{
+ tree len = gfc_class_len_get (TREE_OPERAND (desc2, 0));
+ len = fold_build2_loc (input_location, MAX_EXPR, size_type_node,
+fold_convert (size_type_node, len),
+size_one_node);
+ elemsize2 = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, elemsize2,
+ fold_convert (gfc_array_index_type, len));
+}
+
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
gfc_conv_descriptor_span_set (, desc, elemsize2);
@@ -11324,6 +11337,9 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
gfc_add_modify (, tmp,
fold_convert (TREE_TYPE (tmp),
TYPE_SIZE_UNIT (type)));
+ else if (UNLIMITED_POLY (expr2))
+ gfc_add_modify (, tmp,
+ gfc_class_len_get (TREE_OPERAND (desc2, 0)));
else
gfc_add_modify (, tmp,
build_int_cst (TREE_TYPE (tmp), 0));
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 0280c441ced3..bc8eb419cffe 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11991,6 +11991,19 @@ trans_class_assignment (stmtblock_t *block, gfc_expr
*lhs, gfc_expr *rhs,
old_vptr = build_int_cst (TREE_TYPE (vptr), 0);
size = gfc_vptr_size_get (rhs_vptr);
+
+ /* Take into account _len of unlimited polymorphic entities.
+TODO: handle class(*) allocatable function results on rhs. */
+ if (UNLIMITED_POLY (rhs) && rhs->expr_type == EXPR_VARIABLE)
+ {
+ tree len = trans_get_upoly_len (block, rhs);
+ len = fold_build2_loc (input_location, MAX_EXPR, size_type_node,
+fold_convert (size_type_node, len),
+size_one_node);
+ size = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (size),
+ size, fold_convert (TREE_TYPE (size), len));
+ }
+
tmp = lse->expr;
class_han = GFC_CLASS_TYPE_P (TREE_TYPE (tmp))
? gfc_class_data_get (tmp) : tmp;
diff --git a/gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90
b/gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90
new file mode 100644
index ..c69158a1b55f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90
@@ -0,0 +1,135 @@
+! { dg-do run }
+! PR fortran/114827 - issues with class(*) assignment found by valgrind
+!
+! Contributed by Neil Carlson
+
+program main
+ implicit none
+ call run
+ call run1
+ call run2
+contains
+ ! Scalar tests
+ subroutine run ()
+character(*),parameter :: c = 'fubarfubarfubarfubarfubarfu'
+character(*,kind=4), parameter :: d = 4_"abcdef"
+complex, parameter :: z = (1.,2.)
+class(*), allocatable :: y
+
+call foo (c, y)
+select type (y)
+type is (character(*))
+! print *, y(5:6) ! ICE (-> pr114874)
+ if (y /= c) stop 1
+class default
+ stop 2
+end select
+
+call foo (z, y)
+select type (y)
+type is (complex)
+ if (y /
Re: [Patch, fortran] PR84006 [11/12/13/14/15 Regression] ICE in storage_size() with CLASS entity
Hi Paul, Am 09.05.24 um 09:52 schrieb Paul Richard Thomas: Hi Harald, Inserting your print statements, my test shows the difference in size(chr_a) but prints chr_a as "abcdefgjj" no matter what I do. have you tried ./a.out | cat -ev ? Or some terminal that shows control characters? Cheers, Harald Needless to say, the latter was the only check that I did. The problem, I suspect, lies somewhere in the murky depths of trans-array.cc(gfc_alloc_allocatable_for_assignment) or in the array part of intrinsic_transfer, untouched by either patch, and is present in 13- and 14-branches. I am onto it. Cheers Paul On Wed, 8 May 2024 at 22:06, Harald Anlauf wrote: Hi Paul, this looks mostly good, but the new testcase transfer_class_4.f90 does exhibit a problem with your patch. Run it with valgrind, or with -fcheck=bounds, or with -fsanitize=address, or add the following around the final transfer: print *, storage_size (star_a), storage_size (chr_a), size (chr_a), len (chr_a) chr_a = transfer (star_a, chr_a) print *, storage_size (star_a), storage_size (chr_a), size (chr_a), len (chr_a) print *, ">", chr_a, "<" This prints for me: 40 40 2 5$ 40 40 4 5$ >abcdefghij^@^@^@^@^@^@^@^@^@^@<$ So since the physical representation of chr_a is sufficient to hold star_a (F2023:16.9.212), no reallocation with a wrong calculated size should happen. (Intel and NAG get this right.) Can you check again? Thanks, Harald Am 08.05.24 um 17:01 schrieb Paul Richard Thomas: This fix is straightforward and described by the ChangeLog. Jose Rui Faustino de Sousa posted the same fix for the ICE on the fortran list slightly more than three years ago. Thinking that he had commit rights, I deferred but, regrettably, the patch was never applied. The attached patch also fixes storage_size and transfer for unlimited polymorphic arguments with character payloads. OK for mainline and backporting after a reasonable interval? Paul Fortran: Unlimited polymorphic intrinsic function arguments [PR84006] 2024-05-08 Paul Thomas gcc/fortran PR fortran/84006 PR fortran/100027 PR fortran/98534 * trans-expr.cc (gfc_resize_class_size_with_len): Use the fold even if a block is not available in which to fix the result. (trans_class_assignment): Enable correct assignment of character expressions to unlimited polymorphic variables using lhs _len field and rse string_length. * trans-intrinsic.cc (gfc_conv_intrinsic_storage_size): Extract the class expression so that the unlimited polymorphic class expression can be used in gfc_resize_class_size_with_len to obtain the storage size for character payloads. Guard the use of GFC_DECL_SAVED_DESCRIPTOR by testing for DECL_LANG_SPECIFIC to prevent the ICE. Also, invert the order to use the class expression extracted from the argument. (gfc_conv_intrinsic_transfer): In same way as 'storage_size', use the _len field to obtaining the correct length for arg 1. gcc/testsuite/ PR fortran/84006 PR fortran/100027 * gfortran.dg/storage_size_7.f90: New test. PR fortran/98534 * gfortran.dg/transfer_class_4.f90: New test.
Re: [Patch, fortran] PR84006 [11/12/13/14/15 Regression] ICE in storage_size() with CLASS entity
Hi Paul, this looks mostly good, but the new testcase transfer_class_4.f90 does exhibit a problem with your patch. Run it with valgrind, or with -fcheck=bounds, or with -fsanitize=address, or add the following around the final transfer: print *, storage_size (star_a), storage_size (chr_a), size (chr_a), len (chr_a) chr_a = transfer (star_a, chr_a) print *, storage_size (star_a), storage_size (chr_a), size (chr_a), len (chr_a) print *, ">", chr_a, "<" This prints for me: 40 40 2 5$ 40 40 4 5$ >abcdefghij^@^@^@^@^@^@^@^@^@^@<$ So since the physical representation of chr_a is sufficient to hold star_a (F2023:16.9.212), no reallocation with a wrong calculated size should happen. (Intel and NAG get this right.) Can you check again? Thanks, Harald Am 08.05.24 um 17:01 schrieb Paul Richard Thomas: This fix is straightforward and described by the ChangeLog. Jose Rui Faustino de Sousa posted the same fix for the ICE on the fortran list slightly more than three years ago. Thinking that he had commit rights, I deferred but, regrettably, the patch was never applied. The attached patch also fixes storage_size and transfer for unlimited polymorphic arguments with character payloads. OK for mainline and backporting after a reasonable interval? Paul Fortran: Unlimited polymorphic intrinsic function arguments [PR84006] 2024-05-08 Paul Thomas gcc/fortran PR fortran/84006 PR fortran/100027 PR fortran/98534 * trans-expr.cc (gfc_resize_class_size_with_len): Use the fold even if a block is not available in which to fix the result. (trans_class_assignment): Enable correct assignment of character expressions to unlimited polymorphic variables using lhs _len field and rse string_length. * trans-intrinsic.cc (gfc_conv_intrinsic_storage_size): Extract the class expression so that the unlimited polymorphic class expression can be used in gfc_resize_class_size_with_len to obtain the storage size for character payloads. Guard the use of GFC_DECL_SAVED_DESCRIPTOR by testing for DECL_LANG_SPECIFIC to prevent the ICE. Also, invert the order to use the class expression extracted from the argument. (gfc_conv_intrinsic_transfer): In same way as 'storage_size', use the _len field to obtaining the correct length for arg 1. gcc/testsuite/ PR fortran/84006 PR fortran/100027 * gfortran.dg/storage_size_7.f90: New test. PR fortran/98534 * gfortran.dg/transfer_class_4.f90: New test.
[PATCH] Fortran: improve attribute conflict checking [PR93635]
Dear all,
I've been contemplating whether to submit the attached patch.
It addresses an ICE-on-invalid as reported in the PR, and also
fixes an accepts-invalid (see testcase), plus maybe some more,
related due to incomplete checking of symbol attribute conflicts.
The fix does not fully address the general issue, which is
analyzed by Steve: some of the checks do depend on the selected
Fortran standard, and under circumstances such as in the testcase
the checking of other, standard-version-independent conflicts
simply does not occur.
Steve's solution would fix that, but unfortunately leads to issues
with error recovery in notoriously fragile parts of the FE: e.g.
testcase pr87907.f90 needs adjusting, and minor variations
of it will lead to various other horrendous ICEs that remind
of existing PRs where parsing or resolution goes sideways.
I therefore propose a much simpler approach: move - if possible -
selected of the standard-version-dependent checks after the
version-independent ones. I think this could help in getting more
consistent error reporting and recovery. However, I did *not*
move those checks that are critical when processing interfaces.
(-> pr87907.f90 / (sub)modules)
The patch therefore does not require any testsuite update and
should not give any other surprises, so it should be very safe.
The plan is also to leave the PR open for the time being.
Regtesting on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
From c55cb36a6ad00996b5efb33c0c5357fc5fa9919c Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Mon, 6 May 2024 20:57:29 +0200
Subject: [PATCH] Fortran: improve attribute conflict checking [PR93635]
gcc/fortran/ChangeLog:
PR fortran/93635
* symbol.cc (gfc_check_conflict): Move some attribute conflict
checks that depend on the selected version of the Fortran standard
so that error reporting gets more consistent.
gcc/testsuite/ChangeLog:
PR fortran/93635
* gfortran.dg/pr93635.f90: New test.
---
gcc/fortran/symbol.cc | 30 ---
gcc/testsuite/gfortran.dg/pr93635.f90 | 19 +
2 files changed, 32 insertions(+), 17 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/pr93635.f90
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 8f7deac1d1e..ed17291c53e 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -459,22 +459,6 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
if (where == NULL)
where = _current_locus;
- if (attr->pointer && attr->intent != INTENT_UNKNOWN)
-{
- a1 = pointer;
- a2 = intent;
- standard = GFC_STD_F2003;
- goto conflict_std;
-}
-
- if (attr->in_namelist && (attr->allocatable || attr->pointer))
-{
- a1 = in_namelist;
- a2 = attr->allocatable ? allocatable : pointer;
- standard = GFC_STD_F2003;
- goto conflict_std;
-}
-
/* Check for attributes not allowed in a BLOCK DATA. */
if (gfc_current_state () == COMP_BLOCK_DATA)
{
@@ -579,10 +563,12 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
return false;
conf (allocatable, pointer);
+
+ /* Moving these checks past the function/subroutine conflict check may
+ cause trouble with minor variations of testcase pr87907.f90. */
conf_std (allocatable, dummy, GFC_STD_F2003);
conf_std (allocatable, function, GFC_STD_F2003);
conf_std (allocatable, result, GFC_STD_F2003);
- conf_std (elemental, recursive, GFC_STD_F2018);
conf (in_common, dummy);
conf (in_common, allocatable);
@@ -911,6 +897,16 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
break;
}
+ /* Conflict checks depending on the selected version of the Fortran
+ standard are preferably applied after standard-independent ones, so
+ that one gets more consistent error reporting and recovery. */
+ if (attr->pointer && attr->intent != INTENT_UNKNOWN)
+conf_std (pointer, intent, GFC_STD_F2003);
+
+ conf_std (in_namelist, allocatable, GFC_STD_F2003);
+ conf_std (in_namelist, pointer, GFC_STD_F2003);
+ conf_std (elemental, recursive, GFC_STD_F2018);
+
return true;
conflict:
diff --git a/gcc/testsuite/gfortran.dg/pr93635.f90 b/gcc/testsuite/gfortran.dg/pr93635.f90
new file mode 100644
index 000..4ef33fecf2b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr93635.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! PR fortran/93635
+!
+! Test that some attribute conflicts are properly diagnosed
+
+program p
+ implicit none
+ character(len=:),allocatable :: r,s
+ namelist /args/ r,s
+ equivalence(r,s) ! { dg-error "EQUIVALENCE attribute conflicts with ALLOCATABLE" }
+ allocate(character(len=1024) :: r)
+end
+
+subroutine sub (p, q)
+ implicit none
+ real, pointer, intent(inout) :: p(:), q(:)
+ namelist /nml/ p,q
+ equivalence(p,q) ! { dg-error "EQUIVALENCE attribute conflicts with DUMMY" }
+end
--
2.35.3
Re: [PATCH] Fortran: fix issues with class(*) assignment [PR114827]
Hi Paul,
Am 05.05.24 um 18:48 schrieb Paul Richard Thomas:
Hi Harald,
Please do commit, with or without the extra bit for the function result.
I've committed the attached variant that excludes the case of a scalar
class(*) allocatable function result on the rhs, and added a TODO.
As well as having to get back to pr113363, I have patches in a complete
state for pr84006 and 98534. However they clash with yours. You arrived at
the head of the queue first and so after you :-)
Well, thanks for volunteering to clean up after me... ;-)
Cheers,
Harald
Regards
Paul
From 21e7aa5f3ea44ca2fef8deb8788edffc04901b5c Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Mon, 29 Apr 2024 19:52:52 +0200
Subject: [PATCH] Fortran: fix issues with class(*) assignment [PR114827]
gcc/fortran/ChangeLog:
PR fortran/114827
* trans-array.cc (gfc_alloc_allocatable_for_assignment): Take into
account _len of unlimited polymorphic entities when calculating
the effective element size for allocation size and array span.
Set _len of lhs to _len of rhs.
* trans-expr.cc (trans_class_assignment): Take into account _len
of unlimited polymorphic entities for allocation size.
gcc/testsuite/ChangeLog:
PR fortran/114827
* gfortran.dg/asan/unlimited_polymorphic_34.f90: New test.
---
gcc/fortran/trans-array.cc| 16 +++
gcc/fortran/trans-expr.cc | 13 ++
.../asan/unlimited_polymorphic_34.f90 | 135 ++
3 files changed, 164 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 30b84762346..7ec33fb1598 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -11278,6 +11278,19 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
gfc_add_modify (, linfo->delta[dim], tmp);
}
+ /* Take into account _len of unlimited polymorphic entities, so that span
+ for array descriptors and allocation sizes are computed correctly. */
+ if (UNLIMITED_POLY (expr2))
+{
+ tree len = gfc_class_len_get (TREE_OPERAND (desc2, 0));
+ len = fold_build2_loc (input_location, MAX_EXPR, size_type_node,
+ fold_convert (size_type_node, len),
+ size_one_node);
+ elemsize2 = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, elemsize2,
+ fold_convert (gfc_array_index_type, len));
+}
+
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
gfc_conv_descriptor_span_set (, desc, elemsize2);
@@ -11324,6 +11337,9 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
gfc_add_modify (, tmp,
fold_convert (TREE_TYPE (tmp),
TYPE_SIZE_UNIT (type)));
+ else if (UNLIMITED_POLY (expr2))
+ gfc_add_modify (, tmp,
+ gfc_class_len_get (TREE_OPERAND (desc2, 0)));
else
gfc_add_modify (, tmp,
build_int_cst (TREE_TYPE (tmp), 0));
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 0280c441ced..bc8eb419cff 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11991,6 +11991,19 @@ trans_class_assignment (stmtblock_t *block, gfc_expr *lhs, gfc_expr *rhs,
old_vptr = build_int_cst (TREE_TYPE (vptr), 0);
size = gfc_vptr_size_get (rhs_vptr);
+
+ /* Take into account _len of unlimited polymorphic entities.
+ TODO: handle class(*) allocatable function results on rhs. */
+ if (UNLIMITED_POLY (rhs) && rhs->expr_type == EXPR_VARIABLE)
+ {
+ tree len = trans_get_upoly_len (block, rhs);
+ len = fold_build2_loc (input_location, MAX_EXPR, size_type_node,
+ fold_convert (size_type_node, len),
+ size_one_node);
+ size = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (size),
+ size, fold_convert (TREE_TYPE (size), len));
+ }
+
tmp = lse->expr;
class_han = GFC_CLASS_TYPE_P (TREE_TYPE (tmp))
? gfc_class_data_get (tmp) : tmp;
diff --git a/gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90 b/gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90
new file mode 100644
index 000..c69158a1b55
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90
@@ -0,0 +1,135 @@
+! { dg-do run }
+! PR fortran/114827 - issues with class(*) assignment found by valgrind
+!
+! Contributed by Neil Carlson
+
+program main
+ implicit none
+ call run
+ call run1
+ call run2
+contains
+ ! Scalar tests
+ subroutine run ()
+character(*),parameter :: c = 'fubarfubarfubarfubarfubarfu'
+character(*,kind=4), parameter :: d = 4_"abcdef"
+complex, parameter :: z = (1.,2.)
+class(*), allocatable :: y
+
+call foo (c, y)
+select type (y)
+type is (character(*))
+! print *, y(5:6) ! ICE (-> pr114874)
+ if (y /= c) stop 1
+class default
+ stop 2
+end select
+
+call foo (z, y)
+select type (y)
+type i
[gcc r15-168] Fortran: fix issues with class(*) assignment [PR114827]
https://gcc.gnu.org/g:21e7aa5f3ea44ca2fef8deb8788edffc04901b5c
commit r15-168-g21e7aa5f3ea44ca2fef8deb8788edffc04901b5c
Author: Harald Anlauf
Date: Mon Apr 29 19:52:52 2024 +0200
Fortran: fix issues with class(*) assignment [PR114827]
gcc/fortran/ChangeLog:
PR fortran/114827
* trans-array.cc (gfc_alloc_allocatable_for_assignment): Take into
account _len of unlimited polymorphic entities when calculating
the effective element size for allocation size and array span.
Set _len of lhs to _len of rhs.
* trans-expr.cc (trans_class_assignment): Take into account _len
of unlimited polymorphic entities for allocation size.
gcc/testsuite/ChangeLog:
PR fortran/114827
* gfortran.dg/asan/unlimited_polymorphic_34.f90: New test.
Diff:
---
gcc/fortran/trans-array.cc | 16 +++
gcc/fortran/trans-expr.cc | 13 ++
.../gfortran.dg/asan/unlimited_polymorphic_34.f90 | 135 +
3 files changed, 164 insertions(+)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 30b84762346..7ec33fb1598 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -11278,6 +11278,19 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
gfc_add_modify (, linfo->delta[dim], tmp);
}
+ /* Take into account _len of unlimited polymorphic entities, so that span
+ for array descriptors and allocation sizes are computed correctly. */
+ if (UNLIMITED_POLY (expr2))
+{
+ tree len = gfc_class_len_get (TREE_OPERAND (desc2, 0));
+ len = fold_build2_loc (input_location, MAX_EXPR, size_type_node,
+fold_convert (size_type_node, len),
+size_one_node);
+ elemsize2 = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, elemsize2,
+ fold_convert (gfc_array_index_type, len));
+}
+
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
gfc_conv_descriptor_span_set (, desc, elemsize2);
@@ -11324,6 +11337,9 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
gfc_add_modify (, tmp,
fold_convert (TREE_TYPE (tmp),
TYPE_SIZE_UNIT (type)));
+ else if (UNLIMITED_POLY (expr2))
+ gfc_add_modify (, tmp,
+ gfc_class_len_get (TREE_OPERAND (desc2, 0)));
else
gfc_add_modify (, tmp,
build_int_cst (TREE_TYPE (tmp), 0));
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 0280c441ced..bc8eb419cff 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11991,6 +11991,19 @@ trans_class_assignment (stmtblock_t *block, gfc_expr
*lhs, gfc_expr *rhs,
old_vptr = build_int_cst (TREE_TYPE (vptr), 0);
size = gfc_vptr_size_get (rhs_vptr);
+
+ /* Take into account _len of unlimited polymorphic entities.
+TODO: handle class(*) allocatable function results on rhs. */
+ if (UNLIMITED_POLY (rhs) && rhs->expr_type == EXPR_VARIABLE)
+ {
+ tree len = trans_get_upoly_len (block, rhs);
+ len = fold_build2_loc (input_location, MAX_EXPR, size_type_node,
+fold_convert (size_type_node, len),
+size_one_node);
+ size = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (size),
+ size, fold_convert (TREE_TYPE (size), len));
+ }
+
tmp = lse->expr;
class_han = GFC_CLASS_TYPE_P (TREE_TYPE (tmp))
? gfc_class_data_get (tmp) : tmp;
diff --git a/gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90
b/gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90
new file mode 100644
index 000..c69158a1b55
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90
@@ -0,0 +1,135 @@
+! { dg-do run }
+! PR fortran/114827 - issues with class(*) assignment found by valgrind
+!
+! Contributed by Neil Carlson
+
+program main
+ implicit none
+ call run
+ call run1
+ call run2
+contains
+ ! Scalar tests
+ subroutine run ()
+character(*),parameter :: c = 'fubarfubarfubarfubarfubarfu'
+character(*,kind=4), parameter :: d = 4_"abcdef"
+complex, parameter :: z = (1.,2.)
+class(*), allocatable :: y
+
+call foo (c, y)
+select type (y)
+type is (character(*))
+! print *, y(5:6) ! ICE (-> pr114874)
+ if (y /= c) stop 1
+class default
+ stop 2
+end select
+
+call foo (z, y)
+select type (y)
+type is (complex)
+ if (y /= z) stop 3
+class default
+ stop 4
+end select
+
+call foo (d, y)
Re: [PATCH] Fortran: fix issues with class(*) assignment [PR114827]
Hi Paul,
On 4/30/24 07:50, Paul Richard Thomas wrote:
Hi Harald,
This patch is verging on 'obvious', . once one sees it :-)
Yes, it's good for mainline and all active branches, when available.
thanks for your quick review.
I haven't committed it yet, because I forgot to check what happens with
a class(*) allocatable function result on the r.h.s. of the assignment.
One now gets an ICE with the testcase in your submission
https://gcc.gnu.org/pipermail/fortran/2024-April/060426.html
on the simple scalar assignment
y = bar ()
instead of wrong code. Not very helpful.
I tried the following change on top of the submitted patch:
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 4ba40bfdbd3..cacf3c0dda1 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11995,7 +11996,11 @@ trans_class_assignment (stmtblock_t *block,
gfc_expr *lhs, gfc_expr *rhs,
/* Take into account _len of unlimited polymorphic entities. */
if (UNLIMITED_POLY (rhs))
{
- tree len = trans_get_upoly_len (block, rhs);
+ tree len;
+ if (rhs->expr_type == EXPR_VARIABLE)
+ len = trans_get_upoly_len (block, rhs);
+ else
+ len = gfc_class_len_get (gfc_get_class_from_expr (tmp));
len = fold_build2_loc (input_location, MAX_EXPR, size_type_node,
fold_convert (size_type_node, len),
size_one_node);
This avoids the ICE, but depending on details of bar() this leads
to different wrong code from before, and
function bar() result(res)
class(*), allocatable :: res
res = sca
end function bar
behaves differently from
function bar()
class(*), allocatable :: bar
bar = sca
end function bar
The minimal and sort of "safe" fix to avoid a new ICE while keeping
the fix for simple assignments is to replace in the above snippet
if (UNLIMITED_POLY (rhs))
by
if (UNLIMITED_POLY (rhs) && rhs->expr_type == EXPR_VARIABLE)
omit the other changes above, and defer a fix for assignment of
function results, as looking at the dump-tree suggests that this
will be a bigger piece of work. (The .span looks suspicious all
over the place...)
The good thing is: a simple test with array-valued function results
did not immediately break the submitted patch... ;-)
What do you think?
Thanks,
Harald
Thanks
Paul
PS The fall-out pr114874 is so peculiar that I am dropping everything to
find the source.
On Mon, 29 Apr 2024 at 19:39, Harald Anlauf wrote:
Dear all,
the attached patch fixes issues with assignments of unlimited polymorphic
entities that were found with the help of valgrind or asan, see PR.
Looking
further into it, it turns out that allocation sizes as well as array spans
could be set incorrectly, leading to wrong results or heap corruption.
The fix is rather straightforward: take into the _len of unlimited
polymorphic entities when it is non-zero to get the correct allocation
sizes and array spans.
The patch has been tested by the reporter, see PR.
Regtested on x86_64-pc-linux-gnu. OK for 15-mainline?
I would like to backport this to active branches where appropriate,
starting with 14 after it reopens after release. Is this OK?
Thanks,
Harald
[PATCH] Fortran: fix issues with class(*) assignment [PR114827]
Dear all,
the attached patch fixes issues with assignments of unlimited polymorphic
entities that were found with the help of valgrind or asan, see PR. Looking
further into it, it turns out that allocation sizes as well as array spans
could be set incorrectly, leading to wrong results or heap corruption.
The fix is rather straightforward: take into the _len of unlimited
polymorphic entities when it is non-zero to get the correct allocation
sizes and array spans.
The patch has been tested by the reporter, see PR.
Regtested on x86_64-pc-linux-gnu. OK for 15-mainline?
I would like to backport this to active branches where appropriate,
starting with 14 after it reopens after release. Is this OK?
Thanks,
Harald
From 3b73471b570898e5a5085422da48d5bf118edff1 Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Mon, 29 Apr 2024 19:52:52 +0200
Subject: [PATCH] Fortran: fix issues with class(*) assignment [PR114827]
gcc/fortran/ChangeLog:
PR fortran/114827
* trans-array.cc (gfc_alloc_allocatable_for_assignment): Take into
account _len of unlimited polymorphic entities when calculating
the effective element size for allocation size and array span.
Set _len of lhs to _len of rhs.
* trans-expr.cc (trans_class_assignment): Take into account _len
of unlimited polymorphic entities for allocation size.
gcc/testsuite/ChangeLog:
PR fortran/114827
* gfortran.dg/asan/unlimited_polymorphic_34.f90: New test.
---
gcc/fortran/trans-array.cc| 16 +++
gcc/fortran/trans-expr.cc | 12 ++
.../asan/unlimited_polymorphic_34.f90 | 135 ++
3 files changed, 163 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 30b84762346..7ec33fb1598 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -11278,6 +11278,19 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
gfc_add_modify (, linfo->delta[dim], tmp);
}
+ /* Take into account _len of unlimited polymorphic entities, so that span
+ for array descriptors and allocation sizes are computed correctly. */
+ if (UNLIMITED_POLY (expr2))
+{
+ tree len = gfc_class_len_get (TREE_OPERAND (desc2, 0));
+ len = fold_build2_loc (input_location, MAX_EXPR, size_type_node,
+ fold_convert (size_type_node, len),
+ size_one_node);
+ elemsize2 = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, elemsize2,
+ fold_convert (gfc_array_index_type, len));
+}
+
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
gfc_conv_descriptor_span_set (, desc, elemsize2);
@@ -11324,6 +11337,9 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
gfc_add_modify (, tmp,
fold_convert (TREE_TYPE (tmp),
TYPE_SIZE_UNIT (type)));
+ else if (UNLIMITED_POLY (expr2))
+ gfc_add_modify (, tmp,
+ gfc_class_len_get (TREE_OPERAND (desc2, 0)));
else
gfc_add_modify (, tmp,
build_int_cst (TREE_TYPE (tmp), 0));
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 0280c441ced..4ba40bfdbd3 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11991,6 +11991,18 @@ trans_class_assignment (stmtblock_t *block, gfc_expr *lhs, gfc_expr *rhs,
old_vptr = build_int_cst (TREE_TYPE (vptr), 0);
size = gfc_vptr_size_get (rhs_vptr);
+
+ /* Take into account _len of unlimited polymorphic entities. */
+ if (UNLIMITED_POLY (rhs))
+ {
+ tree len = trans_get_upoly_len (block, rhs);
+ len = fold_build2_loc (input_location, MAX_EXPR, size_type_node,
+ fold_convert (size_type_node, len),
+ size_one_node);
+ size = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (size),
+ size, fold_convert (TREE_TYPE (size), len));
+ }
+
tmp = lse->expr;
class_han = GFC_CLASS_TYPE_P (TREE_TYPE (tmp))
? gfc_class_data_get (tmp) : tmp;
diff --git a/gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90 b/gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90
new file mode 100644
index 000..c69158a1b55
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90
@@ -0,0 +1,135 @@
+! { dg-do run }
+! PR fortran/114827 - issues with class(*) assignment found by valgrind
+!
+! Contributed by Neil Carlson
+
+program main
+ implicit none
+ call run
+ call run1
+ call run2
+contains
+ ! Scalar tests
+ subroutine run ()
+character(*),parameter :: c = 'fubarfubarfubarfubarfubarfu'
+character(*,kind=4), parameter :: d = 4_"abcdef"
+complex, parameter :: z = (1.,2.)
+class(*), allocatable :: y
+
+call foo (c, y)
+select type (y)
+type is (character(*))
+! print *, y(5:6) ! ICE (-> pr114874)
+ if (y /= c) stop 1
+class default
+ stop 2
+end select
+
+call foo
[gcc r12-10398] Fortran: Fix assumed length chars and len inquiry [PR103716]
https://gcc.gnu.org/g:b482968801158116dd8ba3b15a4c29143b2a423a
commit r12-10398-gb482968801158116dd8ba3b15a4c29143b2a423a
Author: Paul Thomas
Date: Tue May 23 06:46:37 2023 +0100
Fortran: Fix assumed length chars and len inquiry [PR103716]
2023-05-23 Paul Thomas
gcc/fortran
PR fortran/103716
* resolve.cc (gfc_resolve_ref): Conversion of array_ref into an
element should be done for all characters without a len expr,
not just deferred lens, and for integer expressions.
* trans-expr.cc (conv_inquiry): For len and kind inquiry refs,
set the se string_length to NULL_TREE.
gcc/testsuite/
PR fortran/103716
* gfortran.dg/pr103716.f90 : New test.
(cherry picked from commit 842a432b02238361ecc601d301ac400a7f30f4fa)
Diff:
---
gcc/fortran/resolve.cc | 4 +++-
gcc/fortran/trans-expr.cc | 2 ++
gcc/testsuite/gfortran.dg/pr103716.f90 | 15 +++
3 files changed, 20 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 9264322f671..6a7325e15e7 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -5461,7 +5461,9 @@ gfc_resolve_ref (gfc_expr *expr)
case REF_INQUIRY:
/* Implement requirement in note 9.7 of F2018 that the result of the
LEN inquiry be a scalar. */
- if (ref->u.i == INQUIRY_LEN && array_ref && expr->ts.deferred)
+ if (ref->u.i == INQUIRY_LEN && array_ref
+ && ((expr->ts.type == BT_CHARACTER && !expr->ts.u.cl->length)
+ || expr->ts.type == BT_INTEGER))
{
array_ref->u.ar.type = AR_ELEMENT;
expr->rank = 0;
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 11ee1931b8e..e78a01003c9 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -2854,11 +2854,13 @@ conv_inquiry (gfc_se * se, gfc_ref * ref, gfc_expr
*expr, gfc_typespec *ts)
case INQUIRY_KIND:
res = build_int_cst (gfc_typenode_for_spec (>ts),
ts->kind);
+ se->string_length = NULL_TREE;
break;
case INQUIRY_LEN:
res = fold_convert (gfc_typenode_for_spec (>ts),
se->string_length);
+ se->string_length = NULL_TREE;
break;
default:
diff --git a/gcc/testsuite/gfortran.dg/pr103716.f90
b/gcc/testsuite/gfortran.dg/pr103716.f90
new file mode 100644
index 000..4f78900839e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr103716.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+!
+! The gimplifier used to throw a fit on thes two functions.
+!
+! Contributed by Gerhard Steinmetz
+!
+function f1(x)
+ character(*) :: x(*)
+ print *, g(x%len)
+end
+
+function f2(x)
+ character(*) :: x(3)
+ print *, g(x%len)
+end
[gcc r12-10396] gfortran: Allow ref'ing PDT's len() in parameter-initializer.
mtree->n.sym
- && e->symtree->n.sym->ts.type != BT_DERIVED
- && e->symtree->n.sym->assoc && e->symtree->n.sym->assoc->target
- && e->symtree->n.sym->assoc->target->ts.type == BT_DERIVED
- && e->symtree->n.sym->assoc->target->symtree->n.sym
- && UNLIMITED_POLY (e->symtree->n.sym->assoc->target->symtree->n.sym))
-
-/* The expression in assoc->target points to a ref to the _data component
- of the unlimited polymorphic entity. To get the _len component the last
- _data ref needs to be stripped and a ref to the _len component added.
*/
-return gfc_get_len_component (e->symtree->n.sym->assoc->target, k);
- else
-return NULL;
+ && e->symtree->n.sym)
+{
+ if (e->symtree->n.sym->ts.type != BT_DERIVED
+ && e->symtree->n.sym->assoc && e->symtree->n.sym->assoc->target
+ && e->symtree->n.sym->assoc->target->ts.type == BT_DERIVED
+ && e->symtree->n.sym->assoc->target->symtree->n.sym
+ && UNLIMITED_POLY (e->symtree->n.sym->assoc->target->symtree->n.sym))
+ /* The expression in assoc->target points to a ref to the _data
+ component of the unlimited polymorphic entity. To get the _len
+ component the last _data ref needs to be stripped and a ref to the
+ _len component added. */
+ return gfc_get_len_component (e->symtree->n.sym->assoc->target, k);
+ else if (e->symtree->n.sym->ts.type == BT_DERIVED
+ && e->ref && e->ref->type == REF_COMPONENT
+ && e->ref->u.c.component->attr.pdt_string
+ && e->ref->u.c.component->ts.type == BT_CHARACTER
+ && e->ref->u.c.component->ts.u.cl->length)
+ {
+ if (gfc_init_expr_flag)
+ {
+ gfc_expr* tmp;
+ tmp = gfc_pdt_find_component_copy_initializer (e->symtree->n.sym,
+e->ref->u.c
+.component->ts.u.cl
+->length->symtree
+->name);
+ if (tmp)
+ return tmp;
+ }
+ else
+ {
+ gfc_expr *len_expr = gfc_copy_expr (e);
+ gfc_free_ref_list (len_expr->ref);
+ len_expr->ref = NULL;
+ gfc_find_component (len_expr->symtree->n.sym->ts.u.derived, e->ref
+ ->u.c.component->ts.u.cl->length->symtree
+ ->name,
+ false, true, _expr->ref);
+ len_expr->ts = len_expr->ref->u.c.component->ts;
+ return len_expr;
+ }
+ }
+}
+ return NULL;
}
diff --git a/gcc/testsuite/gfortran.dg/pdt_33.f03
b/gcc/testsuite/gfortran.dg/pdt_33.f03
new file mode 100644
index 000..3b2fe72431d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_33.f03
@@ -0,0 +1,21 @@
+! { dg-do run }
+!
+! Test the fix for PR102003, where len parameters where not returned as
constants.
+!
+! Contributed by Harald Anlauf
+!
+program pr102003
+ type pdt(n)
+ integer, len :: n = 8
+ character(len=n) :: c
+ end type pdt
+ type(pdt(42)) :: p
+ integer, parameter :: m = len (p% c)
+ integer, parameter :: lm = p% c% len
+
+ if (m /= 42) stop 1
+ if (len (p% c) /= 42) stop 2
+ if (lm /= 42) stop 3
+ if (p% c% len /= 42) stop 4
+end
+
[gcc r13-8651] gfortran: Allow ref'ing PDT's len() in parameter-initializer.
mtree->n.sym
- && e->symtree->n.sym->ts.type != BT_DERIVED
- && e->symtree->n.sym->assoc && e->symtree->n.sym->assoc->target
- && e->symtree->n.sym->assoc->target->ts.type == BT_DERIVED
- && e->symtree->n.sym->assoc->target->symtree->n.sym
- && UNLIMITED_POLY (e->symtree->n.sym->assoc->target->symtree->n.sym))
-
-/* The expression in assoc->target points to a ref to the _data component
- of the unlimited polymorphic entity. To get the _len component the last
- _data ref needs to be stripped and a ref to the _len component added.
*/
-return gfc_get_len_component (e->symtree->n.sym->assoc->target, k);
- else
-return NULL;
+ && e->symtree->n.sym)
+{
+ if (e->symtree->n.sym->ts.type != BT_DERIVED
+ && e->symtree->n.sym->assoc && e->symtree->n.sym->assoc->target
+ && e->symtree->n.sym->assoc->target->ts.type == BT_DERIVED
+ && e->symtree->n.sym->assoc->target->symtree->n.sym
+ && UNLIMITED_POLY (e->symtree->n.sym->assoc->target->symtree->n.sym))
+ /* The expression in assoc->target points to a ref to the _data
+ component of the unlimited polymorphic entity. To get the _len
+ component the last _data ref needs to be stripped and a ref to the
+ _len component added. */
+ return gfc_get_len_component (e->symtree->n.sym->assoc->target, k);
+ else if (e->symtree->n.sym->ts.type == BT_DERIVED
+ && e->ref && e->ref->type == REF_COMPONENT
+ && e->ref->u.c.component->attr.pdt_string
+ && e->ref->u.c.component->ts.type == BT_CHARACTER
+ && e->ref->u.c.component->ts.u.cl->length)
+ {
+ if (gfc_init_expr_flag)
+ {
+ gfc_expr* tmp;
+ tmp = gfc_pdt_find_component_copy_initializer (e->symtree->n.sym,
+e->ref->u.c
+.component->ts.u.cl
+->length->symtree
+->name);
+ if (tmp)
+ return tmp;
+ }
+ else
+ {
+ gfc_expr *len_expr = gfc_copy_expr (e);
+ gfc_free_ref_list (len_expr->ref);
+ len_expr->ref = NULL;
+ gfc_find_component (len_expr->symtree->n.sym->ts.u.derived, e->ref
+ ->u.c.component->ts.u.cl->length->symtree
+ ->name,
+ false, true, _expr->ref);
+ len_expr->ts = len_expr->ref->u.c.component->ts;
+ return len_expr;
+ }
+ }
+}
+ return NULL;
}
diff --git a/gcc/testsuite/gfortran.dg/pdt_33.f03
b/gcc/testsuite/gfortran.dg/pdt_33.f03
new file mode 100644
index 000..3b2fe72431d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_33.f03
@@ -0,0 +1,21 @@
+! { dg-do run }
+!
+! Test the fix for PR102003, where len parameters where not returned as
constants.
+!
+! Contributed by Harald Anlauf
+!
+program pr102003
+ type pdt(n)
+ integer, len :: n = 8
+ character(len=n) :: c
+ end type pdt
+ type(pdt(42)) :: p
+ integer, parameter :: m = len (p% c)
+ integer, parameter :: lm = p% c% len
+
+ if (m /= 42) stop 1
+ if (len (p% c) /= 42) stop 2
+ if (lm /= 42) stop 3
+ if (p% c% len /= 42) stop 4
+end
+
Re: [Patch, fortran] PR93678 - [11/12/13/14 Regression] ICE with TRANSFER and typebound procedures
Hi Paul, On 4/24/24 18:26, Paul Richard Thomas wrote: Hi there, This regression turned out to be low hanging fruit, although it has taken four years to reach it :-( The ChangeLog says it all. OK for mainline and backporting after a suitable delay? yes to both. Thanks for "picking" this fruit! Harald Paul Fortran: Fix ICE in gfc_trans_create_temp_array from bad type [PR93678] 2024-04-24 Paul Thomas gcc/fortran PR fortran/93678 * trans-expr.cc (gfc_conv_procedure_call): Use the interface, where possible, to obtain the type of character procedure pointers of class entities. gcc/testsuite/ PR fortran/93678 * gfortran.dg/pr93678.f90: New test.
[gcc r14-10097] Fortran: check C_SIZEOF on additions from TS29113/F2018 [PR103496]
https://gcc.gnu.org/g:0bf94da59feab2c72a02c91df310a36d33dfd1f7
commit r14-10097-g0bf94da59feab2c72a02c91df310a36d33dfd1f7
Author: Harald Anlauf
Date: Tue Apr 23 20:21:43 2024 +0200
Fortran: check C_SIZEOF on additions from TS29113/F2018 [PR103496]
gcc/testsuite/ChangeLog:
PR fortran/103496
* gfortran.dg/c_sizeof_8.f90: New test.
Diff:
---
gcc/testsuite/gfortran.dg/c_sizeof_8.f90 | 23 +++
1 file changed, 23 insertions(+)
diff --git a/gcc/testsuite/gfortran.dg/c_sizeof_8.f90
b/gcc/testsuite/gfortran.dg/c_sizeof_8.f90
new file mode 100644
index 000..0ae284436d0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_sizeof_8.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+!
+! PR fortran/103496
+!
+! Test that C_SIZEOF returns the expected results
+
+program pr103496
+ use iso_c_binding
+ implicit none
+ integer :: a(6)
+ integer, pointer :: p(:)
+
+ if (c_sizeof(a) /= 6*4) stop 1
+ if (c_sizeof(a(1))/= 4) stop 2
+ if (c_sizeof(a(:))/= 6*4) stop 3
+ if (c_sizeof(a(2::2)) /= 3*4) stop 4
+
+ allocate(p(5))
+ if (c_sizeof(p) /= 5*4) stop 5
+ if (c_sizeof(p(1))/= 4) stop 6
+ if (c_sizeof(p(:))/= 5*4) stop 7
+ if (c_sizeof(p(2::2)) /= 2*4) stop 8
+end
Re: [Patch, fortran] PR103471 - [11/12/13/14 Regression] ICE in gfc_typenode_for_spec, at fortran/trans-types.c:1114
Hi Paul! On 4/20/24 09:54, Paul Richard Thomas wrote: subroutine sub implicit none real, external :: x real :: y(10) integer :: kk print *, [real(x(k))] ! print *, [real(y(k))] end This is another problem, somewhere upstream from resolve.cc, which I have just spent an hour failing to find. In the presence of both print statements, in no matter which order, it is the error in trans-decl.cc that applies. Indeed, the gfc_fatal_error always wins. (I had tried to replace it with gfc_error()/return NULL_TREE, but then I hit an ICE later on. When trying to find out who added the said code, guess whom I found :) Thus I have the impression that the testcase tests something different on the one hand, and on the other I wonder if we would want to change the error message and replace "no default type" to "no IMPLICIT type". It still would not hit the fuzzy check, but that is something that might not be important now. The fuzzy check was intended to ensure that the error was being detected in the "right" place. I want to keep the "no default type" message for the time being at least so as to identify exactly where it comes from. Getting to trans-decl.cc with an unknown type is just wrong. True. I'll come back to you on this. This PR is marked as a regression. Depending on your progress, it might be worth to consider fixing what you think is needed to get rid of the regression marker and defer the improvement of the diagnostics to a second patch. Harald Thanks for the report. Paul
Re: [Patch, fortran] PR103471 - [11/12/13/14 Regression] ICE in gfc_typenode_for_spec, at fortran/trans-types.c:1114
Hi Paul, the patch is OK, but I had to manually fix it. I wonder how you managed to produce: diff --git a/gcc/testsuite/gfortran.dg/pr93484.f90 b/gcc/testsuite/gfortran.dg/pr93484.f90 new file mode 100644 index 000..4dcad47e8da --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr103471.f90 @@ -0,0 +1,13 @@ A minor comment on the error message and the testcase. Take for example: subroutine sub implicit none real, external :: x real :: y(10) integer :: kk print *, [real(x(k))] ! print *, [real(y(k))] end The original testcase in the PR would - without implicit none - resemble the function invocation x(k) here and emit the error: Fatal Error: k at (1) has no default type compilation terminated. while commenting the first print and uncommenting the second would emit the message Error: Symbol 'k' at (1) has no IMPLICIT type; did you mean 'kk'? Thus I have the impression that the testcase tests something different on the one hand, and on the other I wonder if we would want to change the error message and replace "no default type" to "no IMPLICIT type". It still would not hit the fuzzy check, but that is something that might not be important now. Thanks, Harald On 4/19/24 18:52, Paul Richard Thomas wrote: Hi All, This is a more or less obvious patch. The action is in resolve.cc. The chunk in symbol.cc is a tidy up of a diagnostic marker to distinguish where the 'no IMPLICIT type' error was coming from and the chunk in trans-decl.cc follows from discussion with Harald on the PR. Regtests fine. OK for mainline and backporting in a couple of weeks? Paul Fortran: Detect 'no implicit type' error in right place [PR103471] 2024-04-19 Paul Thomas gcc/fortran PR fortran/103471 * resolve.cc (gfc_resolve_index_1): Block index expressions of unknown type from being converted to default integer, avoiding the fatal error in trans-decl.cc. * symbol.cc (gfc_set_default_type): Remove '(symbol)' from the 'no IMPLICIT type' error message. * trans-decl.cc (gfc_get_symbol_decl): Change fatal error locus to that of the symbol declaration. (gfc_trans_deferred_vars): Remove two trailing tabs. gcc/testsuite/ PR fortran/103471 * gfortran.dg/pr103471.f90: New test.
[gcc r14-9996] Fortran: ALLOCATE of fixed-length CHARACTER with SOURCE/MOLD [PR113793]
https://gcc.gnu.org/g:48024a99e3c2ae522d0026eedd591390506b68ca
commit r14-9996-g48024a99e3c2ae522d0026eedd591390506b68ca
Author: Harald Anlauf
Date: Sat Apr 13 19:09:24 2024 +0200
Fortran: ALLOCATE of fixed-length CHARACTER with SOURCE/MOLD [PR113793]
F2008 requires for ALLOCATE with SOURCE= or MOLD= specifier that the kind
type parameters of allocate-object and source-expr have the same values.
Add compile-time diagnostics for different character length and a runtime
check (under -fcheck=bounds). Use length from allocate-object to prevent
heap corruption and to allow string padding or truncation on assignment.
gcc/fortran/ChangeLog:
PR fortran/113793
* resolve.cc (resolve_allocate_expr): Reject ALLOCATE with SOURCE=
or MOLD= specifier for unequal length.
* trans-stmt.cc (gfc_trans_allocate): If an allocatable character
variable has fixed length, use it and do not use the source length.
With bounds-checking enabled, add a runtime check for same length.
gcc/testsuite/ChangeLog:
PR fortran/113793
* gfortran.dg/allocate_with_source_29.f90: New test.
* gfortran.dg/allocate_with_source_30.f90: New test.
* gfortran.dg/allocate_with_source_31.f90: New test.
Diff:
---
gcc/fortran/resolve.cc | 10 +
gcc/fortran/trans-stmt.cc | 36 +--
.../gfortran.dg/allocate_with_source_29.f90| 48
.../gfortran.dg/allocate_with_source_30.f90| 51 ++
.../gfortran.dg/allocate_with_source_31.f90| 38
5 files changed, 179 insertions(+), 4 deletions(-)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 4cbf7186119..6b3e5ba4fcb 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -8278,6 +8278,16 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool
*array_alloc_wo_spec)
goto failure;
}
+ /* Check F2008:C639: "Corresponding kind type parameters of
+allocate-object and source-expr shall have the same values." */
+ if (e->ts.type == BT_CHARACTER
+ && !e->ts.deferred
+ && e->ts.u.cl->length
+ && code->expr3->ts.type == BT_CHARACTER
+ && !gfc_check_same_strlen (e, code->expr3, "ALLOCATE with "
+"SOURCE= or MOLD= specifier"))
+ goto failure;
+
/* Check TS18508, C702/C703. */
if (code->expr3->ts.type == BT_DERIVED
&& ((codimension && gfc_expr_attr (code->expr3).event_comp)
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 7997c167bae..c34e0b4c0cd 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -6829,10 +6829,26 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist
*omp_allocate)
in the array is needed, which is the product of the len and
esize for char arrays. For unlimited polymorphics len can be
zero, therefore take the maximum of len and one. */
+ tree lhs_len;
+
+ /* If an allocatable character variable has fixed length, use it.
+Otherwise use source length. As different lengths are not
+allowed by the standard, generate a runtime check. */
+ if (expr->ts.type == BT_CHARACTER && !expr->ts.deferred)
+ {
+ gfc_trans_same_strlen_check ("ALLOCATE with SOURCE= or MOLD=",
+ >expr3->where,
+ se.string_length, expr3_len,
+ );
+ lhs_len = fold_convert (TREE_TYPE (expr3_len), se.string_length);
+ }
+ else
+ lhs_len = expr3_len;
+
tmp = fold_build2_loc (input_location, MAX_EXPR,
TREE_TYPE (expr3_len),
-expr3_len, fold_convert (TREE_TYPE (expr3_len),
- integer_one_node));
+lhs_len, fold_convert (TREE_TYPE (expr3_len),
+ integer_one_node));
tmp = fold_build2_loc (input_location, MULT_EXPR,
TREE_TYPE (expr3_esize), expr3_esize,
fold_convert (TREE_TYPE (expr3_esize), tmp));
@@ -6877,10 +6893,22 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist
*omp_allocate)
allocate.
expr3_len is set when expr3 is an unlimited polymorphic
-object or a deferred length string. */
+object or a deferred length string.
+
+If an allocatable
[PATCH] Fortran: ALLOCATE of fixed-length CHARACTER with SOURCE/MOLD [PR113793]
Dear all,
the attached patch adds the following:
- diagnostics of different string length of allocate-object and of the
source-expr (SOURCE/MOLD) as hard error when it can be determined at
compile-time
- a runtime-diagnostics und -fcheck=bounds (reuse of existing checks)
- a fallback solution (GNU extension) to use the length of allocate-object
if the length mismatch is not diagnosed at compile-time or runtime.
This avoids heap corruption and leads to string truncation or padding
during assignment.
F2008 demands same values of the kind type parameters, and this is
diagnosed by NAG. It also always gives a hard error, even at runtime.
Some brands (NVidia, AMD flang) tolerate a length mismatch silently
and perform string truncation or padding, without crashing.
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
From b9ece695a178319e35cd9f36cc731855302dd57f Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Sat, 13 Apr 2024 19:09:24 +0200
Subject: [PATCH] Fortran: ALLOCATE of fixed-length CHARACTER with SOURCE/MOLD
[PR113793]
F2008 requires for ALLOCATE with SOURCE= or MOLD= specifier that the kind
type parameters of allocate-object and source-expr have the same values.
Add compile-time diagnostics for different character length and a runtime
check (under -fcheck=bounds). Use length from allocate-object to prevent
heap corruption and to allow string padding or truncation on assignment.
gcc/fortran/ChangeLog:
PR fortran/113793
* resolve.cc (resolve_allocate_expr): Reject ALLOCATE with SOURCE=
or MOLD= specifier for unequal length.
* trans-stmt.cc (gfc_trans_allocate): If an allocatable character
variable has fixed length, use it and do not use the source length.
With bounds-checking enabled, add a runtime check for same length.
gcc/testsuite/ChangeLog:
PR fortran/113793
* gfortran.dg/allocate_with_source_29.f90: New test.
* gfortran.dg/allocate_with_source_30.f90: New test.
* gfortran.dg/allocate_with_source_31.f90: New test.
---
gcc/fortran/resolve.cc| 10
gcc/fortran/trans-stmt.cc | 36 +++--
.../gfortran.dg/allocate_with_source_29.f90 | 48 +
.../gfortran.dg/allocate_with_source_30.f90 | 51 +++
.../gfortran.dg/allocate_with_source_31.f90 | 38 ++
5 files changed, 179 insertions(+), 4 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/allocate_with_source_29.f90
create mode 100644 gcc/testsuite/gfortran.dg/allocate_with_source_30.f90
create mode 100644 gcc/testsuite/gfortran.dg/allocate_with_source_31.f90
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 4cbf7186119..6b3e5ba4fcb 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -8278,6 +8278,16 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec)
goto failure;
}
+ /* Check F2008:C639: "Corresponding kind type parameters of
+ allocate-object and source-expr shall have the same values." */
+ if (e->ts.type == BT_CHARACTER
+ && !e->ts.deferred
+ && e->ts.u.cl->length
+ && code->expr3->ts.type == BT_CHARACTER
+ && !gfc_check_same_strlen (e, code->expr3, "ALLOCATE with "
+ "SOURCE= or MOLD= specifier"))
+ goto failure;
+
/* Check TS18508, C702/C703. */
if (code->expr3->ts.type == BT_DERIVED
&& ((codimension && gfc_expr_attr (code->expr3).event_comp)
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 7997c167bae..c34e0b4c0cd 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -6829,10 +6829,26 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate)
in the array is needed, which is the product of the len and
esize for char arrays. For unlimited polymorphics len can be
zero, therefore take the maximum of len and one. */
+ tree lhs_len;
+
+ /* If an allocatable character variable has fixed length, use it.
+ Otherwise use source length. As different lengths are not
+ allowed by the standard, generate a runtime check. */
+ if (expr->ts.type == BT_CHARACTER && !expr->ts.deferred)
+ {
+ gfc_trans_same_strlen_check ("ALLOCATE with SOURCE= or MOLD=",
+ >expr3->where,
+ se.string_length, expr3_len,
+ );
+ lhs_len = fold_convert (TREE_TYPE (expr3_len), se.string_length);
+ }
+ else
+ lhs_len = expr3_len;
+
tmp = fold_build2_loc (input_location, MAX_EXPR,
TREE_TYPE (expr3_len),
- expr3_len, fold_convert (TREE_TYPE (expr3_len),
- integer_one_node));
+ lhs_len, fold_convert (TREE_TYPE (expr3_len),
+ integer_one_node));
tmp = fold_build2_loc (input_location, MULT_EXPR,
TREE_TYPE (expr3_esize), expr3_esize,
fold_convert (TREE_TYPE (expr3_esize), tmp));
@@ -687
Re: [Patch, fortran] PR113363 - ICE on ASSOCIATE and unlimited polymorphic function
Hi Paul!
On 4/10/24 10:25, Paul Richard Thomas wrote:
Hi All,
This patch corrects incorrect results from assignment of unlimited
polymorphic function results both in assignment statements and allocation
with source.
The first chunk in trans-array.cc ensures that the array dtype is set to
the source dtype. The second chunk ensures that the lhs _len field does not
default to zero and so is specific to dynamic types of character.
The addition to trans-stmt.cc transforms the source expression, aka expr3,
from a derived type of type "STAR" into a proper unlimited polymorphic
expression ready for assignment to the newly allocated entity.
I am wondering about the following snippet in trans-stmt.cc:
+ /* Copy over the lhs _data component ref followed by the
+full array reference for source expressions with rank.
+Otherwise, just copy the _data component ref. */
+ if (code->expr3->rank
+ && ref && ref->next && !ref->next->next)
+ {
+ rhs->ref = gfc_copy_ref (ref);
+ rhs->ref->next = gfc_copy_ref (ref->next);
+ break;
+ }
Why the two gfc_copy_ref? valgrind pointed my to the tail
of gfc_copy_ref which already has:
dest->next = gfc_copy_ref (src->next);
so this looks redundant and leaks frontend memory?
***
Playing with the testcase, I find several invalid writes with
valgrind, or a heap buffer overflow with -fsanitize=address .
It is sufficient to look at a mini-test where the class(*) function
result is assigned to the class(*), allocatable in the main:
x = foo ()
deallocate (x)
The dump tree suggests that array bounds in foo() are read before
they are properly set.
These invalid writes do not occur with 13-branch, so this might
be a regression.
Can you have a look yourself?
Thanks,
Harald
OK for mainline?
Paul
Fortran: Fix wrong code in unlimited polymorphic assignment [PR113363]
2024-04-10 Paul Thomas
gcc/fortran
PR fortran/113363
* trans-array.cc (gfc_array_init_size): Use the expr3 dtype so
that the correct element size is used.
(gfc_alloc_allocatable_for_assignment): Set the _len field for
unlimited polymorphic assignments.
* trans-stmt.cc (gfc_trans_allocate): Build a correct rhs for
the assignment of an unlimited polymorphic 'source'.
gcc/testsuite/
PR fortran/113363
* gfortran.dg/pr113363.f90: New test.
[gcc r14-9893] Fortran: fix argument checking of intrinsics C_SIZEOF, C_F_POINTER [PR106500]
https://gcc.gnu.org/g:ded646c91d2c0fb908faf6fa8fe1df0d7df49d16
commit r14-9893-gded646c91d2c0fb908faf6fa8fe1df0d7df49d16
Author: Harald Anlauf
Date: Tue Apr 9 23:07:59 2024 +0200
Fortran: fix argument checking of intrinsics C_SIZEOF, C_F_POINTER
[PR106500]
The interpretation of the F2018 standard regarding valid arguments to the
intrinsic C_SIZEOF(X) was clarified in an edit to 18-007r1:
https://j3-fortran.org/doc/year/22/22-101r1.txt
loosening restrictions and giving examples. The F2023 text has:
! F2023:18.2.3.8 C_SIZEOF (X)
!
! X shall be a data entity with interoperable type and type parameters,
! and shall not be an assumed-size array, an assumed-rank array that
! is associated with an assumed-size array, an unallocated allocatable
! variable, or a pointer that is not associated.
where
! 3.41 data entity
! data object, result of the evaluation of an expression, or the
! result of the execution of a function reference
Update the checking code for interoperable arguments accordingly, and extend
to reject functions returning pointer as FPTR argument to C_F_POINTER.
gcc/fortran/ChangeLog:
PR fortran/106500
* check.cc (is_c_interoperable): Fix checks for C_SIZEOF.
(gfc_check_c_f_pointer): Reject function returning a pointer as
FPTR,
and improve an error message.
gcc/testsuite/ChangeLog:
PR fortran/106500
* gfortran.dg/c_sizeof_6.f90: Remove wrong dg-error.
* gfortran.dg/sizeof_2.f90: Adjust pattern.
* gfortran.dg/c_f_pointer_tests_9.f90: New test.
* gfortran.dg/c_sizeof_7.f90: New test.
Diff:
---
gcc/fortran/check.cc | 26 --
gcc/testsuite/gfortran.dg/c_f_pointer_tests_9.f90 | 37
gcc/testsuite/gfortran.dg/c_sizeof_6.f90 | 2 +-
gcc/testsuite/gfortran.dg/c_sizeof_7.f90 | 42 +++
gcc/testsuite/gfortran.dg/sizeof_2.f90| 2 +-
5 files changed, 96 insertions(+), 13 deletions(-)
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index db74dcf3f40..2f50d84b876 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -5299,18 +5299,14 @@ is_c_interoperable (gfc_expr *expr, const char **msg,
bool c_loc, bool c_f_ptr)
return false;
}
- if (!c_loc && expr->rank > 0 && expr->expr_type != EXPR_ARRAY)
+ /* Checks for C_SIZEOF need to take into account edits to 18-007r1, see
+ https://j3-fortran.org/doc/year/22/22-101r1.txt . */
+ if (!c_loc && !c_f_ptr && expr->rank > 0 && expr->expr_type == EXPR_VARIABLE)
{
gfc_array_ref *ar = gfc_find_array_ref (expr);
- if (ar->type != AR_FULL)
+ if (ar->type == AR_FULL && ar->as->type == AS_ASSUMED_SIZE)
{
- *msg = "Only whole-arrays are interoperable";
- return false;
- }
- if (!c_f_ptr && ar->as->type != AS_EXPLICIT
- && ar->as->type != AS_ASSUMED_SIZE)
- {
- *msg = "Only explicit-size and assumed-size arrays are interoperable";
+ *msg = "Assumed-size arrays are not interoperable";
return false;
}
}
@@ -5475,9 +5471,17 @@ gfc_check_c_f_pointer (gfc_expr *cptr, gfc_expr *fptr,
gfc_expr *shape)
return false;
}
+ if (fptr->ts.type == BT_PROCEDURE && attr.function)
+{
+ gfc_error ("FPTR argument to C_F_POINTER at %L is a function "
+"returning a pointer", >where);
+ return false;
+}
+
if (fptr->rank > 0 && !is_c_interoperable (fptr, , false, true))
-return gfc_notify_std (GFC_STD_F2018, "Noninteroperable array FPTR "
- "at %L to C_F_POINTER: %s", >where, msg);
+return gfc_notify_std (GFC_STD_F2018,
+ "Noninteroperable array FPTR argument to "
+ "C_F_POINTER at %L: %s", >where, msg);
return true;
}
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_tests_9.f90
b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_9.f90
new file mode 100644
index 000..8c8b4a713a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_9.f90
@@ -0,0 +1,37 @@
+! { dg-do compile }
+!
+! A function returning a pointer cannot be interoperable
+! and cannot be used as FPTR argument to C_F_POINTER.
+
+subroutine s ()
+ use, intrinsic :: iso_c_binding
+ implicit none
+ type(c_ptr) :: cPtr
+ call c_f_pointer (cPtr, p0)! { dg-error "function returning a
pointer" }
+ call c_f_pointer (cPtr, p1, shape=[2]) ! { dg-error "function returning a
pointer" }
+contains
+ function p0 ()
+
[PATCH, v2] Fortran: fix argument checking of intrinsics C_SIZEOF, C_F_POINTER [PR106500]
Hi FX!
On 4/9/24 09:32, FX Coudert wrote:
Hi Harald,
Thanks for the patch.
+ if (attr.function)
+{
+ gfc_error ("FPTR at %L to C_F_POINTER is a function returning a pointer",
+ >where);
+ return false;
+}
+
if (fptr->rank > 0 && !is_c_interoperable (fptr, , false, true))
return gfc_notify_std (GFC_STD_F2018, "Noninteroperable array FPTR "
"at %L to C_F_POINTER: %s", >where, msg);
In both of these gfc_error(), could we change our error message to say "FPTR
argument” instead of “FPTR”? “FPTR to C_F_POINTER” does not really make sense to me.
This would be more in line with what the generally do:
Error: 'x' argument of 'sqrt' intrinsic at (1) must be REAL or COMPLEX
So maybe “FPTR argument to C_F_POINTER at %L” ? That’s much more readable to me.
Good point! I did indeed feel a little uncomfortable with the text
and adjusted both messages accordingly to your suggestion.
I also forgot to add one update of a pattern, and found a cornercase
where the tightening of checks for C_F_POINTER was too strong.
Corrected and now covered in an extension of the corresponding testcase.
Otherwise, OK.
FX
Thanks for the review!
If there are no further comments, I will commit tomorrow.
Thanks,
Harald
From 5983a07f11c88d920241141732fa742735cdb8ea Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Tue, 9 Apr 2024 23:07:59 +0200
Subject: [PATCH] Fortran: fix argument checking of intrinsics C_SIZEOF,
C_F_POINTER [PR106500]
The interpretation of the F2018 standard regarding valid arguments to the
intrinsic C_SIZEOF(X) was clarified in an edit to 18-007r1:
https://j3-fortran.org/doc/year/22/22-101r1.txt
loosening restrictions and giving examples. The F2023 text has:
! F2023:18.2.3.8 C_SIZEOF (X)
!
! X shall be a data entity with interoperable type and type parameters,
! and shall not be an assumed-size array, an assumed-rank array that
! is associated with an assumed-size array, an unallocated allocatable
! variable, or a pointer that is not associated.
where
! 3.41 data entity
! data object, result of the evaluation of an expression, or the
! result of the execution of a function reference
Update the checking code for interoperable arguments accordingly, and extend
to reject functions returning pointer as FPTR argument to C_F_POINTER.
gcc/fortran/ChangeLog:
PR fortran/106500
* check.cc (is_c_interoperable): Fix checks for C_SIZEOF.
(gfc_check_c_f_pointer): Reject function returning a pointer as FPTR,
and improve an error message.
gcc/testsuite/ChangeLog:
PR fortran/106500
* gfortran.dg/c_sizeof_6.f90: Remove wrong dg-error.
* gfortran.dg/sizeof_2.f90: Adjust pattern.
* gfortran.dg/c_f_pointer_tests_9.f90: New test.
* gfortran.dg/c_sizeof_7.f90: New test.
---
gcc/fortran/check.cc | 26 +++-
.../gfortran.dg/c_f_pointer_tests_9.f90 | 37
gcc/testsuite/gfortran.dg/c_sizeof_6.f90 | 2 +-
gcc/testsuite/gfortran.dg/c_sizeof_7.f90 | 42 +++
gcc/testsuite/gfortran.dg/sizeof_2.f90| 2 +-
5 files changed, 96 insertions(+), 13 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/c_f_pointer_tests_9.f90
create mode 100644 gcc/testsuite/gfortran.dg/c_sizeof_7.f90
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index db74dcf3f40..2f50d84b876 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -5299,18 +5299,14 @@ is_c_interoperable (gfc_expr *expr, const char **msg, bool c_loc, bool c_f_ptr)
return false;
}
- if (!c_loc && expr->rank > 0 && expr->expr_type != EXPR_ARRAY)
+ /* Checks for C_SIZEOF need to take into account edits to 18-007r1, see
+ https://j3-fortran.org/doc/year/22/22-101r1.txt . */
+ if (!c_loc && !c_f_ptr && expr->rank > 0 && expr->expr_type == EXPR_VARIABLE)
{
gfc_array_ref *ar = gfc_find_array_ref (expr);
- if (ar->type != AR_FULL)
+ if (ar->type == AR_FULL && ar->as->type == AS_ASSUMED_SIZE)
{
- *msg = "Only whole-arrays are interoperable";
- return false;
- }
- if (!c_f_ptr && ar->as->type != AS_EXPLICIT
- && ar->as->type != AS_ASSUMED_SIZE)
- {
- *msg = "Only explicit-size and assumed-size arrays are interoperable";
+ *msg = "Assumed-size arrays are not interoperable";
return false;
}
}
@@ -5475,9 +5471,17 @@ gfc_check_c_f_pointer (gfc_expr *cptr, gfc_expr *fptr, gfc_expr *shape)
return false;
}
+ if (fptr->ts.type == BT_PROCEDURE && attr.function)
+{
+ gfc_error ("FPTR argument to C_F_POINTER at %L is a function "
+ "returning a pointer", >where);
+ return false;
+}
+
if (fptr->rank > 0 && !is_c_interoperable (fptr, , false, true))
-return gfc_notify_std (GFC_ST
[PATCH] Fortran: fix argument checking of intrinsics C_SIZEOF, C_F_POINTER [PR106500]
Dear all,
the attached patch fixes argument checking of:
- C_SIZEOF - rejects-valid (see below) and ICE-on-valid
- C_F_POINTER - ICE-on-invalid
The interesting part is that C_SIZEOF was not well specified until
after F2018, where an interp request lead to an edit that actually
loosened restrictions and makes the checking much more straightforward,
since expressions and function results are now allowed.
I've added references to the relevant text and interp in the commit message.
While updating the checking code shared between C_SIZEOF and C_F_POINTER,
I figured that the latter missed a check preventing an ICE-on-invalid
when a function returning a pointer was passed.
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
From 6f412a6399a7e125db835584d3d2489a52150c27 Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Mon, 8 Apr 2024 21:43:24 +0200
Subject: [PATCH] Fortran: fix argument checking of intrinsics C_SIZEOF,
C_F_POINTER [PR106500]
The interpretation of the F2018 standard regarding valid arguments to the
intrinsic C_SIZEOF(X) was clarified in an edit to 18-007r1:
https://j3-fortran.org/doc/year/22/22-101r1.txt
loosening restrictions and giving examples. The F2023 text has:
! F2023:18.2.3.8 C_SIZEOF (X)
!
! X shall be a data entity with interoperable type and type parameters,
! and shall not be an assumed-size array, an assumed-rank array that
! is associated with an assumed-size array, an unallocated allocatable
! variable, or a pointer that is not associated.
where
! 3.41 data entity
! data object, result of the evaluation of an expression, or the
! result of the execution of a function reference
Update the checking code for interoperable arguments accordingly, and extend
to reject functions returning pointer as FPTR argument to C_F_POINTER.
gcc/fortran/ChangeLog:
PR fortran/106500
* check.cc (is_c_interoperable): Fix checks for C_SIZEOF.
(gfc_check_c_f_pointer): Reject function returning a pointer as FPTR.
gcc/testsuite/ChangeLog:
PR fortran/106500
* gfortran.dg/c_sizeof_6.f90: Remove wrong dg-error.
* gfortran.dg/c_f_pointer_tests_9.f90: New test.
* gfortran.dg/c_sizeof_7.f90: New test.
---
gcc/fortran/check.cc | 21 ++
.../gfortran.dg/c_f_pointer_tests_9.f90 | 21 ++
gcc/testsuite/gfortran.dg/c_sizeof_6.f90 | 2 +-
gcc/testsuite/gfortran.dg/c_sizeof_7.f90 | 42 +++
4 files changed, 76 insertions(+), 10 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/c_f_pointer_tests_9.f90
create mode 100644 gcc/testsuite/gfortran.dg/c_sizeof_7.f90
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index db74dcf3f40..b7f60575c67 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -5299,18 +5299,14 @@ is_c_interoperable (gfc_expr *expr, const char **msg, bool c_loc, bool c_f_ptr)
return false;
}
- if (!c_loc && expr->rank > 0 && expr->expr_type != EXPR_ARRAY)
+ /* Checks for C_SIZEOF need to take into account edits to 18-007r1, see
+ https://j3-fortran.org/doc/year/22/22-101r1.txt . */
+ if (!c_loc && !c_f_ptr && expr->rank > 0 && expr->expr_type == EXPR_VARIABLE)
{
gfc_array_ref *ar = gfc_find_array_ref (expr);
- if (ar->type != AR_FULL)
+ if (ar->type == AR_FULL && ar->as->type == AS_ASSUMED_SIZE)
{
- *msg = "Only whole-arrays are interoperable";
- return false;
- }
- if (!c_f_ptr && ar->as->type != AS_EXPLICIT
- && ar->as->type != AS_ASSUMED_SIZE)
- {
- *msg = "Only explicit-size and assumed-size arrays are interoperable";
+ *msg = "Assumed-size arrays are not interoperable";
return false;
}
}
@@ -5475,6 +5471,13 @@ gfc_check_c_f_pointer (gfc_expr *cptr, gfc_expr *fptr, gfc_expr *shape)
return false;
}
+ if (attr.function)
+{
+ gfc_error ("FPTR at %L to C_F_POINTER is a function returning a pointer",
+ >where);
+ return false;
+}
+
if (fptr->rank > 0 && !is_c_interoperable (fptr, , false, true))
return gfc_notify_std (GFC_STD_F2018, "Noninteroperable array FPTR "
"at %L to C_F_POINTER: %s", >where, msg);
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_tests_9.f90 b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_9.f90
new file mode 100644
index 000..bb6d3281b02
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_9.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+!
+! A function returning a pointer cannot be interoperable
+! and cannot be used as FPTR argument to C_F_POINTER.
+
+subroutine s ()
+ use, intrinsic :: iso_c_binding
+ implicit none
+ type(c_ptr) :: cPtr
+ call c_f_pointer (cPtr, p0)! { dg-error "function returning a pointer" }
+ call c_f_pointer (cPtr, p1, shape=[2]) ! { dg-error "functio
[gcc r11-11311] Fortran: fix DATA and derived types with pointer components [PR114474]
https://gcc.gnu.org/g:619fc13043c86d616ef57cb31f8ac5d29b059ade
commit r11-11311-g619fc13043c86d616ef57cb31f8ac5d29b059ade
Author: Harald Anlauf
Date: Wed Mar 27 21:18:04 2024 +0100
Fortran: fix DATA and derived types with pointer components [PR114474]
When matching actual arguments in match_actual_arg, these are initially
treated as a possible dummy procedure, assuming that the correct type is
determined later. This resolution could fail when the procedure is a
derived type constructor with a pointer component and appears in a DATA
statement, where the pointer shall be associated with an initial data
target. Check for those cases where the type obviously has not been
resolved yet, and which were missed because there was no component
reference.
gcc/fortran/ChangeLog:
PR fortran/114474
* primary.c (gfc_variable_attr): Catch variables used in structure
constructors within DATA statements that are still tagged with a
temporary type BT_PROCEDURE from match_actual_arg and which have the
target attribute, and fix their typespec.
gcc/testsuite/ChangeLog:
PR fortran/114474
* gfortran.dg/data_pointer_3.f90: New test.
(cherry picked from commit bbb7c513dddc5c9b2d5e9b78bc1c2f85a0cfe07e)
Diff:
---
gcc/fortran/primary.c| 12 +
gcc/testsuite/gfortran.dg/data_pointer_3.f90 | 77
2 files changed, 89 insertions(+)
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 5cad2d2682b..79a2201c812 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -2663,6 +2663,18 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
if (ts != NULL && expr->ts.type == BT_UNKNOWN)
*ts = sym->ts;
+ /* Catch left-overs from match_actual_arg, where an actual argument of a
+ procedure is given a temporary ts.type == BT_PROCEDURE. The fixup is
+ needed for structure constructors in DATA statements, where a pointer
+ is associated with a data target, and the argument has not been fully
+ resolved yet. Components references are dealt with further below. */
+ if (ts != NULL
+ && expr->ts.type == BT_PROCEDURE
+ && expr->ref == NULL
+ && attr.flavor != FL_PROCEDURE
+ && attr.target)
+*ts = sym->ts;
+
has_inquiry_part = false;
for (ref = expr->ref; ref; ref = ref->next)
if (ref->type == REF_INQUIRY)
diff --git a/gcc/testsuite/gfortran.dg/data_pointer_3.f90
b/gcc/testsuite/gfortran.dg/data_pointer_3.f90
new file mode 100644
index 000..49c288e93b9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_pointer_3.f90
@@ -0,0 +1,77 @@
+! { dg-do compile }
+! PR fortran/114474 - DATA and derived types with pointer components
+
+program pr114474
+ implicit none
+ integer, target :: ii = 42! initial data target
+
+ integer, target :: jj = 24
+ integer, pointer:: qq => jj
+ ! ii and jj resolve slightly differently when the data statement below
+ ! is reached, as jj is resolved outside the structure constructor first
+
+ type t
+ integer, pointer :: h
+ end type t
+
+ integer, target :: kk(7) = 23
+ integer, pointer:: ll(:) => kk
+
+ type t1
+ integer :: m(7)
+ end type t1
+
+ type(t) :: x1, x2, x3, x4, x5
+ type(t), parameter :: z1 = t(null())
+
+ type(t1), target:: tt = t1([1,2,3,4,5,6,7])
+ type(t1), parameter :: vv = t1(22)
+ type(t1):: w1, w2
+ integer, pointer :: p1(:) => tt% m
+
+ data x1 / t(null()) /
+ data x2 / t(ii) / ! ii is initial data target
+ data x3 / t(jj) / ! jj is resolved differently...
+ data x4 / t(tt%m(3)) / ! pointer association with 3rd element
+
+ data w1 / t1(12) /
+ data w2 / t1(vv%m) /
+
+ if ( associated (x1% h)) stop 1
+ if (.not. associated (x2% h)) stop 2
+ if (.not. associated (x3% h)) stop 3
+ if (.not. associated (x4% h)) stop 4
+ if (x2% h /= 42) stop 5
+ if (x3% h /= 24) stop 6
+ if (x4% h /= 3) stop 7
+
+ if (any (w1%m /= 12 )) stop 8
+ if (any (w2%m /= vv%m)) stop 9
+end
+
+
+subroutine sub
+ implicit none
+
+ interface
+ real function myfun (x)
+ real, intent(in) :: x
+ end function myfun
+ end interface
+
+ type u
+ procedure(myfun), pointer, nopass :: p
+ end type u
+
+ type(u):: u3 = u(null())
+ type(u), parameter :: u4 = u(null())
+ type(u):: u1, u2
+
+ data u1 / u(null()) /
+ data u2 / u(myfun) /
+end
+
+real function myfun (x)
+ real, intent(in) :: x
+ myfun = x
+end function myfun
[gcc r12-10314] Fortran: fix DATA and derived types with pointer components [PR114474]
https://gcc.gnu.org/g:88abe04de2f16f773126f3908632a27568330cc9
commit r12-10314-g88abe04de2f16f773126f3908632a27568330cc9
Author: Harald Anlauf
Date: Wed Mar 27 21:18:04 2024 +0100
Fortran: fix DATA and derived types with pointer components [PR114474]
When matching actual arguments in match_actual_arg, these are initially
treated as a possible dummy procedure, assuming that the correct type is
determined later. This resolution could fail when the procedure is a
derived type constructor with a pointer component and appears in a DATA
statement, where the pointer shall be associated with an initial data
target. Check for those cases where the type obviously has not been
resolved yet, and which were missed because there was no component
reference.
gcc/fortran/ChangeLog:
PR fortran/114474
* primary.cc (gfc_variable_attr): Catch variables used in structure
constructors within DATA statements that are still tagged with a
temporary type BT_PROCEDURE from match_actual_arg and which have the
target attribute, and fix their typespec.
gcc/testsuite/ChangeLog:
PR fortran/114474
* gfortran.dg/data_pointer_3.f90: New test.
(cherry picked from commit bbb7c513dddc5c9b2d5e9b78bc1c2f85a0cfe07e)
Diff:
---
gcc/fortran/primary.cc | 12 +
gcc/testsuite/gfortran.dg/data_pointer_3.f90 | 77
2 files changed, 89 insertions(+)
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 1ae6a12e0b7..78295c54b6c 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2664,6 +2664,18 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
if (ts != NULL && expr->ts.type == BT_UNKNOWN)
*ts = sym->ts;
+ /* Catch left-overs from match_actual_arg, where an actual argument of a
+ procedure is given a temporary ts.type == BT_PROCEDURE. The fixup is
+ needed for structure constructors in DATA statements, where a pointer
+ is associated with a data target, and the argument has not been fully
+ resolved yet. Components references are dealt with further below. */
+ if (ts != NULL
+ && expr->ts.type == BT_PROCEDURE
+ && expr->ref == NULL
+ && attr.flavor != FL_PROCEDURE
+ && attr.target)
+*ts = sym->ts;
+
has_inquiry_part = false;
for (ref = expr->ref; ref; ref = ref->next)
if (ref->type == REF_INQUIRY)
diff --git a/gcc/testsuite/gfortran.dg/data_pointer_3.f90
b/gcc/testsuite/gfortran.dg/data_pointer_3.f90
new file mode 100644
index 000..49c288e93b9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_pointer_3.f90
@@ -0,0 +1,77 @@
+! { dg-do compile }
+! PR fortran/114474 - DATA and derived types with pointer components
+
+program pr114474
+ implicit none
+ integer, target :: ii = 42! initial data target
+
+ integer, target :: jj = 24
+ integer, pointer:: qq => jj
+ ! ii and jj resolve slightly differently when the data statement below
+ ! is reached, as jj is resolved outside the structure constructor first
+
+ type t
+ integer, pointer :: h
+ end type t
+
+ integer, target :: kk(7) = 23
+ integer, pointer:: ll(:) => kk
+
+ type t1
+ integer :: m(7)
+ end type t1
+
+ type(t) :: x1, x2, x3, x4, x5
+ type(t), parameter :: z1 = t(null())
+
+ type(t1), target:: tt = t1([1,2,3,4,5,6,7])
+ type(t1), parameter :: vv = t1(22)
+ type(t1):: w1, w2
+ integer, pointer :: p1(:) => tt% m
+
+ data x1 / t(null()) /
+ data x2 / t(ii) / ! ii is initial data target
+ data x3 / t(jj) / ! jj is resolved differently...
+ data x4 / t(tt%m(3)) / ! pointer association with 3rd element
+
+ data w1 / t1(12) /
+ data w2 / t1(vv%m) /
+
+ if ( associated (x1% h)) stop 1
+ if (.not. associated (x2% h)) stop 2
+ if (.not. associated (x3% h)) stop 3
+ if (.not. associated (x4% h)) stop 4
+ if (x2% h /= 42) stop 5
+ if (x3% h /= 24) stop 6
+ if (x4% h /= 3) stop 7
+
+ if (any (w1%m /= 12 )) stop 8
+ if (any (w2%m /= vv%m)) stop 9
+end
+
+
+subroutine sub
+ implicit none
+
+ interface
+ real function myfun (x)
+ real, intent(in) :: x
+ end function myfun
+ end interface
+
+ type u
+ procedure(myfun), pointer, nopass :: p
+ end type u
+
+ type(u):: u3 = u(null())
+ type(u), parameter :: u4 = u(null())
+ type(u):: u1, u2
+
+ data u1 / u(null()) /
+ data u2 / u(myfun) /
+end
+
+real function myfun (x)
+ real, intent(in) :: x
+ myfun = x
+end function myfun
[gcc r13-8592] Fortran: fix DATA and derived types with pointer components [PR114474]
https://gcc.gnu.org/g:0d4862691d2b58f7bd2d58de0e78bc574c313d39
commit r13-8592-g0d4862691d2b58f7bd2d58de0e78bc574c313d39
Author: Harald Anlauf
Date: Wed Mar 27 21:18:04 2024 +0100
Fortran: fix DATA and derived types with pointer components [PR114474]
When matching actual arguments in match_actual_arg, these are initially
treated as a possible dummy procedure, assuming that the correct type is
determined later. This resolution could fail when the procedure is a
derived type constructor with a pointer component and appears in a DATA
statement, where the pointer shall be associated with an initial data
target. Check for those cases where the type obviously has not been
resolved yet, and which were missed because there was no component
reference.
gcc/fortran/ChangeLog:
PR fortran/114474
* primary.cc (gfc_variable_attr): Catch variables used in structure
constructors within DATA statements that are still tagged with a
temporary type BT_PROCEDURE from match_actual_arg and which have the
target attribute, and fix their typespec.
gcc/testsuite/ChangeLog:
PR fortran/114474
* gfortran.dg/data_pointer_3.f90: New test.
(cherry picked from commit bbb7c513dddc5c9b2d5e9b78bc1c2f85a0cfe07e)
Diff:
---
gcc/fortran/primary.cc | 12 +
gcc/testsuite/gfortran.dg/data_pointer_3.f90 | 77
2 files changed, 89 insertions(+)
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index c6a119c73cb..edbd162ed13 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2672,6 +2672,18 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
if (ts != NULL && expr->ts.type == BT_UNKNOWN)
*ts = sym->ts;
+ /* Catch left-overs from match_actual_arg, where an actual argument of a
+ procedure is given a temporary ts.type == BT_PROCEDURE. The fixup is
+ needed for structure constructors in DATA statements, where a pointer
+ is associated with a data target, and the argument has not been fully
+ resolved yet. Components references are dealt with further below. */
+ if (ts != NULL
+ && expr->ts.type == BT_PROCEDURE
+ && expr->ref == NULL
+ && attr.flavor != FL_PROCEDURE
+ && attr.target)
+*ts = sym->ts;
+
has_inquiry_part = false;
for (ref = expr->ref; ref; ref = ref->next)
if (ref->type == REF_INQUIRY)
diff --git a/gcc/testsuite/gfortran.dg/data_pointer_3.f90
b/gcc/testsuite/gfortran.dg/data_pointer_3.f90
new file mode 100644
index 000..49c288e93b9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_pointer_3.f90
@@ -0,0 +1,77 @@
+! { dg-do compile }
+! PR fortran/114474 - DATA and derived types with pointer components
+
+program pr114474
+ implicit none
+ integer, target :: ii = 42! initial data target
+
+ integer, target :: jj = 24
+ integer, pointer:: qq => jj
+ ! ii and jj resolve slightly differently when the data statement below
+ ! is reached, as jj is resolved outside the structure constructor first
+
+ type t
+ integer, pointer :: h
+ end type t
+
+ integer, target :: kk(7) = 23
+ integer, pointer:: ll(:) => kk
+
+ type t1
+ integer :: m(7)
+ end type t1
+
+ type(t) :: x1, x2, x3, x4, x5
+ type(t), parameter :: z1 = t(null())
+
+ type(t1), target:: tt = t1([1,2,3,4,5,6,7])
+ type(t1), parameter :: vv = t1(22)
+ type(t1):: w1, w2
+ integer, pointer :: p1(:) => tt% m
+
+ data x1 / t(null()) /
+ data x2 / t(ii) / ! ii is initial data target
+ data x3 / t(jj) / ! jj is resolved differently...
+ data x4 / t(tt%m(3)) / ! pointer association with 3rd element
+
+ data w1 / t1(12) /
+ data w2 / t1(vv%m) /
+
+ if ( associated (x1% h)) stop 1
+ if (.not. associated (x2% h)) stop 2
+ if (.not. associated (x3% h)) stop 3
+ if (.not. associated (x4% h)) stop 4
+ if (x2% h /= 42) stop 5
+ if (x3% h /= 24) stop 6
+ if (x4% h /= 3) stop 7
+
+ if (any (w1%m /= 12 )) stop 8
+ if (any (w2%m /= vv%m)) stop 9
+end
+
+
+subroutine sub
+ implicit none
+
+ interface
+ real function myfun (x)
+ real, intent(in) :: x
+ end function myfun
+ end interface
+
+ type u
+ procedure(myfun), pointer, nopass :: p
+ end type u
+
+ type(u):: u3 = u(null())
+ type(u), parameter :: u4 = u(null())
+ type(u):: u1, u2
+
+ data u1 / u(null()) /
+ data u2 / u(myfun) /
+end
+
+real function myfun (x)
+ real, intent(in) :: x
+ myfun = x
+end function myfun
[gcc r11-11310] fortran: Fix setting of array lower bound for named arrays
https://gcc.gnu.org/g:b755a7af1f2ef1f5348d04db20f751e898abcd9d
commit r11-11310-gb755a7af1f2ef1f5348d04db20f751e898abcd9d
Author: Chung-Lin Tang
Date: Fri Dec 3 17:27:17 2021 +0800
fortran: Fix setting of array lower bound for named arrays
This patch fixes a case of setting array low-bounds, found for particular
uses
of SOURCE=/MOLD=. This adjusts the relevant part in gfc_trans_allocate() to
set e3_has_nodescriptor only for non-named arrays.
2021-12-03 Tobias Burnus
gcc/fortran/ChangeLog:
* trans-stmt.c (gfc_trans_allocate): Set e3_has_nodescriptor to true
only for non-named arrays.
gcc/testsuite/ChangeLog:
* gfortran.dg/allocate_with_source_26.f90: Adjust testcase.
* gfortran.dg/allocate_with_mold_4.f90: New testcase.
(cherry picked from commit 6262e3a22b3d86afc116480bc59a7bb30b0cfd40)
Diff:
---
gcc/fortran/trans-stmt.c | 17 +++
gcc/testsuite/gfortran.dg/allocate_with_mold_4.f90 | 24 ++
.../gfortran.dg/allocate_with_source_26.f90| 8
3 files changed, 35 insertions(+), 14 deletions(-)
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 0e387bbb4e6..0f920c496a0 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -6661,16 +6661,13 @@ gfc_trans_allocate (gfc_code * code)
else
e3rhs = gfc_copy_expr (code->expr3);
- // We need to propagate the bounds of the expr3 for source=/mold=;
- // however, for nondescriptor arrays, we use internally a lower bound
- // of zero instead of one, which needs to be corrected for the allocate
obj
- if (e3_is == E3_DESC)
- {
- symbol_attribute attr = gfc_expr_attr (code->expr3);
- if (code->expr3->expr_type == EXPR_ARRAY ||
- (!attr.allocatable && !attr.pointer))
- e3_has_nodescriptor = true;
- }
+ // We need to propagate the bounds of the expr3 for source=/mold=.
+ // However, for non-named arrays, the lbound has to be 1 and neither the
+ // bound used inside the called function even when returning an
+ // allocatable/pointer nor the zero used internally.
+ if (e3_is == E3_DESC
+ && code->expr3->expr_type != EXPR_VARIABLE)
+ e3_has_nodescriptor = true;
}
/* Loop over all objects to allocate. */
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_mold_4.f90
b/gcc/testsuite/gfortran.dg/allocate_with_mold_4.f90
new file mode 100644
index 000..d545fe1249f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_mold_4.f90
@@ -0,0 +1,24 @@
+program A_M
+ implicit none
+ real, parameter :: C(5:10) = 5.0
+ real, dimension (:), allocatable :: A, B
+ allocate (A(6))
+ call Init (A)
+contains
+ subroutine Init ( A )
+real, dimension ( -1 : ), intent ( in ) :: A
+integer, dimension ( 1 ) :: lb_B
+
+allocate (B, mold = A)
+if (any (lbound (B) /= lbound (A))) stop 1
+if (any (ubound (B) /= ubound (A))) stop 2
+if (any (shape (B) /= shape (A))) stop 3
+if (size (B) /= size (A)) stop 4
+deallocate (B)
+allocate (B, mold = C)
+if (any (lbound (B) /= lbound (C))) stop 5
+if (any (ubound (B) /= ubound (C))) stop 6
+if (any (shape (B) /= shape (C))) stop 7
+if (size (B) /= size (C)) stop 8
+end
+end
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_26.f90
b/gcc/testsuite/gfortran.dg/allocate_with_source_26.f90
index 28f24fc1e10..323c8a30b9e 100644
--- a/gcc/testsuite/gfortran.dg/allocate_with_source_26.f90
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_26.f90
@@ -34,23 +34,23 @@ program p
if (lbound(p1, 1) /= 3 .or. ubound(p1, 1) /= 4 &
.or. lbound(p2, 1) /= 3 .or. ubound(p2, 1) /= 4 &
.or. lbound(p3, 1) /= 1 .or. ubound(p3, 1) /= 2 &
- .or. lbound(p4, 1) /= 7 .or. ubound(p4, 1) /= 8 &
+ .or. lbound(p4, 1) /= 1 .or. ubound(p4, 1) /= 2 &
.or. p1(3)%i /= 43 .or. p1(4)%i /= 56 &
.or. p2(3)%i /= 43 .or. p2(4)%i /= 56 &
.or. p3(1)%i /= 43 .or. p3(2)%i /= 56 &
- .or. p4(7)%i /= 11 .or. p4(8)%i /= 12) then
+ .or. p4(1)%i /= 11 .or. p4(2)%i /= 12) then
call abort()
endif
!write(*,*) lbound(a,1), ubound(a,1) ! prints 1 3
!write(*,*) lbound(b,1), ubound(b,1) ! prints 1 3
- !write(*,*) lbound(c,1), ubound(c,1) ! prints 3 5
+ !write(*,*) lbound(c,1), ubound(c,1) ! prints 1 3
!write(*,*) lbound(d,1), ubound(d,1) ! prints 1 5
!write(*,*) lbound(e,1), ubound(e,1) ! prints 1 6
if (lbound(a,1) /= 1 .or. ubound(a,1) /= 3 &
.or. lbound(b,1) /= 1 .or. ubound(b,1) /= 3 &
- .or. lbound(c,1) /= 3 .or. ubound(c,1) /= 5 &
+ .or. lbound(c,1) /= 1 .or. ubound(c,1) /= 3 &
.or. lbound(d,1) /= 1 .or. ubound(d,1) /= 5 &
.or. lbound(e,1) /= 1 .or. ubound(e,1) /= 6) then
call abort()
[gcc r13-8559] Fortran: error recovery while simplifying expressions [PR103707, PR106987]
https://gcc.gnu.org/g:2808797fc4da7cc455803e2b69368b52db857b4c
commit r13-8559-g2808797fc4da7cc455803e2b69368b52db857b4c
Author: Harald Anlauf
Date: Tue Mar 5 21:54:26 2024 +0100
Fortran: error recovery while simplifying expressions [PR103707,PR106987]
When an exception is encountered during simplification of arithmetic
expressions, the result may depend on whether range-checking is active
(-frange-check) or not. However, the code path in the front-end should
stay the same for "soft" errors for which the exception is triggered by the
check, while "hard" errors should always terminate the simplification, so
that error recovery is independent of the flag. Separation of arithmetic
error codes into "hard" and "soft" errors shall be done consistently via
is_hard_arith_error().
PR fortran/103707
PR fortran/106987
gcc/fortran/ChangeLog:
* arith.cc (is_hard_arith_error): New helper function to determine
whether an arithmetic error is "hard" or not.
(check_result): Use it.
(gfc_arith_divide): Set "Division by zero" only for regular
numerators of real and complex divisions.
(reduce_unary): Use is_hard_arith_error to determine whether a hard
or (recoverable) soft error was encountered. Terminate immediately
on hard error, otherwise remember code of first soft error.
(reduce_binary_ac): Likewise.
(reduce_binary_ca): Likewise.
(reduce_binary_aa): Likewise.
gcc/testsuite/ChangeLog:
* gfortran.dg/arithmetic_overflow_3.f90: New test.
(cherry picked from commit 93e1d4d24ed014387da97e2ce11556d68fe98e66)
Diff:
---
gcc/fortran/arith.cc | 134 +++--
.../gfortran.dg/arithmetic_overflow_3.f90 | 48
2 files changed, 142 insertions(+), 40 deletions(-)
diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index 5673c76823a..fade085450c 100644
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -130,6 +130,30 @@ gfc_arith_error (arith code)
}
+/* Check if a certain arithmetic error code is severe enough to prevent
+ further simplification, as opposed to errors thrown by the range check
+ (e.g. overflow) or arithmetic exceptions that are tolerated with
+ -fno-range-check. */
+
+static bool
+is_hard_arith_error (arith code)
+{
+ switch (code)
+{
+case ARITH_OK:
+case ARITH_OVERFLOW:
+case ARITH_UNDERFLOW:
+case ARITH_NAN:
+case ARITH_DIV0:
+case ARITH_ASYMMETRIC:
+ return false;
+
+default:
+ return true;
+}
+}
+
+
/* Get things ready to do math. */
void
@@ -579,10 +603,10 @@ check_result (arith rc, gfc_expr *x, gfc_expr *r,
gfc_expr **rp)
val = ARITH_OK;
}
- if (val == ARITH_OK || val == ARITH_OVERFLOW)
-*rp = r;
- else
+ if (is_hard_arith_error (val))
gfc_free_expr (r);
+ else
+*rp = r;
return val;
}
@@ -792,23 +816,26 @@ gfc_arith_divide (gfc_expr *op1, gfc_expr *op2, gfc_expr
**resultp)
break;
case BT_REAL:
- if (mpfr_sgn (op2->value.real) == 0 && flag_range_check == 1)
- {
- rc = ARITH_DIV0;
- break;
- }
+ /* Set "Division by zero" only for regular numerator. */
+ if (flag_range_check == 1
+ && mpfr_zero_p (op2->value.real)
+ && mpfr_regular_p (op1->value.real))
+ rc = ARITH_DIV0;
mpfr_div (result->value.real, op1->value.real, op2->value.real,
GFC_RND_MODE);
break;
case BT_COMPLEX:
- if (mpc_cmp_si_si (op2->value.complex, 0, 0) == 0
- && flag_range_check == 1)
- {
- rc = ARITH_DIV0;
- break;
- }
+ /* Set "Division by zero" only for regular numerator. */
+ if (flag_range_check == 1
+ && mpfr_zero_p (mpc_realref (op2->value.complex))
+ && mpfr_zero_p (mpc_imagref (op2->value.complex))
+ && ((mpfr_regular_p (mpc_realref (op1->value.complex))
+ && mpfr_number_p (mpc_imagref (op1->value.complex)))
+ || (mpfr_regular_p (mpc_imagref (op1->value.complex))
+ && mpfr_number_p (mpc_realref (op1->value.complex)
+ rc = ARITH_DIV0;
gfc_set_model (mpc_realref (op1->value.complex));
if (mpc_cmp_si_si (op2->value.complex, 0, 0) == 0)
@@ -1323,7 +1350,6 @@ reduce_unary (arith (*eval) (gfc_expr *, gfc_expr **),
gfc_expr *op,
gfc_constructor *c;
gfc_expr *r;
arith rc;
- bool ov = false;
if (op->expr_type == EXPR_CONSTANT)
return eval (op, result);
@@ -1335,19 +1361,22 @@ reduce_unary (arith (*eval) (gfc_expr *, gfc_expr **),
gfc_expr *op,
[gcc r13-8558] Fortran: error recovery on arithmetic overflow on unary operations [PR113799]
https://gcc.gnu.org/g:ec8303dea72ed4f9ae9fdf3c996a0deef6809351
commit r13-8558-gec8303dea72ed4f9ae9fdf3c996a0deef6809351
Author: Harald Anlauf
Date: Thu Feb 8 21:51:38 2024 +0100
Fortran: error recovery on arithmetic overflow on unary operations
[PR113799]
PR fortran/113799
gcc/fortran/ChangeLog:
* arith.cc (reduce_unary): Remember any overflow encountered during
reduction of unary arithmetic operations on array constructors and
continue, and return error status, but terminate on serious errors.
gcc/testsuite/ChangeLog:
* gfortran.dg/arithmetic_overflow_2.f90: New test.
(cherry picked from commit b3d622d70ba209b63471fc1b0970870046e55745)
Diff:
---
gcc/fortran/arith.cc| 11 ---
gcc/testsuite/gfortran.dg/arithmetic_overflow_2.f90 | 12
2 files changed, 20 insertions(+), 3 deletions(-)
diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index fcf37d48bfc..5673c76823a 100644
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -1323,6 +1323,7 @@ reduce_unary (arith (*eval) (gfc_expr *, gfc_expr **),
gfc_expr *op,
gfc_constructor *c;
gfc_expr *r;
arith rc;
+ bool ov = false;
if (op->expr_type == EXPR_CONSTANT)
return eval (op, result);
@@ -1336,13 +1337,17 @@ reduce_unary (arith (*eval) (gfc_expr *, gfc_expr **),
gfc_expr *op,
{
rc = reduce_unary (eval, c->expr, );
- if (rc != ARITH_OK)
+ /* Remember any overflow encountered during reduction and continue,
+but terminate on serious errors. */
+ if (rc == ARITH_OVERFLOW)
+ ov = true;
+ else if (rc != ARITH_OK)
break;
gfc_replace_expr (c->expr, r);
}
- if (rc != ARITH_OK)
+ if (rc != ARITH_OK && rc != ARITH_OVERFLOW)
gfc_constructor_free (head);
else
{
@@ -1363,7 +1368,7 @@ reduce_unary (arith (*eval) (gfc_expr *, gfc_expr **),
gfc_expr *op,
*result = r;
}
- return rc;
+ return ov ? ARITH_OVERFLOW : rc;
}
diff --git a/gcc/testsuite/gfortran.dg/arithmetic_overflow_2.f90
b/gcc/testsuite/gfortran.dg/arithmetic_overflow_2.f90
new file mode 100644
index 000..6ca27f74215
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arithmetic_overflow_2.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-additional-options "-frange-check" }
+!
+! PR fortran/113799 - handle arithmetic overflow on unary minus
+
+program p
+ implicit none
+ real, parameter :: inf = real(z'7F80')
+ real, parameter :: someInf(*) = [inf, 0.]
+ print *, -someInf ! { dg-error "Arithmetic overflow" }
+ print *, minval(-someInf) ! { dg-error "Arithmetic overflow" }
+end
[gcc r13-8557] Fortran: set shape of initializers of zero-sized arrays [PR95374, PR104352]
https://gcc.gnu.org/g:0dd82c0fba660775ff76ae27077a67f2f1358920
commit r13-8557-g0dd82c0fba660775ff76ae27077a67f2f1358920
Author: Harald Anlauf
Date: Wed May 17 20:39:18 2023 +0200
Fortran: set shape of initializers of zero-sized arrays [PR95374,PR104352]
gcc/fortran/ChangeLog:
PR fortran/95374
PR fortran/104352
* decl.cc (add_init_expr_to_sym): Set shape of initializer also for
zero-sized arrays, so that bounds violations can be detected later.
gcc/testsuite/ChangeLog:
PR fortran/95374
PR fortran/104352
* gfortran.dg/zero_sized_13.f90: New test.
(cherry picked from commit 7bafe652dba9167b65e7b5ef24e77eceb49709ba)
Diff:
---
gcc/fortran/decl.cc | 3 +--
gcc/testsuite/gfortran.dg/zero_sized_13.f90 | 28
2 files changed, 29 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 03e993eb0ff..527e84ad763 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -2248,8 +2248,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp,
locus *var_locus)
&& gfc_is_constant_expr (init)
&& (init->expr_type == EXPR_CONSTANT
|| init->expr_type == EXPR_STRUCTURE)
- && spec_size (sym->as, )
- && mpz_cmp_si (size, 0) > 0)
+ && spec_size (sym->as, ))
{
array = gfc_get_array_expr (init->ts.type, init->ts.kind,
>where);
diff --git a/gcc/testsuite/gfortran.dg/zero_sized_13.f90
b/gcc/testsuite/gfortran.dg/zero_sized_13.f90
new file mode 100644
index 000..4035d458b32
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/zero_sized_13.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! { dg-options "-w" }
+!
+! PR fortran/95374
+! PR fortran/104352 - Various ICEs for bounds violation with zero-sized arrays
+!
+! Contributed by G. Steinmetz
+
+program p
+ implicit none
+ integer :: i
+ integer, parameter :: a(0)= 0
+ integer, parameter :: b(0:-5) = 0
+ integer, parameter :: c(*) = [(a(i:i), i=0,0)] ! { dg-error "out of bounds" }
+ integer, parameter :: d(*) = [(b(i:i), i=1,1)] ! { dg-error "out of bounds" }
+ integer, parameter :: e(1) = [(a(i) , i=1,1)] ! { dg-error "out of bounds" }
+ integer, parameter :: f(1) = [(a(i:i), i=1,1)] ! { dg-error "out of bounds" }
+ integer:: g(1) = [(a(i:i), i=0,0)] ! { dg-error "out of bounds" }
+ integer:: h(1) = [(a(i:i), i=1,1)] ! { dg-error "out of bounds" }
+ print *, [(a(i:i), i=0,0)] ! { dg-error "out of bounds" }
+ print *, [(a(i:i), i=1,1)] ! { dg-error "out of bounds" }
+ print *, any (a(1:1) == 1) ! { dg-error "out of bounds" }
+ print *, all (a(0:0) == 1) ! { dg-error "out of bounds" }
+ print *, sum (a(1:1)) ! { dg-error "out of bounds" }
+ print *, iall (a(0:0)) ! { dg-error "out of bounds" }
+ print *, minloc (a(0:0),1) ! { dg-error "out of bounds" }
+ print *, dot_product(a(1:1),a(1:1)) ! { dg-error "out of bounds" }
+end
Re: [Patch, fortran] PR106999 [11/12/13/14 Regression] ICE tree check: expected record_type or union_type or qual_union_type, have function_type in gfc_class_data_get, at fortran/trans-expr.cc:233
Hi Paul, On 3/31/24 15:01, Paul Richard Thomas wrote: This regression has a relatively simple fix. The passing of a subroutine procedure pointer component to a dummy variable was being missed completely. The error has been added. Conversely, an error was generated for a procedure pointer variable but no use was being made of the interface, if one was available. This has been corrected. OK for mainline and backporting in a couple of weeks? this is all OK. Thanks for the patch! Harald Paul Fortran: Add error for subroutine passed to a variable dummy [PR106999] 2024-03-31 Paul Thomas gcc/fortran PR fortran/106999 *interface.cc (gfc_compare_interfaces): Add error for a subroutine proc pointer passed to a variable formal. (compare_parameter): If a procedure pointer is being passed to a non-procedure formal arg, and there is an an interface, use gfc_compare_interfaces to check and provide a more useful error message. gcc/testsuite/ PR fortran/106999 * gfortran.dg/pr106999.f90: New test.
Re: [Patch, fortran] PR112407 - [13/14 Regression] Fix for PR37336 triggers an ICE in gfc_format_decoder while constructing a vtab
Hi Paul! Am 31.03.24 um 14:08 schrieb Paul Richard Thomas: Hi Harald, I had only a quick glance at your patch. I guess you unintentionally forgot to remove those parts that you already committed for PR110987, along with the finalize-testcases. Guilty as charged. I guess I got out of the wrong side of the bed :-) I am still trying to find the precise paragraph in the standard you refer to regarding INTENT(OUT) and default initialization. Page 114 of the draft F2023 standard: "The INTENT (OUT) attribute for a nonpointer dummy argument specifies that the dummy argument becomes undefined on invocation of the procedure, except for any subcomponents that are default-initialized (7.5.4.6)." With the fix, gfortran behaves in the same way as ifort and nagfor. On rereading the patch, I think that s/"and use the passed value"/"and leave undefined"/ or some such is in order. Yes, something along this line is better. I also did test with NAG and Intel, and was surprised (confused?) at how the count of finalizer calls changes if component "i" gets a default value or not. Something one wouldn't do right after getting out of bed! So the patch looks good to me - except for one philosophical question: Fortran 2018 makes procedures recursive by default, but this is not yet implemented as such, and NON_RECURSIVE is not yet implemented. The new testcase pr112407b.f90 compiles with nagfor -f2018 without any warnings, and gives an error with nagfor -f2008. It appears that it works in the testsuite after the patch and when adding "-std=f2008" instead of using the default "-std=gnu". Would you mind adding "-std=f2008" as dg-option to that testcase? This would avoid one bogus regression when gfortran moves forward. Thanks for the patch! Harald While at it, I think I found a minor nit in testcase pr112407a.f90: component x%i appears undefined the first time it is printed. Fixed - thanks for pointing it out. A correct patch is attached. Thanks for looking at the previous, overloaded version. Paul 2024-03-30 Paul Thomas gcc/fortran PR fortran/112407 *resolve.cc (resolve_procedure_expression): Change the test for for recursion in the case of hidden procedures from modules. (resolve_typebound_static): Add warning for possible recursive calls to typebound procedures. * trans-expr.cc (gfc_trans_class_init_assign): Do not apply default initializer to class dummy where component initializers are all null. gcc/testsuite/ PR fortran/112407 * gfortran.dg/pr112407a.f90: New test. * gfortran.dg/pr112407b.f90: New test.
Re: [Patch, fortran] PR112407 - [13/14 Regression] Fix for PR37336 triggers an ICE in gfc_format_decoder while constructing a vtab
Hi Paul, I had only a quick glance at your patch. I guess you unintentionally forgot to remove those parts that you already committed for PR110987, along with the finalize-testcases. I am still trying to find the precise paragraph in the standard you refer to regarding INTENT(OUT) and default initialization. While at it, I think I found a minor nit in testcase pr112407a.f90: component x%i appears undefined the first time it is printed. This can be verified by either adding an explicit x% i = -42 in the main after the allocate(x). Alternatively, running the code with Intel and using MALLOC_PERTURB_ shows a random arg1%i, but is otherwise fine. However, if by chance (random memory) x% i = +42 then the test would likely fail everywhere. Cheers, Harald Am 30.03.24 um 10:06 schrieb Paul Richard Thomas: Hi All, This bug emerged in a large code and involves possible recursion with a "hidden" module procedure; ie. where the symtree name starts with '@'. This throws the format decoder. As the last message in the PR shows, I have vacillated between silently passing on the possible recursion or adding an alternative warning message. In the end, as a conservative choice I went for emitting the message. In the course of trying to develop a compact test case, I found that type bound procedures were not being tested for recursion and that class dummies, with intent out, were being incorrectly initialized with an empty default initializer. Both of these have been fixed. Unfortunately, the most compact reproducer that Tomas was able to come up with required more than 100kbytes of module files. I tried from the bottom up but failed. Both the tests check the fixes for the other bugs. Regtests on x86_64 - OK for mainline and, in a couple of weeks, 13-branch? Paul Fortran: Fix wrong recursive errors and class initialization [PR112407] 2024-03-30 Paul Thomas gcc/fortran PR fortran/112407 *resolve.cc (resolve_procedure_expression): Change the test for for recursion in the case of hidden procedures from modules. (resolve_typebound_static): Add warning for possible recursive calls to typebound procedures. * trans-expr.cc (gfc_trans_class_init_assign): Do not apply default initializer to class dummy where component initializers are all null. gcc/testsuite/ PR fortran/112407 * gfortran.dg/pr112407a.f90: New test. * gfortran.dg/pr112407b.f90: New test.
[gcc r11-11299] Fortran: fix NULL pointer dereference on overlapping initialization [PR50410]
https://gcc.gnu.org/g:1611acc1f72cad30c7ecccb5c85246836c1d0299
commit r11-11299-g1611acc1f72cad30c7ecccb5c85246836c1d0299
Author: Harald Anlauf
Date: Thu Mar 28 22:34:40 2024 +0100
Fortran: fix NULL pointer dereference on overlapping initialization
[PR50410]
gcc/fortran/ChangeLog:
PR fortran/50410
* trans-expr.c (gfc_conv_structure): Check for NULL pointer.
gcc/testsuite/ChangeLog:
PR fortran/50410
* gfortran.dg/data_initialized_4.f90: New test.
(cherry picked from commit 6fb253a25dff13253d63553f02e0fe72c5e3ab4e)
Diff:
---
gcc/fortran/trans-expr.c | 2 +-
gcc/testsuite/gfortran.dg/data_initialized_4.f90 | 16
2 files changed, 17 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 5adee114157..37f16f37e12 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -8879,7 +8879,7 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int
init)
cm = expr->ts.u.derived->components;
for (c = gfc_constructor_first (expr->value.constructor);
- c; c = gfc_constructor_next (c), cm = cm->next)
+ c && cm; c = gfc_constructor_next (c), cm = cm->next)
{
/* Skip absent members in default initializers and allocatable
components. Although the latter have a default initializer
diff --git a/gcc/testsuite/gfortran.dg/data_initialized_4.f90
b/gcc/testsuite/gfortran.dg/data_initialized_4.f90
new file mode 100644
index 000..156b6607edf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_initialized_4.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-additional-options "-std=legacy" }
+!
+! PR fortran/50410
+!
+! Silently allow overlapping initialization in legacy mode (used to ICE)
+
+program p
+ implicit none
+ type t
+ integer :: g = 1
+ end type t
+ type(t) :: u = t(2)
+ data u%g /3/
+ print *, u! this might print "2"
+end
[gcc r12-10299] Fortran: fix NULL pointer dereference on overlapping initialization [PR50410]
https://gcc.gnu.org/g:cb72fbd49e1f0c1cbdf8a9e97860063b19b1f95e
commit r12-10299-gcb72fbd49e1f0c1cbdf8a9e97860063b19b1f95e
Author: Harald Anlauf
Date: Thu Mar 28 22:34:40 2024 +0100
Fortran: fix NULL pointer dereference on overlapping initialization
[PR50410]
gcc/fortran/ChangeLog:
PR fortran/50410
* trans-expr.cc (gfc_conv_structure): Check for NULL pointer.
gcc/testsuite/ChangeLog:
PR fortran/50410
* gfortran.dg/data_initialized_4.f90: New test.
(cherry picked from commit 6fb253a25dff13253d63553f02e0fe72c5e3ab4e)
Diff:
---
gcc/fortran/trans-expr.cc| 2 +-
gcc/testsuite/gfortran.dg/data_initialized_4.f90 | 16
2 files changed, 17 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 27b34984705..11ee1931b8e 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -9298,7 +9298,7 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int
init)
cm = expr->ts.u.derived->components;
for (c = gfc_constructor_first (expr->value.constructor);
- c; c = gfc_constructor_next (c), cm = cm->next)
+ c && cm; c = gfc_constructor_next (c), cm = cm->next)
{
/* Skip absent members in default initializers and allocatable
components. Although the latter have a default initializer
diff --git a/gcc/testsuite/gfortran.dg/data_initialized_4.f90
b/gcc/testsuite/gfortran.dg/data_initialized_4.f90
new file mode 100644
index 000..156b6607edf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_initialized_4.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-additional-options "-std=legacy" }
+!
+! PR fortran/50410
+!
+! Silently allow overlapping initialization in legacy mode (used to ICE)
+
+program p
+ implicit none
+ type t
+ integer :: g = 1
+ end type t
+ type(t) :: u = t(2)
+ data u%g /3/
+ print *, u! this might print "2"
+end
[gcc r13-8506] Fortran: fix passing of optional dummies to bind(c) procedures [PR113866]
https://gcc.gnu.org/g:5f9144021615f24d038890dab7db2a0b9e84f6d3
commit r13-8506-g5f9144021615f24d038890dab7db2a0b9e84f6d3
Author: Harald Anlauf
Date: Tue Feb 13 20:19:10 2024 +0100
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.
(cherry picked from commit f4935df217ad89f884f908f39086b322e80123d0)
Diff:
---
gcc/fortran/trans-expr.cc | 6 +-
gcc/testsuite/gfortran.dg/bind_c_optional-2.f90 | 105
2 files changed, 109 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index d9de93260a6..c3f02c83b3f 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -7052,8 +7052,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..ceedef7f006
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_optional-2.f90
@@ -0,0 +1,105 @@
+! { 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 (len (c2) /= l .or. len (c4) /= l) stop 81
+if (c2(1:3)/= "a23") stop 1
+if (c4(5)(1:3) /= "bcd") stop 2
+ end
+
+ subroutine bindc (c2, c4) bind(c)
+character(*) :: c2, c4(n)
+if (len (c2) /= l .or. len (c4) /= l) stop 82
+if (c2(1:3)/= "a23") stop 3
+if (c4(5)(1:3) /= "bcd") stop 4
+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
+if (len (c1) /= l .or. len (c3) /= l) stop 83
+call bindc_optional (c1, c3)
+call bindc (c1, c3)
+ end
+
+ subroutine not_bindc_optional_deferred (c5, c6)
+character(:), allocatable, optional :: c5, c6(:)
+if (.not. present (c5) .or. .not. present (c6)) stop 6
+if (len (c5) /= l .or. len (c6) /= l) stop 84
+call not_bindc_optional (c5, c6)
+call bindc_optional (c5, c6)
+call bindc (c5, c6)
+ end
+
+ subroutine not_bindc_optional2 (c7, c8)
+character(*), optional :: c7, c8(:)
+if (.not. present (c7) .or. .not. present (c8)) stop 7
+if (len (c7) /= l .or. len (c8) /= l) stop 85
+call bindc_optional (c7, c8)
+call bindc (c7, c8)
+ end
+
+ subroutine bindc_optional2 (c2, c4) bind(c)
+character(*), optional :: c2, c4(n)
+if (.not. present (c2) .or. .not. present (c4)) stop 8
+if (len (c2) /= l .or. len (c4) /= l) stop 86
+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)
+ 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, c5)
+character(*), optional :: c1, c2(n), c3(:), c4(..), c5(*)
+if (present (c1)) stop 21
+if (present (c2)) stop 22
+if (present (c3)) stop 23
+if (present (c4)) stop 24
+if (present (c5)) stop 25
+ end
+end module
+
+progra
[gcc r13-8505] Fortran: fix NULL pointer dereference on overlapping initialization [PR50410]
https://gcc.gnu.org/g:250990298fb792635d9895e7642ccedbc2dd39d4
commit r13-8505-g250990298fb792635d9895e7642ccedbc2dd39d4
Author: Harald Anlauf
Date: Thu Mar 28 22:34:40 2024 +0100
Fortran: fix NULL pointer dereference on overlapping initialization
[PR50410]
gcc/fortran/ChangeLog:
PR fortran/50410
* trans-expr.cc (gfc_conv_structure): Check for NULL pointer.
gcc/testsuite/ChangeLog:
PR fortran/50410
* gfortran.dg/data_initialized_4.f90: New test.
(cherry picked from commit 6fb253a25dff13253d63553f02e0fe72c5e3ab4e)
Diff:
---
gcc/fortran/trans-expr.cc| 2 +-
gcc/testsuite/gfortran.dg/data_initialized_4.f90 | 16
2 files changed, 17 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 3f3f0123dc3..d9de93260a6 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -9364,7 +9364,7 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int
init)
cm = expr->ts.u.derived->components;
for (c = gfc_constructor_first (expr->value.constructor);
- c; c = gfc_constructor_next (c), cm = cm->next)
+ c && cm; c = gfc_constructor_next (c), cm = cm->next)
{
/* Skip absent members in default initializers and allocatable
components. Although the latter have a default initializer
diff --git a/gcc/testsuite/gfortran.dg/data_initialized_4.f90
b/gcc/testsuite/gfortran.dg/data_initialized_4.f90
new file mode 100644
index 000..156b6607edf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_initialized_4.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-additional-options "-std=legacy" }
+!
+! PR fortran/50410
+!
+! Silently allow overlapping initialization in legacy mode (used to ICE)
+
+program p
+ implicit none
+ type t
+ integer :: g = 1
+ end type t
+ type(t) :: u = t(2)
+ data u%g /3/
+ print *, u! this might print "2"
+end
[gcc r14-9720] Fortran: fix NULL pointer dereference on overlapping initialization [PR50410]
https://gcc.gnu.org/g:6fb253a25dff13253d63553f02e0fe72c5e3ab4e
commit r14-9720-g6fb253a25dff13253d63553f02e0fe72c5e3ab4e
Author: Harald Anlauf
Date: Thu Mar 28 22:34:40 2024 +0100
Fortran: fix NULL pointer dereference on overlapping initialization
[PR50410]
gcc/fortran/ChangeLog:
PR fortran/50410
* trans-expr.cc (gfc_conv_structure): Check for NULL pointer.
gcc/testsuite/ChangeLog:
PR fortran/50410
* gfortran.dg/data_initialized_4.f90: New test.
Diff:
---
gcc/fortran/trans-expr.cc| 2 +-
gcc/testsuite/gfortran.dg/data_initialized_4.f90 | 16
2 files changed, 17 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 079ac93aa8a..d21e3956d6e 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -9650,7 +9650,7 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int
init)
cm = expr->ts.u.derived->components;
for (c = gfc_constructor_first (expr->value.constructor);
- c; c = gfc_constructor_next (c), cm = cm->next)
+ c && cm; c = gfc_constructor_next (c), cm = cm->next)
{
/* Skip absent members in default initializers and allocatable
components. Although the latter have a default initializer
diff --git a/gcc/testsuite/gfortran.dg/data_initialized_4.f90
b/gcc/testsuite/gfortran.dg/data_initialized_4.f90
new file mode 100644
index 000..156b6607edf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_initialized_4.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-additional-options "-std=legacy" }
+!
+! PR fortran/50410
+!
+! Silently allow overlapping initialization in legacy mode (used to ICE)
+
+program p
+ implicit none
+ type t
+ integer :: g = 1
+ end type t
+ type(t) :: u = t(2)
+ data u%g /3/
+ print *, u! this might print "2"
+end
