Re: [Fortran, Patch, PR 96992] Fix Class arrays of different ranks are rejected as storage association argument
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.
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
From c0c95afa95bb682385e47cc248f04e6eecd91e6d Mon Sep 17 00:00:00 2001
From: Andre Vehreschild
Date: Fri, 14 Jun 2024 16:54:37 +0200
Subject: [PATCH] Fortran: Fix rejecting class arrays of different ranks as
storage association argument.
Removing the assert in trans-expr, lead to initial strides not set
which is not fixed. When the array needs repacking, this is done for
class arrays now, too.
PR fortran/96992
gcc/fortran/ChangeLog:
* trans-array.cc (gfc_trans_array_bounds): Set a starting
stride, when descriptor expects a variable for the stride.
(gfc_trans_dummy_array_bias): Allow storage association for
dummy class arrays, when they are not elemental.
* trans-expr.cc (gfc_conv_derived_to_class): Remove assert to
allow converting derived to class type arrays with assumed
rank. Add packing when necessary.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr96992.f90: New test.
---
gcc/fortran/trans-array.cc| 7 ++-
gcc/fortran/trans-expr.cc | 31 -
gcc/testsuite/gfortran.dg/pr96992.f90 | 66 +++
3 files changed, 101 insertions(+), 3 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/pr96992.f90
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 24a9a51692c..573e056d7c6 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -6798,6 +6798,9 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset,
size = gfc_index_one_node;
offset = gfc_index_zero_node;
+ stride = GFC_TYPE_ARRAY_STRIDE (type, 0);
+ if (stride && VAR_P (stride))
+gfc_add_modify (pblock, stride, gfc_index_one_node);
for (dim = 0; dim < as->rank; dim++)
{
/* Evaluate non-constant array bound expressions.
@@ -7143,7 +7146,9 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
|| (is_classarray && CLASS_DATA (sym)->attr.allocatable))
return;
- if (!is_classarray && sym->attr.dummy && gfc_is_nodesc_array (sym))
+ if ((!is_classarray
+ || (is_classarray && CLASS_DATA (sym)->as->type == AS_EXPLICIT))
+ && sym->attr.dummy && !sym->attr.elemental && gfc_is_nodesc_array (sym))
{
gfc_trans_g77_array (sym, block);
return;
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 0796fb75505..4468163e482 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -874,6 +874,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
stmtblock_t block;
gfc_init_block (&block);
gfc_ref *ref;
+ tree maybetmp = NULL_TREE, origdata = NULL_TREE;
parmse->ss = ss;
parmse->use_offset = 1;
@@ -903,8 +904,29 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
if (e->rank != class_ts.u.derived->components->as->rank)
{
- gcc_assert (class_ts.u.derived->components->as->type
- == AS_ASSUMED_RANK);
+ tree desc;
+
+ desc = parmse->expr;
+ if (VAR_P (desc) && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))
+ && !GFC_DECL_PACKED_ARRAY (desc)
+ && !GFC_DECL_PARTIAL_PACKED_ARRAY (desc))
+ {
+ origdata = gfc_evaluate_now (
+ fold_convert (pvoid_type_node,
+ gfc_conv_descriptor_data_get (desc)),
+ &block);
+ tmp = gfc_build_addr_expr (NULL, desc);
+ tmp = build_call_expr (gfor_fndecl_in_pack, 1, tmp);
+ maybetmp = gfc_evaluate_now (tmp, &block);
+ gfc_conv_descriptor_data_set (&block, desc, maybetmp);
+ /* Add code to free eventually allocated temporary array
+ from pack. */
+ tmp = fold_build2 (NE_EXPR, boolean_type_node, maybetmp,
+ origdata);
+ tmp = build3_v (COND_EXPR, tmp, gfc_call_free (maybetmp),
+ build_empty_stmt (input_location));
+ gfc_add_expr_to_block (&parmse->post, tmp);
+ }
if (derived_array
&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (parmse->expr)))
{
@@ -933,6 +955,11 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
if (derived_array && *derived_array != NULL_TREE)
gfc_conv_descriptor_data_set (&block, *derived_array,
null_pointer_node);
+ if (maybetmp)
+ {
+ gfc_add_modify (&block, maybetmp, null_pointer_node);
+ gfc_add_modify (&block, origdata, null_pointer_node);
+ }
tmp = build3_v (COND_EXPR, cond_optional, tmp,
gfc_finish_block (&block));
diff --git a/gcc/testsuite/gfortran.dg/pr96992.f90 b/gcc/testsuite/gfortran.d
Re: [PATCH] Fortran: fix for CHARACTER(len=*) dummies with bind(C) [PR115390]
Hi Harald, that patch looks quite obvious to me. Therefore ok for mainline by me. Thanks for the patch. Regards, Andre On Tue, 18 Jun 2024 22:10:55 +0200 Harald Anlauf wrote: > 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 > -- Andre Vehreschild * Email: vehre ad gmx dot de
Re: [Patch, Fortran, 90076] 1/3 Fix Polymorphic Allocate on Assignment Memory Leak
Hi Paul, thanks for the review. Committed as: gcc-15-1434-gdbb718175d7 Please take a look at the other two merge request or tell me that you have no time, then I ping them to hopefully get some one else to take a look. Thanks again for the review. Regards, Andre On Mon, 17 Jun 2024 06:40:34 +0100 Paul Richard Thomas wrote: > Hi Andre, > > The patch is OK for mainline. Please change the subject line to have > [PR90076] at the end. I am not sure that the contents of the first square > brackets are especially useful in the commit. > > Thanks for the fix > > Paul > > > On Tue, 11 Jun 2024 at 13:57, Andre Vehreschild wrote: > > > Hi all, > > > > the attached patch fix the last case in the bug report. The inital example > > code > > is already fixed by the combination of PR90068 and PR90072. The issue was > > the > > _vptr was not (re)set correctly, like in the __vtab_...-structure was not > > created. This made the compiler ICE. > > > > Regtests fine on x86_64 Fedora 39. Ok for mainline? > > > > Regards, > > Andre > > -- > > Andre Vehreschild * Email: vehre ad gmx dot de > > -- Andre Vehreschild * Email: vehre ad gmx dot de
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
Re: [pushed] readings: Drop FORTRAN 77 test suite at itl.nist.gov
On 6/18/24 10:20 AM, Steve Kargl wrote: On Tue, Jun 18, 2024 at 09:13:23AM +0200, Gerald Pfeifer wrote: The original subsite has disappeared and we couldn't find it elsewhere. https://github.com/gklimowicz/FCVS gklimowicz is a flang developer and member of J3. FWIW my copy of the tests still pass: --- snip --- FM921 compiles and runs OK ***FM922*** FM922 compiles and runs OK ***FM923*** FM923 compiles and runs OK The logfile is nist.log 0 compilation errors or warnings 0 load and link errors 0 runtime errors 192 completely successful
