Re: [pushed] readings: Drop FORTRAN 77 test suite at itl.nist.gov

2024-06-19 Thread Jerry D

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



Re: [Fortran, Patch, PR 96992] Fix Class arrays of different ranks are rejected as storage association argument

2024-06-19 Thread Harald Anlauf

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: [Patch, Fortran, 90076] 1/3 Fix Polymorphic Allocate on Assignment Memory Leak

2024-06-19 Thread Andre Vehreschild
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: [PATCH] Fortran: fix for CHARACTER(len=*) dummies with bind(C) [PR115390]

2024-06-19 Thread Andre Vehreschild
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: [Fortran, Patch, PR 96992] Fix Class arrays of different ranks are rejected as storage association argument

2024-06-19 Thread 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.

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 ();
 	  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)),
+		);
+		  tmp = gfc_build_addr_expr (NULL, desc);
+		  tmp = build_call_expr (gfor_fndecl_in_pack, 1, tmp);
+		  maybetmp = gfc_evaluate_now (tmp, );
+		  gfc_conv_descriptor_data_set (, 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 (>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 (, *derived_array,
 	  null_pointer_node);
+	  if (maybetmp)
+		{
+		  gfc_add_modify (, maybetmp, null_pointer_node);
+		  gfc_add_modify (, origdata, null_pointer_node);
+		}

 	  tmp = build3_v (COND_EXPR, cond_optional, tmp,
 			  gfc_finish_block ());
diff --git a/gcc/testsuite/gfortran.dg/pr96992.f90 b/gcc/testsuite/gfortran.dg/pr96992.f90
new file mode 100644
index