Re: [Patch, fortran] PR59104

2024-06-10 Thread Paul Richard Thomas
Hi Harald,

Thanks for the loophole detection! It is obvious now I see it, as is the
fix. I'll get on to it as soon as I find some time.

Cheers

Paul


On Sun, 9 Jun 2024 at 21:35, Harald Anlauf  wrote:

> Hi Paul,
>
> your approach sounds entirely reasonable.
>
> But as the following addition to the testcase shows, there seem to
> be loopholes left.
>
> When I add the following to function f:
>
>   integer :: l1(size(y))
>   integer :: l2(size(z))
>   print *, size (l1), size (l2), size (z)
>
> I get:
>
> 0   0   3
>
> Expected:
>
> 2   3   3
>
> Can you please check?
>
> Thanks,
> Harald
>
>
> Am 09.06.24 um 17:57 schrieb Paul Richard Thomas:
> > Hi All,
> >
> > I have extended the testcase - see below and have
> > s/dependent_decls_2/dependent_decls_2.f90/ in the ChnageLog.
> >
> > Cheers
> >
> > Paul
> >
> > ! { dg-do run }
> > !
> > ! Fix for PR59104 in which the dependence on the old style function
> result
> > ! was not taken into account in the ordering of auto array allocation and
> > ! characters with dependent lengths.
> > !
> > ! Contributed by Tobias Burnus  
> > !
> > module m
> > implicit none
> > integer, parameter :: dp = kind([double precision::])
> > contains
> >function f(x)
> >   integer, intent(in) :: x
> >   real(dp) f(x/2)
> >   real(dp) g(x/2)
> >   integer y(size (f)+1) ! This was the original problem
> >   integer z(size (f) + size (y)) ! Found in development of the
> fix
> >   integer w(size (f) + size (y) + x) ! Check dummy is OK
> >   f = 10.0
> >   y = 1! Stop -Wall from complaining
> >   z = 1
> >   g = 1
> >   w = 1
> >   if (size (f) .ne. 1) stop 1
> >   if (size (g) .ne. 1) stop 2
> >   if (size (y) .ne. 2) stop 3
> >   if (size (z) .ne. 3) stop 4
> >   if (size (w) .ne. 5) stop 5
> >end function f
> >function e(x) result(f)
> >   integer, intent(in) :: x
> >   real(dp) f(x/2)
> >   real(dp) g(x/2)
> >   integer y(size (f)+1)
> >   integer z(size (f) + size (y)) ! As was this.
> >   integer w(size (f) + size (y) + x)
> >   f = 10.0
> >   y = 1
> >   z = 1
> >   g = 1
> >   w = 1
> >   if (size (f) .ne. 2) stop 6
> >   if (size (g) .ne. 2) stop 7
> >   if (size (y) .ne. 3) stop 8
> >   if (size (z) .ne. 5) stop 9
> >   if (size (w) .ne. 9) stop 10
> >end function
> >function d(x)  ! After fixes to arrays, what was needed was known!
> >  integer, intent(in) :: x
> >  character(len = x/2) :: d
> >  character(len = len (d)) :: line
> >  character(len = len (d) + len (line)) :: line2
> >  character(len = len (d) + len (line) + x) :: line3
> >  line = repeat ("a", len (d))
> >  line2 = repeat ("b", x)
> >      line3 = repeat ("c", len (line3))
> >  if (len (line2) .ne. x) stop 11
> >  if (line3 .ne. "") stop 12
> >  d = line
> >end
> > end module m
> >
> > program p
> > use m
> > implicit none
> > real(dp) y
> >
> > y = sum (f (2))
> > if (int (y) .ne. 10) stop 13
> > y = sum (e (4))
> > if (int (y) .ne. 20) stop 14
> > if (d (4) .ne. "aa") stop 15
> > end program p
> >
> >
> >
> > On Sun, 9 Jun 2024 at 07:14, Paul Richard Thomas <
> > paul.richard.tho...@gmail.com> wrote:
> >
> >> Hi All,
> >>
> >> The attached fixes a problem that, judging by the comments, has been
> >> looked at periodically over the last ten years but just looked to be too
> >> fiendishly complicated to fix. This is not in small part because of the
> >> confusing ordering of dummies in the tlink chain and the unintuitive
> >> placement of all deferred initializations to the front of the init
> chain in
> >> the wrapped block.
> >>
> >> The result of the existing ordering is that the initialization code for
> >> non-dummy variables that depends on the function result occurs before
> any
> >> initialization code for the function result itself. The fix ensures
> that:
> >> (i) These variables are placed correctly in the tlink chain, respecting
> >> inter-dependencies; and (ii) The dependent initializations are placed at
> >> the end of the wrapped block init chain.  The details appear in the
> >> comments in the patch. It is entirely possible that a less clunky fix
> >> exists but I failed to find it.
> >>
> >> OK for mainline?
> >>
> >> Regards
> >>
> >> Paul
> >>
> >>
> >>
> >>
> >
>
>


Re: [Patch, fortran] PR59104

2024-06-09 Thread 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
>
>
>
>


[Patch, fortran] PR59104

2024-06-09 Thread Paul Richard Thomas
Hi All,

The attached fixes a problem that, judging by the comments, has been looked
at periodically over the last ten years but just looked to be too
fiendishly complicated to fix. This is not in small part because of the
confusing ordering of dummies in the tlink chain and the unintuitive
placement of all deferred initializations to the front of the init chain in
the wrapped block.

The result of the existing ordering is that the initialization code for
non-dummy variables that depends on the function result occurs before any
initialization code for the function result itself. The fix ensures that:
(i) These variables are placed correctly in the tlink chain, respecting
inter-dependencies; and (ii) The dependent initializations are placed at
the end of the wrapped block init chain.  The details appear in the
comments in the patch. It is entirely possible that a less clunky fix
exists but I failed to find it.

OK for mainline?

Regards

Paul


Change.Logs
Description: Binary data
diff --git a/gcc/fortran/dependency.cc b/gcc/fortran/dependency.cc
index bafe8cbc5bc..97ace8c778e 100644
--- a/gcc/fortran/dependency.cc
+++ b/gcc/fortran/dependency.cc
@@ -2497,3 +2497,63 @@ gfc_omp_expr_prefix_same (gfc_expr *lexpr, gfc_expr *rexpr)
 
   return true;
 }
+
+
+/* gfc_function_dependency returns true for non-dummy symbols with dependencies
+   on an old-fashioned function result (ie. proc_name = proc_name->result).
+   This is used to ensure that initialization code appears after the function
+   result is treated and that any mutual dependencies between these symbols are
+   respected.  */
+
+static bool
+dependency_fcn (gfc_expr *e, gfc_symbol *sym,
+		 int *f ATTRIBUTE_UNUSED)
+{
+  if (e == NULL)
+return false;
+
+  if (e && e->expr_type == EXPR_VARIABLE
+  && e->symtree
+  && e->symtree->n.sym == sym)
+return true;
+
+  return false;
+}
+
+
+bool
+gfc_function_dependency (gfc_symbol *sym, gfc_symbol *proc_name)
+{
+  bool front = false;
+
+  if (proc_name && proc_name->attr.function
+  && proc_name == proc_name->result
+  && !(sym->attr.dummy || sym->attr.result))
+{
+  if (sym->as && sym->as->type == AS_EXPLICIT)
+	{
+	  for (int dim = 0; dim < sym->as->rank; dim++)
+	{
+	  if (sym->as->lower[dim]
+		  && sym->as->lower[dim]->expr_type != EXPR_CONSTANT)
+		front = gfc_traverse_expr (sym->as->lower[dim], proc_name,
+	   dependency_fcn, 0);
+	  if (front)
+		break;
+	  if (sym->as->upper[dim]
+		  && sym->as->upper[dim]->expr_type != EXPR_CONSTANT)
+		front = gfc_traverse_expr (sym->as->upper[dim], proc_name,
+	   dependency_fcn, 0);
+	  if (front)
+		break;
+	}
+	}
+
+  if (sym->ts.type == BT_CHARACTER
+	  && sym->ts.u.cl && sym->ts.u.cl->length
+	  && sym->ts.u.cl->length->expr_type != EXPR_CONSTANT)
+	front = gfc_traverse_expr (sym->ts.u.cl->length, proc_name,
+   dependency_fcn, 0);
+}
+  return front;
+ }
diff --git a/gcc/fortran/dependency.h b/gcc/fortran/dependency.h
index ea4bd04b0e8..0fa5f93d0fc 100644
--- a/gcc/fortran/dependency.h
+++ b/gcc/fortran/dependency.h
@@ -23,7 +23,7 @@ enum gfc_dep_check
 {
   NOT_ELEMENTAL,/* Not elemental case: normal dependency check.  */
   ELEM_CHECK_VARIABLE,  /* Test whether variables overlap.  */
-  ELEM_DONT_CHECK_VARIABLE  /* Test whether variables overlap only if used 
+  ELEM_DONT_CHECK_VARIABLE  /* Test whether variables overlap only if used
 			   in an expression.  */
 };
 
@@ -43,3 +43,5 @@ bool gfc_are_equivalenced_arrays (gfc_expr *, gfc_expr *);
 bool gfc_omp_expr_prefix_same (gfc_expr *, gfc_expr *);
 
 gfc_expr * gfc_discard_nops (gfc_expr *);
+
+bool gfc_function_dependency (gfc_symbol *, gfc_symbol *);
\ No newline at end of file
diff --git a/gcc/fortran/error.cc b/gcc/fortran/error.cc
index 65e38b0e866..60f607ecc4f 100644
--- a/gcc/fortran/error.cc
+++ b/gcc/fortran/error.cc
@@ -892,7 +892,7 @@ error_print (const char *type, const char *format0, va_list argp)
 #else
 	  m = INTTYPE_MAXIMUM (ptrdiff_t);
 #endif
-	  m = 2 * m + 1;  
+	  m = 2 * m + 1;
 	  error_uinteger (a & m);
 	}
 	  else
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 0a1646def67..7e39981e843 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -27,6 +27,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "parse.h"
 #include "match.h"
 #include "constructor.h"
+#include "dependency.h"
 
 
 /* Strings for all symbol attributes.  We use these for dumping the
@@ -948,15 +949,18 @@ conflict_std:
 void
 gfc_set_sym_referenced (gfc_symbol *sym)
 {
+  gfc_symbol *proc_name = sym->ns->proc_name ? sym->ns->proc_name : NULL;
 
   if (sym->attr.referenced)
 return;
 
   sym->attr.referenced = 1;
 
-  /* Remember which order dummy variables are accessed in.  */
-  if (sym->attr.dummy)
-sym->dummy_order = next_dummy_order++;
+  /* Remember which order dummy variables and symbols with function result
+ dependencies are accessed in.  

Re: [Patch, Fortran/90068] Add finalizer creation to array constructor for functions of derived type.

2024-06-07 Thread Paul Richard Thomas
Hi Andre,

I had been working in exactly the same area to correct the implementation
of finalization of function results in array constructors. However, I
couldn't see a light way of having the finalization occur at the correct
time; "If an executable construct references a nonpointer function, the
result is finalized after execution of the innermost executable construct
containing the reference." This caused all manner of difficulty with
assignment. I'll come back to this.

In the meantime, preventing memory leaks should take priority. This is fine
for mainline.

Thanks

Paul


On Wed, 5 Jun 2024 at 10:47, Andre Vehreschild  wrote:

> Hi Fortraneers,
>
> another patch to fix a memory leak. This time temporaries created during an
> array construction did not have their finalizers called. I.e. allocated
> memory
> was not freed. The attached patch addresses this issue.
>
> Regtested ok on x86_64/Fedora 39. Ok for trunk?
>
> Regards,
> Andre
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
>


Re: [Patch, PR Fortran/90072] Polymorphic Dispatch to Polymophic Return Type Memory Leak

2024-06-07 Thread Paul Richard Thomas
Hi Andre,

I apologise for the slow response. It's been something of a heavy week...

This is good for mainline.

Thanks

Paul

PS That's good news about the funding. Maybe we will get to see "built in"
coarrays soon?


On Tue, 4 Jun 2024 at 11:25, Andre Vehreschild  wrote:

> Hi all,
>
> attached patch fixes a memory leak when a user-defined function returns a
> polymorphic type/class. The issue was, that the polymorphic type was not
> detected correctly and therefore the len-field was not transferred
> correctly.
>
> Regtests ok x86_64-linux/Fedora 39. Ok for master?
>
> Regards,
> Andre
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
>


Re: [Patch, fortran] PR103312 - [11/12/13/14/15 Regression] ICE in gfc_find_component since r9-1098-g3cf89a7b992d483e

2024-05-23 Thread Paul Richard Thomas
Hi Harald,

You were absolutely right about returning 'false' :-) The patch is duly
corrected.

Committed to mainline and will be followed by backports in a few weeks.

Regards

Paul


On Tue, 21 May 2024 at 19:58, Harald Anlauf  wrote:

> 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
> >
>
>


[Patch, fortran] PR103312 - [11/12/13/14/15 Regression] ICE in gfc_find_component since r9-1098-g3cf89a7b992d483e

2024-05-20 Thread 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.

OK for mainline? I will delay for a month before backporting.

Regards

Paul


Change.Logs
Description: Binary data
diff --git a/gcc/fortran/dependency.cc b/gcc/fortran/dependency.cc
index fb4d94de641..bafe8cbc5bc 100644
--- a/gcc/fortran/dependency.cc
+++ b/gcc/fortran/dependency.cc
@@ -440,6 +440,38 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
 	return mpz_sgn (e2->value.op.op2->value.integer);
 }
 
+
+  if (e1->expr_type == EXPR_COMPCALL)
+{
+  /* This will have emerged from interface.cc(gfc_check_typebound_override)
+	 via gfc_check_result_characteristics. It is possible that other
+	 variants exist that are 'equal' but play it safe for now by setting
+	 the relationship as 'indeterminate'.  */
+  if (e2->expr_type == EXPR_FUNCTION && e2->ref)
+	{
+	  gfc_ref *ref = e2->ref;
+	  gfc_symbol *s = NULL;
+
+	  if (e1->value.compcall.tbp->u.specific)
+	s = e1->value.compcall.tbp->u.specific->n.sym;
+
+	  /* Check if the proc ptr points to an interface declaration and the
+	 names are the same; ie. the overriden proc. of an abstract type.
+	 The checking of the arguments will already have been done.  */
+	  for (; ref && s; ref = ref->next)
+	if (!ref->next && ref->type == REF_COMPONENT
+		&& ref->u.c.component->attr.proc_pointer
+		&& ref->u.c.component->ts.interface
+		&& ref->u.c.component->ts.interface->attr.if_source
+			== IFSRC_IFBODY
+		&& !strcmp (s->name, ref->u.c.component->name))
+	  return 0;
+	}
+
+  /* Assume as default that TKR checking is sufficient.  */
+ return -2;
+  }
+
   if (e1->expr_type != e2->expr_type)
 return -3;
 
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;
+
   gfc_init_expr_flag = true;
   t = gfc_resolve_expr (expr);
   if (t)
diff --git a/gcc/testsuite/gfortran.dg/pr103312.f90 b/gcc/testsuite/gfortran.dg/pr103312.f90
new file mode 100644
index 000..deacc70bf5d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr103312.f90
@@ -0,0 +1,87 @@
+! { dg-do run }
+!
+! Test the fix for pr103312, in which the use of a component call in
+! initialization expressions, eg. character(this%size()), caused ICEs.
+!
+! Contributed by Arseny Solokha  
+!
+module example
+
+  type, abstract :: foo
+integer :: i
+  contains
+procedure(foo_size), deferred :: size
+procedure(foo_func), deferred :: func
+  end type
+
+  interface
+function foo_func (this) result (string)
+  import :: foo
+  class(foo) :: this
+  character(this%size()) :: string
+end function
+pure integer function foo_size (this)
+  import foo
+  class(foo), intent(in) :: this
+end function
+  end interface
+
+end module
+
+module extension
+  use example
+  implicit none
+  type, extends(foo) :: bar
+  contains
+procedure :: size
+procedure :: func
+  end type
+
+contains
+pure integer function size (this)
+  class(bar), intent(in) :: this
+  size = this%i
+end function
+function func (this) result (string)
+  class(bar) :: this
+  character(this%size()) :: string
+  string = repeat ("x", len (string))
+end function
+
+end module
+
+module unextended
+  implicit none
+  type :: foobar
+integer :: i
+  contains
+procedure :: size
+procedure :: func
+  end type
+
+contains
+pure integer function size (this)
+  class(foobar), intent(in) :: this
+  size = this%i
+end function
+function func (this) result (string)
+  class(foobar) :: this
+  character(this%size()) :: string
+  character(:), allocatable :: chr
+  string = repeat ("y", len (string))
+  allocate (character(this%size()) :: chr)
+  if (len (string) .ne. len (chr)) stop 1
+end function
+
+end module
+
+  use example
+  use extension
+  use unextended
+  type(bar) :: a
+  type(foobar) :: b
+  a%i = 5
+  if (a%func() .ne. 'x') stop 2
+  b%i = 7
+  if (b%func() .ne. 'yyy') stop 3
+end


[Patch, fortran] PR114874 - [14/15 Regression] ICE with select type, type is (character(*)), and substring

2024-05-15 Thread 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.

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?

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.
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index a7a0fdba3dd..de1a7cd0935 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2242,6 +2242,10 @@ typedef struct gfc_namespace
   /* Set when resolve_types has been called for this namespace.  */
   unsigned types_resolved:1;
 
+  /* Set if the associate_name in a select type statement is an
+ inferred type.  */
+  unsigned assoc_name_inferred:1;
+
   /* Set to 1 if code has been generated for this namespace.  */
   unsigned translated:1;
 
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 4539c9bb134..b7441b9b074 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -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;
+
   new_st.op = EXEC_SELECT_TYPE;
   new_st.expr1 = expr1;
   new_st.expr2 = expr2;
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 8e7833769a8..76f6bcb8a78 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2113,13 +2113,13 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
 
   inferred_type = IS_INFERRED_TYPE (primary);
 
-  /* SELECT TYPE and SELECT RANK temporaries within an ASSOCIATE block, whose
- selector has not been parsed, can generate errors with array and component
- refs.. Use 'inferred_type' as a flag to suppress these errors.  */
+  /* SELECT TYPE temporaries within an ASSOCIATE block, whose selector has not
+ been parsed, can generate errors with array refs.. The SELECT TYPE
+ namespace is marked with 'assoc_name_inferred'. During resolution, this is
+ detected and gfc_fixup_inferred_type_refs is called.  */
   if (!inferred_type
-  && (gfc_peek_ascii_char () == '(' && !sym->attr.dimension)
-  && !sym->attr.codimension
   && sym->attr.select_type_temporary
+  && sym->ns->assoc_name_inferred
   && !sym->attr.select_rank_temporary)
 inferred_type = true;
 
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 4368627041e..d7a0856fcca 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -5888,6 +5888,9 @@ resolve_variable (gfc_expr *e)
   if (e->expr_type == EXPR_CONSTANT)
 	return true;
 }
+  else if (sym->attr.select_type_temporary
+	   && sym->ns->assoc_name_inferred)
+gfc_fixup_inferred_type_refs (e);
 
   /* For variables that are used in an associate (target => object) where
  the object's basetype is array valued while the target is scalar,
@@ -6231,10 +6234,12 @@ gfc_fixup_inferred_type_refs (gfc_expr *e)
 	  free (new_ref);
 	}
 	  else
-	  {
-	e->ref = ref->next;
-	free (ref);
-	  }
+	{
+	  if (e->ref->u.ar.type == AR_UNKNOWN)
+		gfc_error ("Invalid array reference at %L", >where);
+	  

Re: [PATCH] fortran: Assume there is no cyclic reference with submodule symbols [PR99798]

2024-05-12 Thread Paul Richard Thomas
Hi Mikael,

That is an ingenious solution. Given the complexity, I think that the
comments are well warranted.

OK for master and, I would suggest, 14-branch after a few weeks.

Thanks!

Paul

On Sun, 12 May 2024 at 14:16, Mikael Morin  wrote:

> Hello,
>
> Here is my final patch to fix the ICE of PR99798.
> It's maybe overly verbose with comments, but the memory management is
> hopefully clarified.
> I tested this with a full fortran regression test on x86_64-linux and a
> manual check with valgrind on the testcase.
> OK for master?
>
> -- 8< --
>
> This prevents a premature release of memory with procedure symbols from
> submodules, causing random compiler crashes.
>
> The problem is a fragile detection of cyclic references, which can match
> with procedures host-associated from a module in submodules, in cases
> where it
> shouldn't.  The formal namespace is released, and with it the dummy
> arguments
> symbols of the procedure.  But there is no cyclic reference, so the
> procedure
> symbol itself is not released and remains, with pointers to its dummy
> arguments
> now dangling.
>
> The fix adds a condition to avoid the case, and refactors to a new
> predicate
> by the way.  Part of the original condition is also removed, for lack of a
> reason to keep it.
>
> PR fortran/99798
>
> gcc/fortran/ChangeLog:
>
> * symbol.cc (gfc_release_symbol): Move the condition guarding
> the handling cyclic references...
> (cyclic_reference_break_needed): ... here as a new predicate.
> Remove superfluous parts.  Add a condition preventing any premature
> release with submodule symbols.
>
> gcc/testsuite/ChangeLog:
>
> * gfortran.dg/submodule_33.f08: New test.
> ---
>  gcc/fortran/symbol.cc  | 54 +-
>  gcc/testsuite/gfortran.dg/submodule_33.f08 | 20 
>  2 files changed, 72 insertions(+), 2 deletions(-)
>  create mode 100644 gcc/testsuite/gfortran.dg/submodule_33.f08
>
> diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
> index 8f7deac1d1e..0a1646def67 100644
> --- a/gcc/fortran/symbol.cc
> +++ b/gcc/fortran/symbol.cc
> @@ -3179,6 +3179,57 @@ gfc_free_symbol (gfc_symbol *)
>  }
>
>
> +/* Returns true if the symbol SYM has, through its FORMAL_NS field, a
> reference
> +   to itself which should be eliminated for the symbol memory to be
> released
> +   via normal reference counting.
> +
> +   The implementation is crucial as it controls the proper release of
> symbols,
> +   especially (contained) procedure symbols, which can represent a lot of
> memory
> +   through the namespace of their body.
> +
> +   We try to avoid freeing too much memory (causing dangling pointers),
> to not
> +   leak too much (wasting memory), and to avoid expensive walks of the
> symbol
> +   tree (which would be the correct way to check for a cycle).  */
> +
> +bool
> +cyclic_reference_break_needed (gfc_symbol *sym)
> +{
> +  /* Normal symbols don't reference themselves.  */
> +  if (sym->formal_ns == nullptr)
> +return false;
> +
> +  /* Procedures at the root of the file do have a self reference, but
> they don't
> + have a reference in a parent namespace preventing the release of the
> + procedure namespace, so they can use the normal reference counting.
> */
> +  if (sym->formal_ns == sym->ns)
> +return false;
> +
> +  /* If sym->refs == 1, we can use normal reference counting.  If
> sym->refs > 2,
> + the symbol won't be freed anyway, with or without cyclic reference.
> */
> +  if (sym->refs != 2)
> +return false;
> +
> +  /* Procedure symbols host-associated from a module in submodules are
> special,
> + because the namespace of the procedure block in the submodule is
> different
> + from the FORMAL_NS namespace generated by host-association.  So
> there are
> + two different namespaces representing the same procedure namespace.
> As
> + FORMAL_NS comes from host-association, which only imports symbols
> visible
> + from the outside (dummy arguments basically), we can assume there is
> no
> + self reference through FORMAL_NS in that case.  */
> +  if (sym->attr.host_assoc && sym->attr.used_in_submodule)
> +return false;
> +
> +  /* We can assume that contained procedures have cyclic references,
> because
> + the symbol of the procedure itself is accessible in the procedure
> body
> + namespace.  So we assume that symbols with a formal namespace
> different
> + from the declaration namespace and two references, one of which is
> about
> + to be removed, are procedures with just the self reference left.  At
> this
> + point, the symbol SYM matches that pattern, so we return true here to
> + permit the release of SYM.  */
> +  return true;
> +}
> +
> +
>  /* Decrease the reference counter and free memory when we reach zero.
> Returns true if the symbol has been freed, false otherwise.  */
>
> @@ -3188,8 +3239,7 @@ gfc_release_symbol (gfc_symbol *)
>

Re: [Patch, fortran] PR113363 - ICE on ASSOCIATE and unlimited polymorphic function

2024-05-12 Thread 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 .
>
>
>
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 7ec33fb1598..c5b56f4e273 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -5957,6 +5957,11 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
   tmp = gfc_conv_descriptor_dtype (descriptor);
   gfc_add_modify (pblock, tmp, gfc_get_dtype_rank_type (rank, type));
 }
+  else if (expr3_desc && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (expr3_desc)))
+{
+  tmp = gfc_conv_descriptor_dtype (descriptor);
+  gfc_add_modify (pblock, tmp, gfc_conv_descriptor_dtype (expr3_desc));
+}
   else
 {
   tmp = gfc_conv_descriptor_dtype (descriptor);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 4590aa6edb4..e315e2d3370 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -8245,8 +8245,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	 call the finalization function of the temporary. Note that the
 	 nullification of allocatable components needed by the result
 	 is done in gfc_trans_assignment_1.  */
-  if (expr && ((gfc_is_class_array_function (expr)
-		&& se->ss && se->ss->loop)
+  if (expr && (gfc_is_class_array_function (expr)
 		   || gfc_is_alloc_class_scalar_function (expr))
 	  && se->expr && GFC_CLASS_TYPE_P (TREE_TYPE (se->expr))
 	  && expr->must_finalize)
@@ -12028,18 +12027,25 @@ trans_class_assignment (stmtblock_t *block, gfc_expr *lhs, gfc_expr *rhs,
 
   /* Reallocate if dynamic types are different. */
   gfc_init_block (_alloc);
-  tmp = fold_convert (pvoid_type_node, class_han);
-  re = build_call_expr_loc (input_location,
-builtin_decl_explicit (BUILT_IN_REALLOC), 2,
-tmp, size);
-  re = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (tmp), tmp,
-			re);
-  tmp = fold_build2_loc (input_location, NE_EXPR,
-			 logical_type_node, rhs_vptr, old_vptr);
-  re = fold_build3_loc (input_location, COND_EXPR, void_type_node,
-			tmp, re, build_empty_stmt (input_location));
-  gfc_add_expr_to_block (_alloc, re);
-
+  if (UNLIMITED_POLY (lhs) && rhs->ts.type == BT_CHARACTER)
+	{
+	  gfc_add_expr_to_block (_alloc, gfc_call_free (class_han));
+	  gfc_allocate_using_malloc (_alloc, class_han, size, NULL_TREE);
+	}
+  else
+	{
+	  tmp = fold_convert (pvoid_type_node, class_han);
+	  re = build_call_expr_loc (input_location,
+builtin_decl_explicit (BUILT_IN_REALLOC),
+2, tmp, size);
+	  re = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (tmp),
+tmp, re);
+	  tmp = fold_build2_loc (input_location, NE_EXPR,
+ logical_type_node, rhs_vptr, old_vptr);
+	  re = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+tmp, re, build_empty_stmt (input_location));
+	  gfc_add_expr_to_block (_alloc, re);
+	}
   tree realloc_expr = lhs->ts.type == BT_CLASS ?
 	  gfc_finish_block (_alloc) :
 			

Re: [Patch, fortran] PR84006 [11/12/13/14/15 Regression] ICE in storage_size() with CLASS entity

2024-05-11 Thread 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?

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
>>
>>
>>
diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index c961cdbc2df..c63a4a8d38c 100644
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -3025,6 +3025,10 @@ gfc_resolve_transfer (gfc_expr *f, gfc_expr *source ATTRIBUTE_UNUSED,
 	}
 }
 
+  if (UNLIMITED_POLY (mold))
+gfc_error ("TODO: unlimited polymorphic MOLD in TRANSFER intrinsic at %L",
+	   >where);
+
   f->ts = mold->ts;
 
   if (size == NULL && mold->rank == 0)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index bc8eb419cff..4590aa6edb4 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -317,6 +317,8 @@ gfc_resize_class_size_with_len (stmtblock_t * block, tree class_expr, tree size)
 	  size = gfc_evaluate_now (size, block);
 	  tmp = gfc_evaluate_now (fold_convert (type , tmp), block);
 	}
+  else
+	tmp = fold_convert (type , tmp);
   tmp2 = fold_build2_loc (input_location, MULT_EXPR,
 			  type, size, tmp);
   tmp = fold_build2_loc (input_location, GT_EXPR,
@@ -11994,15 +11996,24 @@ trans_class_assignment (stmtblock_t *block, gfc_expr *lhs, gfc_expr *rhs,
 
   /* 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)
+  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 (tmp);
 	  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));
 	}
+  else if (rhs->ts.type == BT_CHARACTER && rse->string_length)
+	size = fold_build2_loc (input_location, MULT_EXPR,
+gfc_charlen_type_node, size,
+rse

Re: [Patch, fortran] PR84006 [11/12/13/14/15 Regression] ICE in storage_size() with CLASS entity

2024-05-09 Thread Paul Richard Thomas
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
>
>
> 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] PR84006 [11/12/13/14/15 Regression] ICE in storage_size() with CLASS entity

2024-05-08 Thread 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.
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index bc8eb419cff..4590aa6edb4 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -317,6 +317,8 @@ gfc_resize_class_size_with_len (stmtblock_t * block, tree class_expr, tree size)
 	  size = gfc_evaluate_now (size, block);
 	  tmp = gfc_evaluate_now (fold_convert (type , tmp), block);
 	}
+  else
+	tmp = fold_convert (type , tmp);
   tmp2 = fold_build2_loc (input_location, MULT_EXPR,
 			  type, size, tmp);
   tmp = fold_build2_loc (input_location, GT_EXPR,
@@ -11994,15 +11996,24 @@ trans_class_assignment (stmtblock_t *block, gfc_expr *lhs, gfc_expr *rhs,
 
   /* 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)
+  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 (tmp);
 	  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));
 	}
+  else if (rhs->ts.type == BT_CHARACTER && rse->string_length)
+	size = fold_build2_loc (input_location, MULT_EXPR,
+gfc_charlen_type_node, size,
+rse->string_length);
+
 
   tmp = lse->expr;
   class_han = GFC_CLASS_TYPE_P (TREE_TYPE (tmp))
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 83041183fcb..e18e4d1e183 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -8250,7 +8250,9 @@ gfc_conv_intrinsic_storage_size (gfc_se *se, gfc_expr *expr)
 {
   gfc_expr *arg;
   gfc_se argse;
-  tree type, result_type, tmp;
+  tree type, result_type, tmp, class_decl = NULL;
+  gfc_symbol *sym;
+  bool unlimited = false;
 
   arg = expr->value.function.actual->expr;
 
@@ -8261,10 +8263,12 @@ gfc_conv_intrinsic_storage_size (gfc_se *se, gfc_expr *expr)
 {
   if (arg->ts.type == BT_CLASS)
 	{
+	  unlimited = UNLIMITED_POLY (arg);
 	  gfc_add_vptr_component (arg);
 	  gfc_add_size_component (arg);
 	  gfc_conv_expr (, arg);
 	  tmp = fold_convert (result_type, argse.expr);
+	  class_decl = gfc_get_class_from_expr (argse.expr);
 	  goto done;
 	}
 
@@ -8276,14 +8280,20 @@ gfc_conv_intrinsic_storage_size (gfc_se *se, gfc_expr *expr)
 {
   argse.want_pointer = 0;
   gfc_conv_expr_descriptor (, arg);
+  sym = arg->expr_type == EXPR_VARIABLE ? arg->symtree->n.sym : NULL;
   if (arg->ts.type == BT_CLASS)
 	{
-	  if (arg->rank > 0)
+	  unlimited = UNLIMITED_POLY (arg);
+	  if (TREE_CODE (argse.expr) == COMPONENT_REF)
+	tmp = gfc_class_vtab_size_get (TREE_OPERAND (argse.expr, 0));
+	  else if (arg->rank > 0 && sym
+		   && DECL_LANG_SPECIFIC (sym->backend_decl))
 	tmp = gfc_class_vtab_size_get (
-		 GFC_DECL_SAVED_DESCRIPTOR (arg->symtree->n.sym->backend_decl));
+		 GFC_DECL_SAVED_DESCRIPTOR (sym->backend_decl));
 	  else
-	tmp = gfc_class_vtab_size_get (TREE_OPERAND (argse.expr, 0));
+	gcc_unreachable ();
 	  tmp = fold_convert (result_type, tmp);
+	  class_decl = gfc_get_class_from_expr 

Re: [PATCH] Fortran: fix issues with class(*) assignment [PR114827]

2024-05-05 Thread Paul Richard Thomas
Hi Harald,

Please do commit, with or without the extra bit for the function result.

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 :-)

Regards

Paul


Re: [PATCH] Fortran: fix issues with class(*) assignment [PR114827]

2024-04-29 Thread Paul Richard Thomas
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

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
>
>


Re: [Patch, fortran] PR114859 - [14/15 Regression] Seeing new segmentation fault in same_type_as since r14-9752

2024-04-29 Thread Paul Richard Thomas
Hi Mikael,

Thank you for the review and, in particular, the corrections in the fortran
ChangeLog. Unfortunately, both of us missed the systematically wrong PR
number. The commit was made to 15-branch with the wrong number throughout,
which I will correct tomorrow. This, however, has made a bit more work for
Jakub, which I have communicated to him through the PR. It is what comes of
working in a hurry, late at night.

The good news is that it fixes the original problem, which showed up
in Parallel Sparse BLAS is fixed.

Best regards

Paul


On Mon, 29 Apr 2024 at 09:34, Mikael Morin  wrote:

> Hello,
>
> Le 28/04/2024 à 23:37, Paul Richard Thomas a écrit :
> > Hi All,
> >
> > Could this be looked at quickly? The timing of this regression is more
> > than a little embarrassing on the eve of the 14.1 release. The testcase
> > and the comment in gfc_trans_class_init_assign explain what this problem
> > is all about and how the patch fixes it.
> >
> > OK for 15-branch and backporting to 14-branch (hopefully to the RC as
> well)?
> >
> > Paul
> >
> > Fortran: Fix regression caused by r14-9752 [PR114959]
> >
> > 2024-04-28  Paul Thomas  mailto:pa...@gcc.gnu.org>>
>
> You can drop the mailto:… thing. ;-)
>
> > gcc/fortran
> > PR fortran/114959
> > * trans-expr.cc (gfc_trans_class_init_assign): Return NULL_TREE
> > if the default initializer has all NULL fields. Guard this
> > by a requirement that the code be EXEC_INIT_ASSIGN and that the
> > object be an INTENT_IN dummy.
>
> In the patch, the code requirement is different from EXEC_ALLOCATE and
> the intent is INTENT_OUT, not INTENT_IN.
>
> > * trans-stmt.cc (gfc_trans_allocate): Change the initializer
> > code for allocate with mold to EXEC_ASSIGN to allow initializer
> > with all NULL fields..
>
> In the patch it's EXEC_ALLOCATE, not EXEC_ASSIGN.
>
> OK for master with the ChangeLog fixed.
> For 14, you need release manager approval, I think.
> Thanks for the quick fix.
>
> Mikael
>


[Patch, fortran] PR114859 - [14/15 Regression] Seeing new segmentation fault in same_type_as since r14-9752

2024-04-28 Thread Paul Richard Thomas
Hi All,

Could this be looked at quickly? The timing of this regression is more than
a little embarrassing on the eve of the 14.1 release. The testcase and the
comment in gfc_trans_class_init_assign explain what this problem is all
about and how the patch fixes it.

OK for 15-branch and backporting to 14-branch (hopefully to the RC as well)?

Paul

Fortran: Fix regression caused by r14-9752 [PR114959]

2024-04-28  Paul Thomas  

gcc/fortran
PR fortran/114959
* trans-expr.cc (gfc_trans_class_init_assign): Return NULL_TREE
if the default initializer has all NULL fields. Guard this
by a requirement that the code be EXEC_INIT_ASSIGN and that the
object be an INTENT_IN dummy.
* trans-stmt.cc (gfc_trans_allocate): Change the initializer
code for allocate with mold to EXEC_ASSIGN to allow initializer
with all NULL fields..

gcc/testsuite/
PR fortran/114959
* gfortran.dg/pr114959.f90: New test.
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 072adf3fe77..0280c441ced 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1720,6 +1720,7 @@ gfc_trans_class_init_assign (gfc_code *code)
   gfc_se dst,src,memsz;
   gfc_expr *lhs, *rhs, *sz;
   gfc_component *cmp;
+  gfc_symbol *sym;
 
   gfc_start_block ();
 
@@ -1736,18 +1737,25 @@ gfc_trans_class_init_assign (gfc_code *code)
   /* The _def_init is always scalar.  */
   rhs->rank = 0;
 
-  /* Check def_init for initializers.  If this is a dummy with all default
- initializer components NULL, return NULL_TREE and use the passed value as
- required by F2018(8.5.10).  */
-  if (!lhs->ref && lhs->symtree->n.sym->attr.dummy)
+  /* Check def_init for initializers.  If this is an INTENT(OUT) dummy with all
+ default initializer components NULL, return NULL_TREE and use the passed
+ value as required by F2018(8.5.10).  */
+  sym = code->expr1->expr_type == EXPR_VARIABLE ? code->expr1->symtree->n.sym
+		: NULL;
+  if (code->op != EXEC_ALLOCATE
+  && sym && sym->attr.dummy
+  && sym->attr.intent == INTENT_OUT)
 {
-  cmp = rhs->ref->next->u.c.component->ts.u.derived->components;
-  for (; cmp; cmp = cmp->next)
+  if (!lhs->ref && lhs->symtree->n.sym->attr.dummy)
 	{
-	  if (cmp->initializer)
-	break;
-	  else if (!cmp->next)
-	return build_empty_stmt (input_location);
+	  cmp = rhs->ref->next->u.c.component->ts.u.derived->components;
+	  for (; cmp; cmp = cmp->next)
+	{
+	  if (cmp->initializer)
+		break;
+	  else if (!cmp->next)
+		return NULL_TREE;
+	}
 	}
 }
 
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index c34e0b4c0cd..d355009fa5e 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -7262,11 +7262,12 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate)
 	{
 	  /* Use class_init_assign to initialize expr.  */
 	  gfc_code *ini;
-	  ini = gfc_get_code (EXEC_INIT_ASSIGN);
+	  ini = gfc_get_code (EXEC_ALLOCATE);
 	  ini->expr1 = gfc_find_and_cut_at_last_class_ref (expr, true);
 	  tmp = gfc_trans_class_init_assign (ini);
 	  gfc_free_statements (ini);
-	  gfc_add_expr_to_block (, tmp);
+	  if (tmp != NULL_TREE)
+	gfc_add_expr_to_block (, tmp);
 	}
   else if ((init_expr = allocate_get_initializer (code, expr)))
 	{
diff --git a/gcc/testsuite/gfortran.dg/pr114959.f90 b/gcc/testsuite/gfortran.dg/pr114959.f90
new file mode 100644
index 000..5cc3c052c1d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr114959.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Fix the regression caused by r14-9752 (fix for PR112407)
+! Contributed by Orion Poplawski  
+! Problem isolated by Jakub Jelinek   and further
+! reduced here.
+!
+module m
+  type :: smoother_type
+integer :: i
+  end type
+  type :: onelev_type
+class(smoother_type), allocatable :: sm
+class(smoother_type), allocatable :: sm2a
+  end type
+contains
+  subroutine save_smoothers(level,save1, save2)
+Implicit None
+type(onelev_type), intent(inout) :: level
+class(smoother_type), allocatable , intent(inout) :: save1, save2
+integer(4) :: info
+
+info  = 0
+! r14-9752 causes the 'stat' declaration from the first ALLOCATE statement
+! to disappear, which triggers an ICE in gimplify_var_or_parm_decl. The
+! second ALLOCATE statement has to be present for the ICE to occur.
+allocate(save1, mold=level%sm,stat=info)
+allocate(save2, mold=level%sm2a,stat=info)
+  end subroutine save_smoothers
+end module m
+! Two 'stat's from the allocate statements and two from the final wrapper.
+! { dg-final { scan-tree-dump-times "integer\\(kind..\\) stat" 4 "original" } }


[Patch, fortran] PR93678 - [11/12/13/14 Regression] ICE with TRANSFER and typebound procedures

2024-04-24 Thread Paul Richard Thomas
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?

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.
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 605434f4ddb..072adf3fe77 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -7879,8 +7879,14 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	{
 	  gcc_assert (se->loop && info);
 
-	  /* Set the type of the array.  */
-	  tmp = gfc_typenode_for_spec (>ts);
+	  /* Set the type of the array. vtable charlens are not always reliable.
+	 Use the interface, if possible.  */
+	  if (comp->ts.type == BT_CHARACTER
+	  && expr->symtree->n.sym->ts.type == BT_CLASS
+	  && comp->ts.interface && comp->ts.interface->result)
+	tmp = gfc_typenode_for_spec (>ts.interface->result->ts);
+	  else
+	tmp = gfc_typenode_for_spec (>ts);
 	  gcc_assert (se->ss->dimen == se->loop->dimen);
 
 	  /* Evaluate the bounds of the result, if known.  */
diff --git a/gcc/testsuite/gfortran.dg/pr93678.f90 b/gcc/testsuite/gfortran.dg/pr93678.f90
new file mode 100644
index 000..403bedd0c4f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr93678.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! Test the fix for PR93678 in which the charlen for the 'unpackbytes'
+! vtable field was incomplete and caused the ICE as indicated.
+! Contributed by Luis Kornblueh  
+!
+! The testcase was reduced by various gfortran regulars.
+module mo_a
+  implicit none
+  type t_b
+integer :: i
+  contains
+procedure :: unpackbytes => b_unpackbytes
+  end type t_b
+contains
+  function b_unpackbytes (me) result (res)
+class(t_b), intent(inout) :: me
+character :: res(1)
+res = char (me%i)
+  end function b_unpackbytes
+  subroutine b_unpackint (me, c)
+class(t_b), intent(inout) :: me
+character, intent(in) :: c
+!   print *, b_unpackbytes (me) ! ok
+if (any (me% unpackbytes () .ne. c)) stop 1 ! ICEd here
+  end subroutine b_unpackint
+end module mo_a
+
+  use mo_a
+  class(t_b), allocatable :: z
+  allocate (z, source = t_b(97))
+  call b_unpackint (z, "a")
+end


Re: [Patch, fortran] PR89462 - [11/12/13/14 Regression] gfortran loops in code generation

2024-04-24 Thread Paul Richard Thomas
PS ignore the chunk in trans-array.cc. It is an attempt to fix PR93678 that
literally did nothing.

Paul

On Wed, 24 Apr 2024 at 07:05, Paul Richard Thomas <
paul.richard.tho...@gmail.com> wrote:

> Hi,
>
> The linaro pre-commit error testing picked up errors for arm and aarch
> since they set the option -pedantic-errors.
> /home/tcwg-build/workspace/tcwg_gnu_4/abe/snapshots/gcc.git~master/gcc/testsuite/gfortran.dg/pr89462.f90:6:14:
> Warning: Obsolescent feature: Old-style character length at (1)
> /home/tcwg-build/workspace/tcwg_gnu_4/abe/snapshots/gcc.git~master/gcc/testsuite/gfortran.dg/pr89462.f90:7:17:
> Warning: Obsolescent feature: Old-style character length at (1)
>
> I have added the option to the testcase together with the corresponding
> warnings as in the attached.
>
> I will wait for 24 hours more.
>
> Paul
>
> On Tue, 23 Apr 2024 at 16:25, Paul Richard Thomas <
> paul.richard.tho...@gmail.com> wrote:
>
>> Hi All,
>>
>> Jakub pinpointed the source of this bug in comment 6 of the PR. The rest
>> was 'obvious' :-)
>>
>> I plan to push the patch to mainline in the next 24 hours unless there
>> are opinions to the contrary. Backporting is proposed to occur a couple of
>> weeks later.
>>
>> Best regards
>>
>> Paul
>>
>> Fortran: Generate new charlens for shared symbol typespecs [PR89462]
>>
>> 2024-04-23  Paul Thomas  
>>Jakub Jelinek  
>>
>> gcc/fortran
>> PR fortran/89462
>> * decl.cc (build_sym): Add an extra argument 'elem'. If 'elem'
>> is greater than 1, gfc_new_charlen is called to generate a new
>> charlen, registered in the symbol namespace.
>> (variable_decl, enumerator_decl): Set the new argument in the
>> calls to build_sym.
>>
>> gcc/testsuite/
>> PR fortran/89462
>> * gfortran.dg/pr89462.f90: New test.
>>
>>


Re: [Patch, fortran] PR89462 - [11/12/13/14 Regression] gfortran loops in code generation

2024-04-24 Thread Paul Richard Thomas
Hi,

The linaro pre-commit error testing picked up errors for arm and aarch
since they set the option -pedantic-errors.
/home/tcwg-build/workspace/tcwg_gnu_4/abe/snapshots/gcc.git~master/gcc/testsuite/gfortran.dg/pr89462.f90:6:14:
Warning: Obsolescent feature: Old-style character length at (1)
/home/tcwg-build/workspace/tcwg_gnu_4/abe/snapshots/gcc.git~master/gcc/testsuite/gfortran.dg/pr89462.f90:7:17:
Warning: Obsolescent feature: Old-style character length at (1)

I have added the option to the testcase together with the corresponding
warnings as in the attached.

I will wait for 24 hours more.

Paul

On Tue, 23 Apr 2024 at 16:25, Paul Richard Thomas <
paul.richard.tho...@gmail.com> wrote:

> Hi All,
>
> Jakub pinpointed the source of this bug in comment 6 of the PR. The rest
> was 'obvious' :-)
>
> I plan to push the patch to mainline in the next 24 hours unless there are
> opinions to the contrary. Backporting is proposed to occur a couple of
> weeks later.
>
> Best regards
>
> Paul
>
> Fortran: Generate new charlens for shared symbol typespecs [PR89462]
>
> 2024-04-23  Paul Thomas  
>Jakub Jelinek  
>
> gcc/fortran
> PR fortran/89462
> * decl.cc (build_sym): Add an extra argument 'elem'. If 'elem'
> is greater than 1, gfc_new_charlen is called to generate a new
> charlen, registered in the symbol namespace.
> (variable_decl, enumerator_decl): Set the new argument in the
> calls to build_sym.
>
> gcc/testsuite/
> PR fortran/89462
> * gfortran.dg/pr89462.f90: New test.
>
>
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index a7576f4bc40..b8308aeee55 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -1713,7 +1713,7 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
 /* Function called by variable_decl() that adds a name to the symbol table.  */
 
 static bool
-build_sym (const char *name, gfc_charlen *cl, bool cl_deferred,
+build_sym (const char *name, int elem, gfc_charlen *cl, bool cl_deferred,
 	   gfc_array_spec **as, locus *var_locus)
 {
   symbol_attribute attr;
@@ -1778,7 +1778,10 @@ build_sym (const char *name, gfc_charlen *cl, bool cl_deferred,
 
   if (sym->ts.type == BT_CHARACTER)
 {
-  sym->ts.u.cl = cl;
+  if (elem > 1)
+	sym->ts.u.cl = gfc_new_charlen (sym->ns, cl);
+  else
+	sym->ts.u.cl = cl;
   sym->ts.deferred = cl_deferred;
 }
 
@@ -2960,7 +2963,7 @@ variable_decl (int elem)
  create a symbol for those yet.  If we fail to create the symbol,
  bail out.  */
   if (!gfc_comp_struct (gfc_current_state ())
-  && !build_sym (name, cl, cl_deferred, , _locus))
+  && !build_sym (name, elem, cl, cl_deferred, , _locus))
 {
   m = MATCH_ERROR;
   goto cleanup;
@@ -10938,7 +10941,7 @@ enumerator_decl (void)
   /* OK, we've successfully matched the declaration.  Now put the
  symbol in the current namespace. If we fail to create the symbol,
  bail out.  */
-  if (!build_sym (name, NULL, false, , _locus))
+  if (!build_sym (name, 1, NULL, false, , _locus))
 {
   m = MATCH_ERROR;
   goto cleanup;
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 30b84762346..322ff552813 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -11756,8 +11756,16 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
   gfc_fix_class_refs (expr);
 
   for (ref = expr->ref; ref; ref = ref->next)
-if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
-  break;
+{
+  if (ref->type == REF_COMPONENT
+	  && ref->u.c.component->attr.function)
+	{
+	  ref = NULL;
+	  break;
+	}
+  if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
+  break;
+}
 
   return gfc_walk_array_ref (ss, expr, ref);
 }
diff --git a/gcc/testsuite/gfortran.dg/pr89462.f90 b/gcc/testsuite/gfortran.dg/pr89462.f90
new file mode 100644
index 000..b2a4912fcc8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr89462.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-pedantic-errors" }
+! Test the fix for PR89462 in which the shared 'cl' field of the typespec
+! shared between 'test', 'TR' and 'aTP' caused the compiler to go into an
+! infinite loop.
+! Contributed by Sergei Trofimovich  
+  CHARACTER*1 FUNCTION test(H) ! { dg-warning "Old-style character length" }
+ CHARACTER*1 test2,TR,aTP  ! { dg-warning "Old-style character length" }
+ ENTRY test2(L)
+ CALL ttest3(aTP)
+ test = TR
+ RETURN
+  END


[Patch, fortran] PR89462 - [11/12/13/14 Regression] gfortran loops in code generation

2024-04-23 Thread Paul Richard Thomas
Hi All,

Jakub pinpointed the source of this bug in comment 6 of the PR. The rest
was 'obvious' :-)

I plan to push the patch to mainline in the next 24 hours unless there are
opinions to the contrary. Backporting is proposed to occur a couple of
weeks later.

Best regards

Paul

Fortran: Generate new charlens for shared symbol typespecs [PR89462]

2024-04-23  Paul Thomas  
   Jakub Jelinek  

gcc/fortran
PR fortran/89462
* decl.cc (build_sym): Add an extra argument 'elem'. If 'elem'
is greater than 1, gfc_new_charlen is called to generate a new
charlen, registered in the symbol namespace.
(variable_decl, enumerator_decl): Set the new argument in the
calls to build_sym.

gcc/testsuite/
PR fortran/89462
* gfortran.dg/pr89462.f90: New test.
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index a7576f4bc40..b8308aeee55 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -1713,7 +1713,7 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
 /* Function called by variable_decl() that adds a name to the symbol table.  */
 
 static bool
-build_sym (const char *name, gfc_charlen *cl, bool cl_deferred,
+build_sym (const char *name, int elem, gfc_charlen *cl, bool cl_deferred,
 	   gfc_array_spec **as, locus *var_locus)
 {
   symbol_attribute attr;
@@ -1778,7 +1778,10 @@ build_sym (const char *name, gfc_charlen *cl, bool cl_deferred,
 
   if (sym->ts.type == BT_CHARACTER)
 {
-  sym->ts.u.cl = cl;
+  if (elem > 1)
+	sym->ts.u.cl = gfc_new_charlen (sym->ns, cl);
+  else
+	sym->ts.u.cl = cl;
   sym->ts.deferred = cl_deferred;
 }
 
@@ -2960,7 +2963,7 @@ variable_decl (int elem)
  create a symbol for those yet.  If we fail to create the symbol,
  bail out.  */
   if (!gfc_comp_struct (gfc_current_state ())
-  && !build_sym (name, cl, cl_deferred, , _locus))
+  && !build_sym (name, elem, cl, cl_deferred, , _locus))
 {
   m = MATCH_ERROR;
   goto cleanup;
@@ -10938,7 +10941,7 @@ enumerator_decl (void)
   /* OK, we've successfully matched the declaration.  Now put the
  symbol in the current namespace. If we fail to create the symbol,
  bail out.  */
-  if (!build_sym (name, NULL, false, , _locus))
+  if (!build_sym (name, 1, NULL, false, , _locus))
 {
   m = MATCH_ERROR;
   goto cleanup;
diff --git a/gcc/testsuite/gfortran.dg/pr89462.f90 b/gcc/testsuite/gfortran.dg/pr89462.f90
new file mode 100644
index 000..9efdb1adbc7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr89462.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! Test the fix for PR89462 in which the shared 'cl' field of the typespec
+! shared between 'test', 'TR' and 'aTP' caused the compiler to go into an
+! infinite loop.
+! Contributed by Sergei Trofimovich  
+  CHARACTER*1 FUNCTION test(H)
+ CHARACTER*1 test2,TR,aTP
+ ENTRY test2(L)
+ CALL ttest3(aTP)
+ test = TR
+ RETURN
+  END


Re: [Patch, fortran] PR103471 - [11/12/13/14 Regression] ICE in gfc_typenode_for_spec, at fortran/trans-types.c:1114

2024-04-20 Thread Paul Richard Thomas
Hi Harald,

>
> the patch is OK, but I had to manually fix it.  I wonder how you managed
> to produce:
>

Yes, I had to use --whitespace fix when I reapplied it a few minutes ago.

>
> diff --git a/gcc/testsuite/gfortran.dg/pr93484.f90
>

I had followed comment 1 in the PR and wrongly named the file because of
it. Now corrected.


>
> 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.


> 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.

I'll come back to you on this.

Thanks for the report.

Paul


[Patch, fortran] PR103471 - [11/12/13/14 Regression] ICE in gfc_typenode_for_spec, at fortran/trans-types.c:1114

2024-04-19 Thread Paul Richard Thomas
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.
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 6b3e5ba4fcb..9b7fabd3707 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -5001,7 +5001,8 @@ gfc_resolve_index_1 (gfc_expr *index, int check_scalar,

   if ((index->ts.kind != gfc_index_integer_kind
&& force_index_integer_kind)
-  || index->ts.type != BT_INTEGER)
+  || (index->ts.type != BT_INTEGER
+	  && index->ts.type != BT_UNKNOWN))
 {
   gfc_clear_ts ();
   ts.type = BT_INTEGER;
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 3a3b6de5cec..8f7deac1d1e 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -320,7 +320,7 @@ gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns)
 		   "; did you mean %qs?",
 		   sym->name, >declared_at, guessed);
 	  else
-	gfc_error ("Symbol %qs at %L has no IMPLICIT type(symbol)",
+	gfc_error ("Symbol %qs at %L has no IMPLICIT type",
 		   sym->name, >declared_at);
 	  sym->attr.untyped = 1; /* Ensure we only give an error once.  */
 	}
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index e160c5c98c1..301439baaf5 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1797,7 +1797,8 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 }

   if (sym->ts.type == BT_UNKNOWN)
-gfc_fatal_error ("%s at %C has no default type", sym->name);
+gfc_fatal_error ("%s at %L has no default type", sym->name,
+		 >declared_at);

   if (sym->attr.intrinsic)
 gfc_internal_error ("intrinsic variable which isn't a procedure");
@@ -5214,8 +5215,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 	tree tmp = lookup_attribute ("omp allocate",
  DECL_ATTRIBUTES (n->sym->backend_decl));
 	tmp = TREE_VALUE (tmp);
-	TREE_PURPOSE (tmp) = se.expr;
-	TREE_VALUE (tmp) = align;
+	TREE_PURPOSE (tmp) = se.expr;
+	TREE_VALUE (tmp) = align;
 	TREE_PURPOSE (TREE_CHAIN (tmp)) = init_stmtlist;
 	TREE_VALUE (TREE_CHAIN (tmp)) = cleanup_stmtlist;
   }
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 @@
+! { dg-do compile }
+! Test the fix for PR103471 in which, rather than giving a "no IMPLICIT type"
+! message, gfortran took to ICEing. The fuzzy symbol check for 'kk' demonstrates
+! that the error is being detected in the right place.
+!
+! Contributed by Gerhard Steinmetz  
+!
+program p
+   implicit none
+   integer, parameter :: x(4) = [1,2,3,4]
+   integer :: kk
+   print *, [real(x(k))] ! { dg-error "has no IMPLICIT type; did you mean .kk.\\?" }
+end


[Patch, fortran] PR114739 [14 Regression] ice in gfc_find_derived_types, at fortran/symbol.cc:2458

2024-04-17 Thread Paul Richard Thomas
This ICE was caused by my patch r14-9489-g3fd46d859cda10. However, the ICE
hid a wrong error going back to at least 6.4.1 20180703. The patch fixes
both and exposed incorrect error messages in existing tests in gfortran.dg.
The fix for these was to add 'IMPLICIT NONE' in call cases so that there
really is no implicit type.

Regtests OK - I will commit in 24 hours time, if there are no objections
and will backport in a couple of weeks.

Paul

Fortran: Fix ICE in gfc_match_varspec and error messages [PR114739]

2024-04-17  Paul Thomas  

gcc/fortran
PR fortran/114739
* primary.cc (gfc_match_varspec): Check for default type before
checking for derived types with the right component name.

gcc/testsuite/
PR fortran/114739
* gfortran.dg/pr114739.f90: New test.
* gfortran.dg/derived_comp_array_ref_8.f90: Add 'implicit none'
for consistency with expected error message.
* gfortran.dg/nullify_4.f90: ditto
* gfortran.dg/pointer_init_6.f90: ditto
* gfortran.dg/pr107397.f90: ditto
* gfortran.dg/pr88138.f90: ditto
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 5dd6875a4a6..3c64fa73dfa 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2236,6 +2236,15 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
   match mm;
   old_loc = gfc_current_locus;
   mm = gfc_match_name (name);
+
+  /* Check to see if this is default complex.  */
+  if (sym->ts.type == BT_UNKNOWN && tgt_expr == NULL
+	  && gfc_get_default_type (sym->name, sym->ns)->type != BT_UNKNOWN)
+	{
+	  gfc_set_default_type (sym, 0, sym->ns);
+	  primary->ts = sym->ts;
+	}
+
   /* This is a usable inquiry reference, if the symbol is already known
 	 to have a type or no derived types with a component of this name
 	 can be found.  If this was an inquiry reference with the same name
diff --git a/gcc/testsuite/gfortran.dg/derived_comp_array_ref_8.f90 b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_8.f90
index 739f4adfb78..22dfdc668a6 100644
--- a/gcc/testsuite/gfortran.dg/derived_comp_array_ref_8.f90
+++ b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_8.f90
@@ -2,6 +2,7 @@
 !
 ! PR fortran/52325
 !
+implicit none
 real :: f
 cc%a = 5 ! { dg-error "Symbol 'cc' at .1. has no IMPLICIT type" }
 f%a = 5  ! { dg-error "Unexpected '%' for nonderived-type variable 'f' at" }
diff --git a/gcc/testsuite/gfortran.dg/nullify_4.f90 b/gcc/testsuite/gfortran.dg/nullify_4.f90
index 0fd5056ee07..240110fabf8 100644
--- a/gcc/testsuite/gfortran.dg/nullify_4.f90
+++ b/gcc/testsuite/gfortran.dg/nullify_4.f90
@@ -3,6 +3,7 @@
 !
 ! Check error recovery; was crashing before.
 !
+implicit none
 real, pointer :: ptr
 nullify(ptr, mesh%coarser) ! { dg-error "Symbol 'mesh' at .1. has no IMPLICIT type" }
 end
diff --git a/gcc/testsuite/gfortran.dg/pointer_init_6.f90 b/gcc/testsuite/gfortran.dg/pointer_init_6.f90
index 3abad4ae179..477626e66bb 100644
--- a/gcc/testsuite/gfortran.dg/pointer_init_6.f90
+++ b/gcc/testsuite/gfortran.dg/pointer_init_6.f90
@@ -21,7 +21,7 @@ end module m1


 module m2
-
+ implicit none
  type :: t
procedure(s), pointer, nopass :: ppc
  end type
diff --git a/gcc/testsuite/gfortran.dg/pr107397.f90 b/gcc/testsuite/gfortran.dg/pr107397.f90
index fd59bf16007..f77b4b00d00 100644
--- a/gcc/testsuite/gfortran.dg/pr107397.f90
+++ b/gcc/testsuite/gfortran.dg/pr107397.f90
@@ -1,6 +1,7 @@
 !{ dg-do compile }
 !
 program p
+  implicit none
   type t
 real :: a = 1.0
   end type
diff --git a/gcc/testsuite/gfortran.dg/pr114739.f90 b/gcc/testsuite/gfortran.dg/pr114739.f90
new file mode 100644
index 000..eb82cb3f65b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr114739.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! The fix here was triggered by an ICE prior to r14-9489-g3fd46d859cda10
+! Before that gfortran gave an incorrect "no implicit type" error for all
+! three statements.
+program main
+  implicit complex(z)
+  implicit character(c)
+  z2%re = 1.
+  z2%im = 2.
+  print *, z2, c%kind
+end
diff --git a/gcc/testsuite/gfortran.dg/pr88138.f90 b/gcc/testsuite/gfortran.dg/pr88138.f90
index c4019a6ca2e..f1130cf2bab 100644
--- a/gcc/testsuite/gfortran.dg/pr88138.f90
+++ b/gcc/testsuite/gfortran.dg/pr88138.f90
@@ -1,5 +1,6 @@
 ! { dg-do compile }
 program p
+   implicit none
type t
   character :: c = 'c'
end type


[Patch, fortran] PR113363 - ICE on ASSOCIATE and unlimited polymorphic function

2024-04-10 Thread Paul Richard Thomas
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.

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.
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 30b84762346..2f9a32dda15 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -5957,6 +5957,11 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
   tmp = gfc_conv_descriptor_dtype (descriptor);
   gfc_add_modify (pblock, tmp, gfc_get_dtype_rank_type (rank, type));
 }
+  else if (expr3_desc && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (expr3_desc)))
+{
+  tmp = gfc_conv_descriptor_dtype (descriptor);
+  gfc_add_modify (pblock, tmp, gfc_conv_descriptor_dtype (expr3_desc));
+}
   else
 {
   tmp = gfc_conv_descriptor_dtype (descriptor);
@@ -11324,6 +11329,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 (desc, 0)));
 	  else
 	gfc_add_modify (, tmp,
 			build_int_cst (TREE_TYPE (tmp), 0));
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 7997c167bae..c6953033cf4 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -7187,6 +7187,45 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate)
 	  gfc_expr *rhs = e3rhs ? e3rhs : gfc_copy_expr (code->expr3);
 	  flag_realloc_lhs = 0;
 
+	  /* The handling of code->expr3 above produces a derived type of
+	 type "STAR", whose size defaults to size(void*). In order to
+	 have the right type information for the assignment, we must
+	 reconstruct an unlimited polymorphic rhs.  */
+	  if (UNLIMITED_POLY (code->expr3)
+	  && e3rhs && e3rhs->ts.type == BT_DERIVED
+	  && !strcmp (e3rhs->ts.u.derived->name, "STAR"))
+	{
+	  gfc_ref *ref;
+	  gcc_assert (TREE_CODE (expr3_vptr) == COMPONENT_REF);
+	  tmp = gfc_create_var (gfc_typenode_for_spec (>expr3->ts),
+"e3");
+	  gfc_add_modify (, tmp,
+			  gfc_get_class_from_expr (expr3_vptr));
+	  rhs->symtree->n.sym->backend_decl = tmp;
+	  rhs->ts = code->expr3->ts;
+	  rhs->symtree->n.sym->ts = rhs->ts;
+	  for (ref = init_expr->ref; ref; ref = ref->next)
+		{
+		  /* 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;
+		}
+		  else if ((init_expr->rank && !code->expr3->rank
+			&& ref && ref->next && !ref->next->next)
+			   || (ref && !ref->next))
+		{
+		  rhs->ref = gfc_copy_ref (ref);
+		  break;
+		}
+		}
+	}
+
 	  /* Set the symbol to be artificial so that the result is not finalized.  */
 	  init_expr->symtree->n.sym->attr.artificial = 1;
 	  tmp = gfc_trans_assignment (init_expr, rhs, true, false, true,
diff --git a/gcc/testsuite/gfortran.dg/pr113363.f90 b/gcc/testsuite/gfortran.dg/pr113363.f90
new file mode 100644
index 000..7701539fdff
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr113363.f90
@@ -0,0 +1,86 @@
+! { dg-do run }
+! Test the fix for comment 1 in PR113363, which failed as in comments below.
+! Contributed by Harald Anlauf  
+program p
+  implicit none
+  class(*), allocatable :: x(:), y
+  character(*), parameter :: arr(2) = ["hello ","bye   "], &
+ sca = "Have a nice day"
+
+! Bug was detected in polymorphic array function results
+  allocate(x, source = foo ())
+  call check1 (x, arr)  ! Wrong output "6 hello e"
+  deallocate (x)
+  x = foo ()
+  call check1 (x, arr)  ! Wrong output "0  "
+  associate 

[Patch, fortran] PR113956 - [13/14 Regression] ice in gfc_trans_pointer_assignment, at fortran/trans-expr.cc:10524

2024-04-09 Thread Paul Richard Thomas
Patch pushed after pre-approval by Harald on Bugzilla.

Fortran: Fix ICE in gfc_trans_pointer_assignment [PR113956]

2024-04-09  Paul Thomas  

gcc/fortran
PR fortran/113956
* trans-expr.cc (gfc_trans_pointer_assignment): Remove assert
causing the ICE since it was unnecesary.

gcc/testsuite/
PR fortran/113956
* gfortran.dg/pr113956.f90: New test.

Paul


[Patch, fortran] PR114535 - [13/14 regression] ICE with elemental finalizer

2024-04-08 Thread Paul Richard Thomas
Hi All,

This one is blazingly 'obvious'. I haven't had the heart to investigate why
somebody thought that it is a good idea to check if unreferenced symbols
are finalizable because, I suspect, that 'somebody' was me. Worse, I tried
a couple of other fixes before I hit on the 'obvious' one :-(

The ChangeLog says it all. OK for mainline and then backporting in a couple
of weeks?

Paul

Fortran: Fix ICE in trans-stmt.cc(gfc_trans_call) [PR114535]

2024-04-08  Paul Thomas  

gcc/fortran
PR fortran/114535
* resolve.cc (resolve_symbol): Remove last chunk that checked
for finalization of unreferenced symbols.

gcc/testsuite/
PR fortran/114535
* gfortran.dg/pr114535d.f90: New test.
* gfortran.dg/pr114535iv.f90: Additional source.
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 43315a6a550..4cbf7186119 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -17069,15 +17069,6 @@ resolve_symbol (gfc_symbol *sym)
 
   if (sym->param_list)
 resolve_pdt (sym);
-
-  if (!sym->attr.referenced
-  && (sym->ts.type == BT_CLASS || sym->ts.type == BT_DERIVED))
-{
-  gfc_expr *final_expr = gfc_lval_expr_from_sym (sym);
-  if (gfc_is_finalizable (final_expr->ts.u.derived, NULL))
-	gfc_set_sym_referenced (sym);
-  gfc_free_expr (final_expr);
-}
 }
 
 
diff --git a/gcc/testsuite/gfortran.dg/pr114535d.f90 b/gcc/testsuite/gfortran.dg/pr114535d.f90
new file mode 100644
index 000..7ce178a1e30
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr114535d.f90
@@ -0,0 +1,42 @@
+! { dg-do compile }
+! { dg-compile-aux-modules "pr114535iv.f90" }
+! Contributed by Andrew Benson  
+!
+module d
+  implicit none
+contains
+  function en() result(dd)
+use :: iv
+implicit none
+type(vs) :: dd
+dd%i = 1
+  end function en
+end module d
+
+! Delete line 1 and all brands complain that 'vs' is an undefined type.
+! Delete lines 1 and line 2 recreates the original problem.
+module ni
+  implicit none
+contains
+  subroutine iss1()
+!use :: iv! line 1
+use :: d
+implicit none
+!type(vs) :: ans; ans = en(); ! line 2
+  end subroutine iss1
+  subroutine iss2()
+use :: d
+implicit none
+  end subroutine iss2
+end module ni ! Used to give an ICE: in gfc_trans_call, at fortran/trans-stmt.cc:400
+
+  use ni
+  use iv
+  type(vs) :: x
+  call iss1()
+  call iss1()
+  if ((ctr .eq. 0) .or. (ctr .ne. 6)) stop 1  ! Depends whether lines 1 & 2 are present
+  call iss2()
+  x = vs(42)
+  if ((ctr .eq. 1) .or. (ctr .ne. 7)) stop 2  ! Make sure destructor available here
+end
diff --git a/gcc/testsuite/gfortran.dg/pr114535iv.f90 b/gcc/testsuite/gfortran.dg/pr114535iv.f90
new file mode 100644
index 000..be629991023
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr114535iv.f90
@@ -0,0 +1,18 @@
+! Compiled with pr114535d.f90
+! Contributed by Andrew Benson  
+!
+module iv
+  type, public :: vs
+ integer :: i
+   contains
+ final :: destructor
+  end type vs
+  integer :: ctr = 0
+contains
+  impure elemental subroutine destructor(s)
+type(vs), intent(inout) :: s
+s%i = 0
+ctr = ctr + 1
+  end subroutine destructor
+end module iv
+


Re: [patch, libgfortran] PR114304 - [13/14 Regression] libgfortran I/O – bogus "Semicolon not allowed as separator with DECIMAL='point'"

2024-04-04 Thread Paul Richard Thomas
Hi Jerry,

It looks good to me. Noting that this is not a regression, OK for mainline
on condition that you keep a sharp eye out for any associated problems.
Likewise with backporting to 13-branch.

Thanks

Paul


On Thu, 4 Apr 2024 at 02:34, Jerry D  wrote:

> Hi all,
>
> The attached log entry and patch (git show) fixes this issue by adding
> logic to handle spaces in eat_separators. One or more spaces by
> themselves are a valid separator. So in this case we look at the
> character following the spaces to see if it is a comma or semicolon.
>
> If so, I change it to the valid separator for the given decimal mode,
> point or comma. This allows the comma or semicolon to be interpreted as
> a null read on the next effective item in the formatted read.
>
> I chose a permissive approach here that allows reads to proceed when the
> input line is mal-formed with an incorrect separator as long as there is
> at least one space in front of it.
>
> New test case included. Regression tested on X86-64.
>
> OK for trunk?  Backport to 13 after some time.
>
> Regards,
>
> Jerry


[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

2024-03-31 Thread Paul Richard Thomas
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?

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.
diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index 7b86a338bc1..bf151dae743 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -1789,6 +1789,14 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2,
   return false;
 }

+  if (s2->attr.subroutine && s1->attr.flavor == FL_VARIABLE)
+{
+  if (errmsg != NULL)
+	snprintf (errmsg, err_len, "subroutine proc pointer '%s' passed "
+		  "to dummy variable '%s'", name2, s1->name);
+  return false;
+}
+
   /* Do strict checks on all characteristics
  (for dummy procedures and procedure pointer assignments).  */
   if (!generic_flag && strict_flag)
@@ -2425,12 +2433,22 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 {
   gfc_symbol *act_sym = actual->symtree->n.sym;

-  if (formal->attr.flavor != FL_PROCEDURE)
+  if (formal->attr.flavor != FL_PROCEDURE && !act_sym->ts.interface)
 	{
 	  if (where)
 	gfc_error ("Invalid procedure argument at %L", >where);
 	  return false;
 	}
+  else if (act_sym->ts.interface
+	   && !gfc_compare_interfaces (formal, act_sym->ts.interface,
+	   act_sym->name, 0, 1, err,
+	   sizeof(err),NULL, NULL))
+	{
+	  if (where)
+	gfc_error_opt (0, "Interface mismatch in dummy procedure %qs at %L:"
+			   " %s", formal->name, >where, err);
+	  return false;
+	}

   if (!gfc_compare_interfaces (formal, act_sym, act_sym->name, 0, 1, err,
    sizeof(err), NULL, NULL))
diff --git a/gcc/testsuite/gfortran.dg/pr106999.f90 b/gcc/testsuite/gfortran.dg/pr106999.f90
new file mode 100644
index 000..b3f1d7741f3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr106999.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! Test the fix for PR106999
+! Contributed by Gerhard Steinmetz  
+program p
+   type t
+  integer :: i
+  procedure(g), pointer :: f
+   end type
+   class(t), allocatable :: y, z
+   procedure(g), pointer :: ff
+   allocate (z)
+   z%i = 42
+   z%f => g
+   ff => g
+   call r(z%f)
+   call s(z%f) ! { dg-error "Interface mismatch in dummy procedure" }
+   call s(ff)  ! { dg-error "Interface mismatch in dummy procedure" }
+contains
+   subroutine g(x)
+  class(t) :: x
+  x%i = 84
+   end
+   subroutine r(x)
+  procedure(g) :: x
+  print *, "in r"
+  allocate (y)
+  call x(y)
+  print *, y%i
+   end
+   subroutine s(x)
+  class(*) :: x
+   end subroutine
+end


Re: [Patch, fortran] PR112407 - [13/14 Regression] Fix for PR37336 triggers an ICE in gfc_format_decoder while constructing a vtab

2024-03-31 Thread 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.


> 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.
> >
>
>
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 50d51b06c92..43315a6a550 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -1963,12 +1963,20 @@ resolve_procedure_expression (gfc_expr* expr)
   || (sym->attr.function && sym->result == sym))
 return true;

-  /* A non-RECURSIVE procedure that is used as procedure expression within its
+   /* A non-RECURSIVE procedure that is used as procedure expression within its
  own body is in danger of being called recursively.  */
   if (is_illegal_recursion (sym, gfc_current_ns))
-gfc_warning (0, "Non-RECURSIVE procedure %qs at %L is possibly calling"
-		 " itself recursively.  Declare it RECURSIVE or use"
-		 " %<-frecursive%>", sym->name, >where);
+{
+  if (sym->attr.use_assoc && expr->symtree->name[0] == '@')
+	gfc_warning (0, "Non-RECURSIVE procedure %qs from module %qs is "
+		 " possibly calling itself recursively in procedure %qs. "
+		 " Declare it RECURSIVE or use %<-frecursive%>",
+		 sym->name, sym->module, gfc_current_ns->proc_name->name);
+  else
+	gfc_warning (0, "Non-RECURSIVE procedure %qs at %L is possibly calling"
+		 " itself recursively.  Declare it RECURSIVE or use"
+		 " %<-frecursive%>", sym->name, >where);
+}

   return true;
 }
@@ -6820,6 +6828,13 @@ resolve_typebound_static (gfc_expr* e, gfc_symtree** target,
   if (st)
 	*target = st;
 }
+
+  if (is_illegal_recursion ((*target)->n.sym, gfc_current_ns)
+  && !e->value.compcall.tbp->deferred)
+gfc_warning (0, "Non-RECURSIVE procedure %qs at %L is possibly calling"
+		 " itself recursively.  Declare it RECURSIVE or use"
+		 " %<-frecursive%>", (*target)->n.sym->name, >where);
+
   return true;
 }

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 76bed9830c4..f3fcba2bd59 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1719,6 +1719,7 @@ gfc_trans_class_init_assign (gfc_code *code)
   tree tmp;
   gfc_se dst,src,memsz;
   gfc_expr *lhs, *rhs, *sz;
+  gfc_component *cmp;

   gfc_start_block ();

@@ -1735,6 +1736,21 @@ gfc_trans_class_init_assign (gfc_code *code)
   /* The _def_init is always scalar.  */
   rhs->rank = 0;

+  /* Check def_init for initializers.  If this is a dummy with all default
+ initializer components NULL, return NULL_TREE and use the passed value as
+ required by F2018(8.5.10).  */
+  if (!lhs->ref && lhs->symtree->n.sym->attr.dummy)
+{
+  cmp = rhs->ref->next->u.c.component->ts.u.derived->components;
+  for (; cmp; cmp = cmp->next)
+	{
+	  if (cmp->initializer)
+	break;
+	  else if (!cmp->next)
+	return build_empty_stmt (input_location);
+	}
+}
+
   if (code->expr1->ts.type == BT_CLASS
   && CLASS_DATA (code->expr1)->attr.dimension)
 {
diff --git a/gcc/testsuite/gfortran.dg/pr112407a.f90 b/gcc/testsuite/gfortran.dg/pr112407a.f90
new file mode 100644
index 000..470f4191611
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr112407a.f90
@@ -0,0 +1,71 @@
+! { dg-do run }
+! Test of an issue found in the investigation of PR112407
+! Contributed by Tomas Trnka  
+!
+module m
+  private new_t
+
+  type s
+procedure(),pointer,nopass :: op
+  end type
+
+  type :: t
+integer :: i
+type (s) :: s
+  

[Patch, fortran] PR112407 - [13/14 Regression] Fix for PR37336 triggers an ICE in gfc_format_decoder while constructing a vtab

2024-03-30 Thread 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.
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 50d51b06c92..43315a6a550 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -1963,12 +1963,20 @@ resolve_procedure_expression (gfc_expr* expr)
   || (sym->attr.function && sym->result == sym))
 return true;
 
-  /* A non-RECURSIVE procedure that is used as procedure expression within its
+   /* A non-RECURSIVE procedure that is used as procedure expression within its
  own body is in danger of being called recursively.  */
   if (is_illegal_recursion (sym, gfc_current_ns))
-gfc_warning (0, "Non-RECURSIVE procedure %qs at %L is possibly calling"
-		 " itself recursively.  Declare it RECURSIVE or use"
-		 " %<-frecursive%>", sym->name, >where);
+{
+  if (sym->attr.use_assoc && expr->symtree->name[0] == '@')
+	gfc_warning (0, "Non-RECURSIVE procedure %qs from module %qs is "
+		 " possibly calling itself recursively in procedure %qs. "
+		 " Declare it RECURSIVE or use %<-frecursive%>",
+		 sym->name, sym->module, gfc_current_ns->proc_name->name);
+  else
+	gfc_warning (0, "Non-RECURSIVE procedure %qs at %L is possibly calling"
+		 " itself recursively.  Declare it RECURSIVE or use"
+		 " %<-frecursive%>", sym->name, >where);
+}
 
   return true;
 }
@@ -6820,6 +6828,13 @@ resolve_typebound_static (gfc_expr* e, gfc_symtree** target,
   if (st)
 	*target = st;
 }
+
+  if (is_illegal_recursion ((*target)->n.sym, gfc_current_ns)
+  && !e->value.compcall.tbp->deferred)
+gfc_warning (0, "Non-RECURSIVE procedure %qs at %L is possibly calling"
+		 " itself recursively.  Declare it RECURSIVE or use"
+		 " %<-frecursive%>", (*target)->n.sym->name, >where);
+
   return true;
 }
 
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 76bed9830c4..3b54874cf1f 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1719,6 +1719,7 @@ gfc_trans_class_init_assign (gfc_code *code)
   tree tmp;
   gfc_se dst,src,memsz;
   gfc_expr *lhs, *rhs, *sz;
+  gfc_component *cmp;
 
   gfc_start_block ();
 
@@ -1735,6 +1736,21 @@ gfc_trans_class_init_assign (gfc_code *code)
   /* The _def_init is always scalar.  */
   rhs->rank = 0;
 
+  /* Check def_init for initializers.  If this is a dummy with all default
+ initializer components NULL, return NULL_TREE and use the passed value as
+ required by F2018(8.5.10).  */
+  if (!lhs->ref && lhs->symtree->n.sym->attr.dummy)
+{
+  cmp = rhs->ref->next->u.c.component->ts.u.derived->components;
+  for (; cmp; cmp = cmp->next)
+	{
+	  if (cmp->initializer)
+	break;
+	  else if (!cmp->next)
+	return build_empty_stmt (input_location);
+	}
+}
+
   if (code->expr1->ts.type == BT_CLASS
   && CLASS_DATA (code->expr1)->attr.dimension)
 {
@@ -12511,11 +12527,14 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
   gfc_add_block_to_block (, );
   gfc_add_expr_to_block (, tmp);
 
-  /* Add the post blocks to the body.  */
-  if (!l_is_temp)
+  /* Add the post blocks to the body.  Scalar finalization must appear before
+ the post block in case any dellocations are done.  */
+  if (rse.finalblock.head
+  && (!l_is_temp || (expr2->expr_type == EXPR_FUNCTION
+			 && gfc_expr_attr (expr2).elemental)))
 {
-  gfc_add_block_to_block (, );
   gfc_add_block_to_block (, );
+  gfc_add_block_to_block (, 

Re: [Patch, fortran] PR110987 and PR113885 - gimplifier ICEs and wrong results in finalization

2024-03-29 Thread Paul Richard Thomas
Hi Harald,

Thanks for the thumbs-up. Committed as
3c793f0361bc66d2a6bf0b3e1fb3234fc511e2a6.

I will backport to 13-branch in a couple of weeks.

Best regards

Paul


On Thu, 28 Mar 2024 at 22:27, Harald Anlauf  wrote:

> ...snip...
> yes, this looks good here.
>
> ...snip...

The patch looks rather "conservative" (read: safe) and appears to
> fix the regressions very well, so go ahead as planned.
>
> Thanks for the patch!
>
> Harald
>
>


[Patch, fortran] PR110987 and PR113885 - gimplifier ICEs and wrong results in finalization

2024-03-28 Thread Paul Richard Thomas
Hi All,

The attached patch has two elements:

(i) A fix for gimplifier ICEs with derived type having no components. The
reporter himself suggested (thanks Kirill!):

-  if (derived && derived->attr.zero_comp)
+  if (derived && (derived->components == NULL))

As far as I can tell, this is the correct fix. I tried setting
attr.zero_comp in resolve.cc for all the OK types without components but
this caused all sorts of fallout.

(ii) Final calls were occurring in the wrong place for finalizable
elemental function calls within scalarizer loops. This caused incorrect
results even for derived types with components. This is also fixed.

It should be noted that finalizer calls from the rhs of an assignment are
occurring at the wrong time, since F2018/24-7.5.6.3 requires:
"If an executable construct references a nonpointer function, the result is
finalized after execution of the innermost executable construct containing
the reference.", while in the present implementation, this happening just
before assignment to the lhs temporary. Fixing this is going to be really
tough and invasive, so I decided that getting the right results and the
correct number of finalization should be sufficient for the 14-branch
release. As it happens, I had been mulling over how to do this for
finalizations hidden in constructors and other contexts than assignment
(eg. write statements or allocation with source). It's a few months away
and will be appropriate for stage 1.

Regtests on x86_64 - OK for mainline and then, after a bit, for backporting
to 13-branch?

Regards to all

Paul

Fortran: Fix a gimplifier ICE/wrong result with finalization [PR104555]

2024-03-28  Paul Thomas  

gcc/fortran
PR fortran/36337
PR fortran/110987
PR fortran/113885
* trans-expr.cc (gfc_trans_assignment_1): Place finalization
block before rhs post block for elemental rhs.
* trans.cc (gfc_finalize_tree_expr): Check directly if a type
has no components, rather than the zero components attribute.
Treat elemental zero component expressions in the same way as
scalars.


gcc/testsuite/
PR fortran/113885
* gfortran.dg/finalize_54.f90: New test.
* gfortran.dg/finalize_55.f90: New test.

gcc/testsuite/
PR fortran/110987
* gfortran.dg/finalize_56.f90: New test.
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 76bed9830c4..079ac93aa8a 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -12511,11 +12511,14 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
   gfc_add_block_to_block (, );
   gfc_add_expr_to_block (, tmp);

-  /* Add the post blocks to the body.  */
-  if (!l_is_temp)
+  /* Add the post blocks to the body.  Scalar finalization must appear before
+ the post block in case any dellocations are done.  */
+  if (rse.finalblock.head
+  && (!l_is_temp || (expr2->expr_type == EXPR_FUNCTION
+			 && gfc_expr_attr (expr2).elemental)))
 {
-  gfc_add_block_to_block (, );
   gfc_add_block_to_block (, );
+  gfc_add_block_to_block (, );
 }
   else
 gfc_add_block_to_block (, );
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 7f50b16aee9..badad6ae892 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1624,7 +1624,7 @@ gfc_finalize_tree_expr (gfc_se *se, gfc_symbol *derived,
 }
   else if (derived && gfc_is_finalizable (derived, NULL))
 {
-  if (derived->attr.zero_comp && !rank)
+  if (!derived->components && (!rank || attr.elemental))
 	{
 	  /* Any attempt to assign zero length entities, causes the gimplifier
 	 all manner of problems. Instead, a variable is created to act as
@@ -1675,7 +1675,7 @@ gfc_finalize_tree_expr (gfc_se *se, gfc_symbol *derived,
 	  final_fndecl);
   if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
 {
-  if (is_class)
+  if (is_class || attr.elemental)
 	desc = gfc_conv_scalar_to_descriptor (se, desc, attr);
   else
 	{
@@ -1685,7 +1685,7 @@ gfc_finalize_tree_expr (gfc_se *se, gfc_symbol *derived,
 	}
 }

-  if (derived && derived->attr.zero_comp)
+  if (derived && !derived->components)
 {
   /* All the conditions below break down for zero length derived types.  */
   tmp = build_call_expr_loc (input_location, final_fndecl, 3,
diff --git a/gcc/testsuite/gfortran.dg/finalize_54.f90 b/gcc/testsuite/gfortran.dg/finalize_54.f90
new file mode 100644
index 000..73d32b1b333
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_54.f90
@@ -0,0 +1,47 @@
+! { dg-do compile }
+! Test the fix for PR113885, where not only was there a gimplifier ICE
+! for a derived type 't' with no components but, with a component, gfortran
+! gave wrong results.
+! Contributed by David Binderman  
+!
+module types
+  type t
+   contains
+ final :: finalize
+  end type t
+contains
+  pure subroutine finalize(x)
+type(t), intent(inout) :: x
+  end subroutine finalize
+end module types
+
+subroutine test1(x)
+  use types
+  interface
+ elemental function elem(x)
+  

Re: [PATCH] Fortran: no size check passing NULL() without MOLD argument [PR55978]

2024-03-24 Thread Paul Richard Thomas
Hi Harald,

This is completely fine - if you haven't committed, please do so.

Thanks

Paul


On Fri, 22 Mar 2024 at 17:32, Harald Anlauf  wrote:

> Dear all,
>
> here's a simple and obvious patch for a rejects-valid case when
> we pass a NULL() actual to an optional dummy for variants where
> there is no MOLD argument and it is also not required.
>
> The testcase is an extended version of PR55978 comment#16
> and cross-checked with Intel and NAG.
>
> Regtested on x86_64-pc-linux-gnu.
>
> I intend to commit soon unless there are objections.
>
> Thanks,
> Harald
>
>


Re: [PATCH v3 2/2] fortran: Fix specification expression error with dummy procedures [PR111781]

2024-03-19 Thread Paul Richard Thomas
Hi Mikael,

This is very good. I am pleased to see global variables disappear and I
like the new helper functions.

As before, OK for mainline and, if you wish, 13-branch.

Thanks

Paul


On Tue, 19 Mar 2024 at 15:49, Mikael Morin  wrote:

> This fixes a spurious invalid variable in specification expression error.
> The error was caused on the testcase from the PR by two different bugs.
> First, the call to is_parent_of_current_ns was unable to recognize
> correct host association and returned false.  Second, an ad-hoc
> condition coming next was using a global variable previously improperly
> restored to false (instead of restoring it to its initial value).  The
> latter happened on the testcase because one dummy argument was a procedure,
> and checking that argument what causing a check of all its arguments with
> the (improper) reset of the flag at the end, and that preceded the check of
> the next argument.
>
> For the first bug, the wrong result of is_parent_of_current_ns is fixed by
> correcting the namespaces that function deals with, both the one passed
> as argument and the current one tracked in the gfc_current_ns global.  Two
> new functions are introduced to select the right namespace.
>
> Regarding the second bug, the problematic condition is removed, together
> with the formal_arg_flag associated with it.  Indeed, that condition was
> (wrongly) allowing local variables to be used in array bounds of dummy
> arguments.
>
> PR fortran/111781
>
> gcc/fortran/ChangeLog:
>
> * symbol.cc (gfc_get_procedure_ns, gfc_get_spec_ns): New functions.
> * gfortran.h (gfc_get_procedure_ns, gfc_get_spec ns): Declare them.
> (gfc_is_formal_arg): Remove.
> * expr.cc (check_restricted): Remove special case allowing local
> variable in dummy argument bound expressions.  Use gfc_get_spec_ns
> to get the right namespace.
> * resolve.cc (gfc_is_formal_arg, formal_arg_flag): Remove.
> (gfc_resolve_formal_arglist): Set gfc_current_ns.  Quit loop and
> restore gfc_current_ns instead of early returning.
> (resolve_symbol): Factor common array spec resolution code to...
> (resolve_symbol_array_spec): ... this new function.  Additionnally
> set and restore gfc_current_ns.
>
> gcc/testsuite/ChangeLog:
>
> * gfortran.dg/spec_expr_8.f90: New test.
> * gfortran.dg/spec_expr_9.f90: New test.
> ---
>  gcc/fortran/expr.cc   |  8 +--
>  gcc/fortran/gfortran.h|  4 +-
>  gcc/fortran/resolve.cc| 77 +++
>  gcc/fortran/symbol.cc | 58 +
>  gcc/testsuite/gfortran.dg/spec_expr_8.f90 | 24 +++
>  gcc/testsuite/gfortran.dg/spec_expr_9.f90 | 19 ++
>  6 files changed, 140 insertions(+), 50 deletions(-)
>  create mode 100644 gcc/testsuite/gfortran.dg/spec_expr_8.f90
>  create mode 100644 gcc/testsuite/gfortran.dg/spec_expr_9.f90
>
> diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
> index e4b1e8307e3..9a042cd7040 100644
> --- a/gcc/fortran/expr.cc
> +++ b/gcc/fortran/expr.cc
> @@ -3514,19 +3514,13 @@ check_restricted (gfc_expr *e)
>if (!check_references (e->ref, _restricted))
> break;
>
> -  /* gfc_is_formal_arg broadcasts that a formal argument list is being
> -processed in resolve.cc(resolve_formal_arglist).  This is done so
> -that host associated dummy array indices are accepted (PR23446).
> -This mechanism also does the same for the specification
> expressions
> -of array-valued functions.  */
>if (e->error
> || sym->attr.in_common
> || sym->attr.use_assoc
> || sym->attr.dummy
> || sym->attr.implied_index
> || sym->attr.flavor == FL_PARAMETER
> -   || is_parent_of_current_ns (sym->ns)
> -   || (gfc_is_formal_arg () && (sym->ns == gfc_current_ns)))
> +   || is_parent_of_current_ns (gfc_get_spec_ns (sym)))
> {
>   t = true;
>   break;
> diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
> index c7039730fad..26aa56b3358 100644
> --- a/gcc/fortran/gfortran.h
> +++ b/gcc/fortran/gfortran.h
> @@ -3612,6 +3612,9 @@ bool gfc_is_associate_pointer (gfc_symbol*);
>  gfc_symbol * gfc_find_dt_in_generic (gfc_symbol *);
>  gfc_formal_arglist *gfc_sym_get_dummy_args (gfc_symbol *);
>
> +gfc_namespace * gfc_get_procedure_ns (gfc_symbol *);
> +gfc_namespace * gfc_get_spec_ns (gfc_symbol *);
> +
>  /* intrinsic.cc -- true if working in an init-expr, false otherwise.  */
>  extern bool gfc_init_expr_flag;
>
> @@ -3821,7 +3824,6 @@ bool gfc_resolve_iterator (gfc_iterator *, bool,
> bool);
>  bool find_forall_index (gfc_expr *, gfc_symbol *, int);
>  bool gfc_resolve_index (gfc_expr *, int);
>  bool gfc_resolve_dim_arg (gfc_expr *);
> -bool gfc_is_formal_arg (void);
>  bool gfc_resolve_substring (gfc_ref *, bool *);
>  void 

Re: [PATCH v3 0/2] fortran: Fix specification checks [PR111781]

2024-03-19 Thread Paul Richard Thomas
Hi Mikael,

Sorry, I am replying to these in the order that they appear in my intray :-)

OK for mainline and, if you wish, 13-branch.

Thanks

Paul


On Tue, 19 Mar 2024 at 15:49, Mikael Morin  wrote:

> Hello,
>
> these patches correct diagnostics dealing with variables in specification
> expressions.
> The first patch is a testsuite change, which fixes invalid specification
> expressions that the second patch would diagnose.
> The second patch removes a spurious diagnostic when a dummy procedure is
> involved, and enables more valid ones, as visible in the testcases from the
> first patch.
>
> I haven't tested it again (same code as v2), but I plan to do it before
> the final push.
> Ok for master?
>
> Mikael
>
> v2 -> v3 changes:
>
>   - Correct first name in testcase comment
>   - Clarify and correct log and changelog text from second patch
>   - Target current stage (stage4) instead of next (stage1)
>
> v1 -> v2 changes:
>
>   - Fix condition guarding sym->result access.
>
>
> Mikael Morin (2):
>   testsuite: Declare fortran array bound variables
>   fortran: Fix specification expression error with dummy procedures
> [PR111781]
>
>  gcc/fortran/expr.cc   |  8 +-
>  gcc/fortran/gfortran.h|  4 +-
>  gcc/fortran/resolve.cc| 77 +--
>  gcc/fortran/symbol.cc | 58 ++
>  .../gfortran.dg/graphite/pr107865.f90 |  2 +-
>  gcc/testsuite/gfortran.dg/pr101267.f90|  2 +-
>  gcc/testsuite/gfortran.dg/pr112404.f90|  2 +-
>  gcc/testsuite/gfortran.dg/pr78061.f   |  2 +-
>  gcc/testsuite/gfortran.dg/pr79315.f90 |  6 +-
>  gcc/testsuite/gfortran.dg/spec_expr_8.f90 | 24 ++
>  gcc/testsuite/gfortran.dg/spec_expr_9.f90 | 19 +
>  gcc/testsuite/gfortran.dg/vect/pr90681.f  |  2 +-
>  gcc/testsuite/gfortran.dg/vect/pr97761.f90|  2 +-
>  gcc/testsuite/gfortran.dg/vect/pr99746.f90|  2 +-
>  14 files changed, 152 insertions(+), 58 deletions(-)
>  create mode 100644 gcc/testsuite/gfortran.dg/spec_expr_8.f90
>  create mode 100644 gcc/testsuite/gfortran.dg/spec_expr_9.f90
>
> --
> 2.43.0
>
>


Re: [PATCH v3 1/2] testsuite: Declare fortran array bound variables

2024-03-19 Thread Paul Richard Thomas
Hi Mikael,

This looks completely "obvious" to me. OK for mainline and, I would
suggest, 13-branch.

Thanks

Paul



On Tue, 19 Mar 2024 at 15:49, Mikael Morin  wrote:

> This fixes invalid undeclared fortran array bound variables
> in the testsuite.
>
> gcc/testsuite/ChangeLog:
>
> * gfortran.dg/graphite/pr107865.f90: Declare array bound
> variable(s)
> as dummy argument(s).
> * gfortran.dg/pr101267.f90: Likewise.
> * gfortran.dg/pr112404.f90: Likewise.
> * gfortran.dg/pr78061.f: Likewise.
> * gfortran.dg/pr79315.f90: Likewise.
> * gfortran.dg/vect/pr90681.f: Likewise.
> * gfortran.dg/vect/pr97761.f90: Likewise.
> * gfortran.dg/vect/pr99746.f90: Likewise.
> ---
>  gcc/testsuite/gfortran.dg/graphite/pr107865.f90 | 2 +-
>  gcc/testsuite/gfortran.dg/pr101267.f90  | 2 +-
>  gcc/testsuite/gfortran.dg/pr112404.f90  | 2 +-
>  gcc/testsuite/gfortran.dg/pr78061.f | 2 +-
>  gcc/testsuite/gfortran.dg/pr79315.f90   | 6 +-
>  gcc/testsuite/gfortran.dg/vect/pr90681.f| 2 +-
>  gcc/testsuite/gfortran.dg/vect/pr97761.f90  | 2 +-
>  gcc/testsuite/gfortran.dg/vect/pr99746.f90  | 2 +-
>  8 files changed, 12 insertions(+), 8 deletions(-)
>
> diff --git a/gcc/testsuite/gfortran.dg/graphite/pr107865.f90
> b/gcc/testsuite/gfortran.dg/graphite/pr107865.f90
> index 6bddb17a1be..323d8092ad2 100644
> --- a/gcc/testsuite/gfortran.dg/graphite/pr107865.f90
> +++ b/gcc/testsuite/gfortran.dg/graphite/pr107865.f90
> @@ -1,7 +1,7 @@
>  ! { dg-do compile }
>  ! { dg-options "-O1 -floop-parallelize-all -ftree-parallelize-loops=2" }
>
> -  SUBROUTINE FNC (F)
> +  SUBROUTINE FNC (F,N)
>
>IMPLICIT REAL (A-H)
>DIMENSION F(N)
> diff --git a/gcc/testsuite/gfortran.dg/pr101267.f90
> b/gcc/testsuite/gfortran.dg/pr101267.f90
> index 12723cf9c22..99a6dcfa342 100644
> --- a/gcc/testsuite/gfortran.dg/pr101267.f90
> +++ b/gcc/testsuite/gfortran.dg/pr101267.f90
> @@ -1,7 +1,7 @@
>  ! { dg-do compile }
>  ! { dg-options "-Ofast" }
>  ! { dg-additional-options "-march=znver2" { target x86_64-*-* i?86-*-* } }
> -   SUBROUTINE sfddagd( regime, znt,ite ,jte )
> +   SUBROUTINE sfddagd( regime, znt,ite ,jte, ime, IN )
> REAL, DIMENSION( ime, IN) :: regime, znt
> REAL, DIMENSION( ite, jte) :: wndcor_u
> LOGICAL wrf_dm_on_monitor
> diff --git a/gcc/testsuite/gfortran.dg/pr112404.f90
> b/gcc/testsuite/gfortran.dg/pr112404.f90
> index 573fa28164a..4508bbc8738 100644
> --- a/gcc/testsuite/gfortran.dg/pr112404.f90
> +++ b/gcc/testsuite/gfortran.dg/pr112404.f90
> @@ -1,7 +1,7 @@
>  ! { dg-do compile }
>  ! { dg-options "-Ofast" }
>  ! { dg-additional-options "-mavx2" { target avx2 } }
> -   SUBROUTINE sfddagd( regime, znt, ite, jte )
> +   SUBROUTINE sfddagd( regime, znt, ite, jte, ime, IN )
> REAL, DIMENSION( ime, IN) :: regime, znt
> REAL, DIMENSION( ite, jte) :: wndcor_u
> LOGICAL wrf_dm_on_monitor
> diff --git a/gcc/testsuite/gfortran.dg/pr78061.f
> b/gcc/testsuite/gfortran.dg/pr78061.f
> index 7e4dd3de8b5..9061dea74da 100644
> --- a/gcc/testsuite/gfortran.dg/pr78061.f
> +++ b/gcc/testsuite/gfortran.dg/pr78061.f
> @@ -1,6 +1,6 @@
>  ! { dg-do compile }
>  ! { dg-options "-O3 -fsplit-loops" }
> -  SUBROUTINE SSYMM(C)
> +  SUBROUTINE SSYMM(C,LDC)
>REAL C(LDC,*)
>LOGICAL LSAME
>LOGICAL UPPER
> diff --git a/gcc/testsuite/gfortran.dg/pr79315.f90
> b/gcc/testsuite/gfortran.dg/pr79315.f90
> index 8cd89691ce9..b754a2b3274 100644
> --- a/gcc/testsuite/gfortran.dg/pr79315.f90
> +++ b/gcc/testsuite/gfortran.dg/pr79315.f90
> @@ -10,7 +10,11 @@ SUBROUTINE wsm32D(t, &
>   its,&
> ite, &
> kts, &
> -   kte  &
> +   kte, &
> +   ims, &
> +   ime, &
> +   kms, &
> +   kme  &
>)
>REAL, DIMENSION( its:ite , kts:kte ),   &
>  INTENT(INOUT) ::  &
> diff --git a/gcc/testsuite/gfortran.dg/vect/pr90681.f
> b/gcc/testsuite/gfortran.dg/vect/pr90681.f
> index 03d3987b146..49f1d50ab8f 100644
> --- a/gcc/testsuite/gfortran.dg/vect/pr90681.f
> +++ b/gcc/testsuite/gfortran.dg/vect/pr90681.f
> @@ -1,6 +1,6 @@
>  C { dg-do compile }
>  C { dg-additional-options "-march=armv8.2-a+sve" { target { aarch64*-*-*
> } } }
> -  SUBROUTINE HMU (H1)
> +  SUBROUTINE HMU (H1,NORBS)
>COMMON DD(107)
>DIMENSION H1(NORBS,*)
>  DO 70 J1 = IA,I1
> diff --git a/gcc/testsuite/gfortran.dg/vect/pr97761.f90
> b/gcc/testsuite/gfortran.dg/vect/pr97761.f90
> index 250e2bf016e..401ef06e422 100644
> --- a/gcc/testsuite/gfortran.dg/vect/pr97761.f90
> +++ b/gcc/testsuite/gfortran.dg/vect/pr97761.f90
> @@ -1,7 +1,7 @@
>  ! { dg-do compile }
>  ! { dg-additional-options "-O1" }
>
> -subroutine ni (ps)
> +subroutine ni (ps, inout)
>  type vector
> real  x, y
>  end type
> diff --git a/gcc/testsuite/gfortran.dg/vect/pr99746.f90
> 

Re: [PATCH] Fortran: fix IS_CONTIGUOUS for polymorphic dummy arguments [PR114001]

2024-03-13 Thread Paul Richard Thomas
Hi Harald,

This looks good to me. The testcase gives the same result with other brands.

OK for mainline and for backporting.

Thanks

Paul


On Tue, 12 Mar 2024 at 22:12, Harald Anlauf  wrote:

> Dear all,
>
> here's another small fix: IS_CONTIGUOUS did erroneously always
> return .true. for CLASS dummy arguments.  The solution was to
> adjust the logic in gfc_is_simply_contiguous to also handle
> CLASS symbols.
>
> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
>
> Thanks,
> Harald
>
>


Re: [Patch, fortran PR89645/99065 No IMPLICIT type error with: ASSOCIATE( X => function() )

2024-03-12 Thread Paul Richard Thomas
Hi Harald,

Roger that about the comments. The major part of my recent efforts has been
to maximise comments - apparently not always successfully!

The main reason that I want to "fix everything" is that this is it; I will
not work on this approach anymore. The gfortran/g95 founder's approach was
very clever but has found it's limit with the associate construct. The sad
thing is that this is the only blocker that I know of.

Thanks

Paul


On Tue, 12 Mar 2024 at 21:07, Harald Anlauf  wrote:

> Hi Paul,
>
> On 3/12/24 15:54, Paul Richard Thomas wrote:
> > Hi All,
> >
> > This is the last posting of this patch before I push it. Harald is OK
> with
> > it on the grounds that the inferred_type flag guards the whole lot,
> > except for the chunks in trans-stmt.cc.
> >
> > In spite of Harald's off-list admonition not to try to fix everything at
> > once, this version fixes most of the inquiry reference bugs
> > (associate_68.f90) with the exception of character(kind=4) function
> > selectors. The reason for this is that I have some housekeeping to do
> > before release on finalization and then I want to replace this patch in
> > 15-branch with two pass parsing. My first attempts at the latter were a
> > partial success.
>
> you wouldn't stop trying to fix everything, would you?  ;-)
>
> > It regtests OK on x86_64. Unless there are objections, I will commit on
> > Thursday evening.
>
> No objections, just one wish: could you improve the text of the
> following comments so that mere mortals understand them?
>
> diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
> index 12e7bf3c873..0ab69bb9dce 100644
> --- a/gcc/fortran/primary.cc
> +++ b/gcc/fortran/primary.cc
> [...]
> +  /* If there is a usable inquiry reference not there are no matching
> +derived types, force the inquiry reference by setting unknown the
> +type of the primary expression.  */
>
>
> I have a hard time parsing the first part of that sentence.
>
> diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
> index 5d9852c79e0..16adb2a7efb 100644
> --- a/gcc/fortran/symbol.cc
> +++ b/gcc/fortran/symbol.cc
> [...]
> +/* Find all derived types in the uppermost namespace that have a component
> +   a component called name and stash them in the assoc field of an
> +   associate name variable.
>
>
> "a component" too much?
>
> Thanks,
> Harald
>
> > Cheers
> >
> > Paul
>
>


Re: [Patch, fortran PR89645/99065 No IMPLICIT type error with: ASSOCIATE( X => function() )

2024-03-12 Thread Paul Richard Thomas
Hi All,

This is the last posting of this patch before I push it. Harald is OK with
it on the grounds that the inferred_type flag guards the whole lot,
except for the chunks in trans-stmt.cc.

In spite of Harald's off-list admonition not to try to fix everything at
once, this version fixes most of the inquiry reference bugs
(associate_68.f90) with the exception of character(kind=4) function
selectors. The reason for this is that I have some housekeeping to do
before release on finalization and then I want to replace this patch in
15-branch with two pass parsing. My first attempts at the latter were a
partial success.

It regtests OK on x86_64. Unless there are objections, I will commit on
Thursday evening.

Cheers

Paul

Fortran: Fix class/derived/complex function associate selectors [PR87477]

2024-03-12  Paul Thomas  

gcc/fortran
PR fortran/87477
PR fortran/89645
PR fortran/99065
PR fortran/114141
PR fortran/114280
* class.cc (gfc_change_class): New function needed for
associate names, when rank changes or a derived type is
produced by resolution
* dump-parse-tree.cc (show_code_node): Make output for SELECT
TYPE more comprehensible.
* expr.cc (find_inquiry_ref): Do not simplify expressions of
an inferred type.
* gfortran.h : Add 'gfc_association_list' to structure
'gfc_association_list'. Add prototypes for
'gfc_find_derived_types', 'gfc_fixup_inferred_type_refs' and
'gfc_change_class'. Add macro IS_INFERRED_TYPE.
* match.cc (copy_ts_from_selector_to_associate): Add bolean arg
'select_type' with default false. If this is a select type name
and the selector is a inferred type, build the class type and
apply it to the associate name.
(build_associate_name): Pass true to 'select_type' in call to
previous.
* parse.cc (parse_associate): If the selector is inferred type
the associate name is too. Make sure that function selector
class and rank, if known, are passed to the associate name. If
a function result exists, pass its typespec to the associate
name.
* primary.cc (resolvable_fcns): New function to check that all
the function references are resolvable.
(gfc_match_varspec): If a scalar derived type select type
temporary has an array reference, match the array reference,
treating this in the same way as an equivalence member. Do not
set 'inquiry' if applied to an unknown type the inquiry name
is ambiguous with the component of an accessible derived type.
Check that resolution of the target expression is OK by testing
if the symbol is declared or is an operator expression, then
using 'resolvable_fcns' recursively. If all is well, resolve
the expression. If this is an inferred type with a component
reference, call 'gfc_find_derived_types' to find a suitable
derived type. If there is an inquiry ref and the symbol either
is of unknown type or is inferred to be a derived type, set the
primary and symbol TKR appropriately.
* resolve.cc (resolve_variable): Call new function below.
(gfc_fixup_inferred_type_refs): New function to ensure that the
expression references for a inferred type are consistent with
the now fixed up selector.
(resolve_assoc_var): Ensure that derived type or class function
selectors transmit the correct arrayspec to the associate name.
(resolve_select_type): If the selector is an associate name of
inferred type and has no component references, the associate
name should have its typespec. Simplify the conversion of a
class array to class scalar by calling 'gfc_change_class'.
Make sure that a class, inferred type selector with an array
ref transfers the typespec from the symbol to the expression.
* symbol.cc (gfc_set_default_type): If an associate name with
unknown type has a selector expression, try resolving the expr.
(find_derived_types, gfc_find_derived_types): New functions
that search for a derived type with a given name.
* trans-expr.cc (gfc_conv_variable): Some inferred type exprs
escape resolution so call 'gfc_fixup_inferred_type_refs'.
* trans-stmt.cc (trans_associate_var): Tidy up expression for
'class_target'. Finalize and free class function results.
Correctly handle selectors that are class functions and class
array references, passed as derived types.

gcc/testsuite/
PR fortran/87477
PR fortran/89645
PR fortran/99065
* gfortran.dg/associate_64.f90 : New test
* gfortran.dg/associate_66.f90 : New test
* gfortran.dg/associate_67.f90 : New test

PR fortran/114141
* gfortran.dg/associate_65.f90 : New test

PR fortran/114280
* gfortran.dg/associate_68.f90 : New test
diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc
index ce31a93abcd..abe89630be3 100644
--- a/gcc/fortran/class.cc
+++ b/gcc/fortran/class.cc
@@ -815,6 +815,56 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
 }
 
 
+/* Change class, using gfc_build_class_symbol. This is needed for associate
+   names, when rank changes or a derived type is produced by resolution.  */
+
+void
+gfc_change_class (gfc_typespec *ts, symbol_attribute *sym_attr,
+		  gfc_array_spec *sym_as, int rank, int corank)
+{
+  

Re: [PATCH] Fortran: handle procedure pointer component in DT array [PR110826]

2024-03-12 Thread Paul Richard Thomas
Hi Harald,

This looks good to me. OK for mainline and, since it is so straightforward,
for backporting.

Thanks for the patch.

Paul


On Mon, 11 Mar 2024 at 21:20, Harald Anlauf  wrote:

> Dear all,
>
> the attached patch fixes an ICE-on-valid code when assigning
> a procedure pointer that is a component of a DT array and
> the function in question is array-valued.  (The procedure
> pointer itself cannot be an array.)
>
> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
>
> Thanks,
> Harald
>
>


Re: [PATCH] Fortran: error recovery while simplifying expressions [PR103707, PR106987]

2024-03-06 Thread Paul Richard Thomas
Hi Harald,

This all looks good to me. OK for mainline and, according to intestinal
fortitude on your part, earlier branches.

Thanks

Paul


On Tue, 5 Mar 2024 at 21:24, Harald Anlauf  wrote:

> Dear all,
>
> error recovery on arithmetic errors during simplification has bugged
> me for a long time, especially since the occurence of ICEs depended
> on whether -frange-check is specified or not, whether array ctors
> were involved, etc.
>
> I've now come up with the attached patch that classifies the arithmetic
> result codes into "hard" and "soft" errors.
>
> A "soft" error means that it is an overflow or other exception (e.g. NaN)
> that is ignored with -fno-range-check.  After the patch, a soft error
> will not stop simplification (a hard one will), and error status will be
> passed along.
>
> I took this opportunity to change the emitted error for division by zero
> for real and complex division dependent on whether the numerator is
> regular or not.  This makes e.g. (0.)/0 a NaN and now says so, in
> accordance with some other brands.
>
> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
>
> Other comments?
>
> Thanks,
> Harald
>
>


Re: [Patch, fortran PR89645/99065 No IMPLICIT type error with: ASSOCIATE( X => function() )

2024-03-03 Thread Paul Richard Thomas
Hi Harald,

Please find an updated version of the patch that rolls in Steve's patch for
PR114141, fixes unlimited polymorphic function selectors and cures the
memory leaks. I apologise for not working on this sooner but, as I informed
you, I have been away for an extended trip to Australia.

The chunks that fix PR114141 are picked out in comment 14 to the PR and the
cures to the problems that you found in the first review are found at
trans-stmt.cc:2047-49.

Regtests fine. OK for trunk, bearing in mind that most of the patch is ring
fenced by the inferred_type flag?

Cheers

Paul


On Mon, 8 Jan 2024 at 21:53, Harald Anlauf  wrote:

> Hi Paul,
>
> your patch looks already very impressive!
>
> Regarding the patch as is, I am still trying to grok it, even with your
> explanations at hand...
>
> While the testcase works as advertised, I noticed that it exhibits a
> runtime memleak that occurs for (likely) each case where the associate
> target is an allocatable, class-valued function result.
>
> I tried to produce a minimal testcase using class(*), which apparently
> is not handled by your patch (it ICEs for me):
>
> program p
>implicit none
>class(*), allocatable :: x(:)
>x = foo()
>call prt (x)
>deallocate (x)
>! up to here no memleak...
>associate (var => foo())
>  call prt (var)
>end associate
> contains
>function foo() result(res)
>  class(*), allocatable :: res(:)
>  res = [42]
>end function foo
>subroutine prt (x)
>  class(*), intent(in) :: x(:)
>  select type (x)
>  type is (integer)
> print *, x
>  class default
> stop 99
>  end select
>end subroutine prt
> end
>
> Traceback (truncated):
>
> foo.f90:9:18:
>
>  9 | call prt (var)
>|  1
> internal compiler error: tree check: expected record_type or union_type
> or qual_union_type, have function_type in gfc_class_len_get, at
> fortran/trans-expr.cc:271
> 0x19fd5d5 tree_check_failed(tree_node const*, char const*, int, char
> const*, ...)
>  ../../gcc-trunk/gcc/tree.cc:8952
> 0xe1562d tree_check3(tree_node*, char const*, int, char const*,
> tree_code, tree_code, tree_code)
>  ../../gcc-trunk/gcc/tree.h:3652
> 0xe3e264 gfc_class_len_get(tree_node*)
>  ../../gcc-trunk/gcc/fortran/trans-expr.cc:271
> 0xecda48 trans_associate_var
>  ../../gcc-trunk/gcc/fortran/trans-stmt.cc:2325
> 0xecdd09 gfc_trans_block_construct(gfc_code*)
>  ../../gcc-trunk/gcc/fortran/trans-stmt.cc:2383
> [...]
>
> I don't see anything wrong with it: NAG groks it, like Nvidia and Flang,
> while Intel crashes at runtime.
>
> Can you have another brief look?
>
> Thanks,
> Harald
>
>
> On 1/6/24 18:26, Paul Richard Thomas wrote:
> > These PRs come about because of gfortran's single pass parsing. If the
> > function in the title is parsed after the associate construct, then its
> > type and rank are not known. The point at which this becomes a problem is
> > when expressions within the associate block are parsed. primary.cc
> > (gfc_match_varspec) could already deal with intrinsic types and so
> > component references were the trigger for the problem.
> >
> > The two major parts of this patch are the fixup needed in
> gfc_match_varspec
> > and the resolution of  expressions with references in resolve.cc
> > (gfc_fixup_inferred_type_refs). The former relies on the two new
> functions
> > in symbol.cc to search for derived types with an appropriate component to
> > match the component reference and then set the associate name to have a
> > matching derived type. gfc_fixup_inferred_type_refs is called in
> resolution
> > and so the type of the selector function is known.
> > gfc_fixup_inferred_type_refs ensures that the component references use
> this
> > derived type and that array references occur in the right place in
> > expressions and match preceding array specs. Most of the work in
> preparing
> > the patch was sorting out cases where the selector was not a derived type
> > but, instead, a class function. If it were not for this, the patch would
> > have been submitted six months ago :-(
> >
> > The patch is relatively safe because most of the chunks are guarded by
> > testing for the associate name being an inferred type, which is set in
> > gfc_match_varspec. For this reason, I do not think it likely that the
> patch
> > will cause regressions. However, it is more than possible that variants
> not
> > appearing in the submitted testcase will throw up new bugs.
> >
> > Jerry has already given the patch a whirl an

[Patch, fortran PR89645/99065 No IMPLICIT type error with: ASSOCIATE( X => function() )

2024-01-06 Thread Paul Richard Thomas
These PRs come about because of gfortran's single pass parsing. If the
function in the title is parsed after the associate construct, then its
type and rank are not known. The point at which this becomes a problem is
when expressions within the associate block are parsed. primary.cc
(gfc_match_varspec) could already deal with intrinsic types and so
component references were the trigger for the problem.

The two major parts of this patch are the fixup needed in gfc_match_varspec
and the resolution of  expressions with references in resolve.cc
(gfc_fixup_inferred_type_refs). The former relies on the two new functions
in symbol.cc to search for derived types with an appropriate component to
match the component reference and then set the associate name to have a
matching derived type. gfc_fixup_inferred_type_refs is called in resolution
and so the type of the selector function is known.
gfc_fixup_inferred_type_refs ensures that the component references use this
derived type and that array references occur in the right place in
expressions and match preceding array specs. Most of the work in preparing
the patch was sorting out cases where the selector was not a derived type
but, instead, a class function. If it were not for this, the patch would
have been submitted six months ago :-(

The patch is relatively safe because most of the chunks are guarded by
testing for the associate name being an inferred type, which is set in
gfc_match_varspec. For this reason, I do not think it likely that the patch
will cause regressions. However, it is more than possible that variants not
appearing in the submitted testcase will throw up new bugs.

Jerry has already given the patch a whirl and found that it applies
cleanly, regtests OK and works as advertised.

OK for trunk?

Paul

Fortran: Fix class/derived type function associate selectors [PR87477]

2024-01-06  Paul Thomas  

gcc/fortran
PR fortran/87477
PR fortran/89645
PR fortran/99065
* class.cc (gfc_change_class): New function needed for
associate names, when rank changes or a derived type is
produced by resolution
* dump-parse-tree.cc (show_code_node): Make output for SELECT
TYPE more comprehensible.
* gfortran.h : Add 'gfc_association_list' to structure
'gfc_association_list'. Add prototypes for
'gfc_find_derived_types', 'gfc_fixup_inferred_type_refs' and
'gfc_change_class'. Add macro IS_INFERRED_TYPE.
* match.cc (copy_ts_from_selector_to_associate): Add bolean arg
'select_type' with default false. If this is a select type name
and the selector is a inferred type, build the class type and
apply it to the associate name.
(build_associate_name): Pass true to 'select_type' in call to
previous.
* parse.cc (parse_associate): If the selector is a inferred type
the associate name is too. Make sure that function selector
class and rank, if known, are passed to the associate name. If
a function result exists, pass its typespec to the associate
name.
* primary.cc (gfc_match_varspec): If a scalar derived type
select type temporary has an array reference, match the array
reference, treating this in the same way as an equivalence
member. If this is a inferred type with a component reference,
call 'gfc_find_derived_types' to find a suitable derived type.
* resolve.cc (resolve_variable): Call new function below.
(gfc_fixup_inferred_type_refs): New function to ensure that the
expression references for a inferred type are consistent with
the now fixed up selector.
(resolve_assoc_var): Ensure that derived type or class function
selectors transmit the correct arrayspec to the associate name.
(resolve_select_type): If the selector is an associate name of
inferred type and has no component references, the associate
name should have its typespec.
* symbol.cc (gfc_set_default_type): If an associate name with
unknown type has a selector expression, try resolving the expr.
(find_derived_types, gfc_find_derived_types): New functions
that search for a derived type with a given name.
* trans-expr.cc (gfc_conv_variable): Some inferred type exprs
escape resolution so call 'gfc_fixup_inferred_type_refs'.
* trans-stmt.cc (trans_associate_var): Tidy up expression for
'class_target'. Correctly handle selectors that are class array
references, passed as derived types.

gcc/testsuite/
PR fortran/87477
PR fortran/89645
PR fortran/99065
* gfortran.dg/associate_64.f90 : New test
diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc
index 5c43b77dba3..7db1ecbd264 100644
--- a/gcc/fortran/class.cc
+++ b/gcc/fortran/class.cc
@@ -815,6 +815,56 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
 }
 
 
+/* Change class, using gfc_build_class_symbol. This is needed for associate
+   names, when rank changes or a derived type is produced by resolution.  */
+
+void
+gfc_change_class (gfc_typespec *ts, symbol_attribute *sym_attr,
+		  gfc_array_spec *sym_as, int rank, int corank)
+{
+  symbol_attribute attr;
+  gfc_component *c;
+  gfc_array_spec *as = NULL;
+  gfc_symbol *der = ts->u.derived;

Re: [PATCH] Fortran: fix argument passing to CONTIGUOUS, TARGET dummy [PR97592]

2023-12-17 Thread Paul Richard Thomas
Hi Harald,

It might be a simple patch but I have to confess it took a while for me to
get my head around the difference between gfc_is_not_contiguous and
!gfc_is_simply_contigous :-(

Yes, this is OK for mainline and, after a short delay, for 13-branch.

Thanks for the patch

Paul


On Sat, 16 Dec 2023 at 18:28, Harald Anlauf  wrote:

> Dear all,
>
> the attached simple patch fixes a (9+) regression for passing
> to a CONTIGUOUS,TARGET dummy an *effective argument* that is
> contiguous, although the actual argument is not simply-contiguous
> (it is a pointer without the CONTIGOUS attribute in the PR).
>
> Since a previous attempt for a patch lead to regressions in
> gfortran.dg/bind-c-contiguous-3.f90, which is rather dense,
> I decided to enhance the current testcase with various
> combinations of actual and dummy arguments that allow to
> study whether a _gfortran_internal_pack is generated in
> places where we want to.  (_gfortran_internal_pack does not
> create a temporary when no packing is needed).
>
> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
>
> I would like to backport this - after a grace period - to
> at least 13-branch.  Any objections here?
>
> Thanks,
> Harald
>
>


{Patch, fortran] PR112834 - Class array function selector causes chain of syntax and other spurious errors

2023-12-06 Thread Paul Richard Thomas
Dear All,

This patch was rescued from my ill-fated and long winded attempt to provide
a fix-up for function selector references, where the function is parsed
after the procedure containing the associate/select type construct (PRs
89645 and 99065). The fix-ups broke down completely once these constructs
were enclosed by another associate construct, where the selector is a
derived type or class function. My inclination now is to introduce two pass
parsing for contained procedures.

Returning to PR112834, the patch is simple enough and is well described by
the change logs. PR111853 was fixed as a side effect of the bigger patch.
Steve Kargl had also posted the same fix on the PR.

Regression tests - OK for trunk and 13-branch?

Paul


Change.Logs
Description: Binary data
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 9e3571d3dbe..cecd2940dcf 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -6436,9 +6436,9 @@ build_associate_name (const char *name, gfc_expr **e1, gfc_expr **e2)

   sym = expr1->symtree->n.sym;
   if (expr2->ts.type == BT_UNKNOWN)
-  sym->attr.untyped = 1;
+sym->attr.untyped = 1;
   else
-  copy_ts_from_selector_to_associate (expr1, expr2);
+copy_ts_from_selector_to_associate (expr1, expr2);

   sym->attr.flavor = FL_VARIABLE;
   sym->attr.referenced = 1;
@@ -6527,6 +6527,7 @@ select_type_set_tmp (gfc_typespec *ts)
   gfc_symtree *tmp = NULL;
   gfc_symbol *selector = select_type_stack->selector;
   gfc_symbol *sym;
+  gfc_expr *expr2;

   if (!ts)
 {
@@ -6550,7 +6551,19 @@ select_type_set_tmp (gfc_typespec *ts)
   sym = tmp->n.sym;
   gfc_add_type (sym, ts, NULL);

-  if (selector->ts.type == BT_CLASS && selector->attr.class_ok
+  /* If the SELECT TYPE selector is a function we might be able to obtain
+	 a typespec from the result. Since the function might not have been
+	 parsed yet we have to check that there is indeed a result symbol.  */
+  if (selector->ts.type == BT_UNKNOWN
+	  && gfc_state_stack->construct
+	  && (expr2 = gfc_state_stack->construct->expr2)
+	  && expr2->expr_type == EXPR_FUNCTION
+	  && expr2->symtree
+	  && expr2->symtree->n.sym && expr2->symtree->n.sym->result)
+	selector->ts = expr2->symtree->n.sym->result->ts;
+
+  if (selector->ts.type == BT_CLASS
+  && selector->attr.class_ok
 	  && selector->ts.u.derived && CLASS_DATA (selector))
 	{
 	  sym->attr.pointer
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index abd3a424f38..c1fa751d0e8 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -5131,7 +5131,7 @@ parse_associate (void)
   gfc_current_ns = my_ns;
   for (a = new_st.ext.block.assoc; a; a = a->next)
 {
-  gfc_symbol* sym;
+  gfc_symbol *sym, *tsym;
   gfc_expr *target;
   int rank;

@@ -5195,6 +5195,16 @@ parse_associate (void)
 	  sym->ts.type = BT_DERIVED;
 	  sym->ts.u.derived = derived;
 	}
+	  else if (target->symtree && (tsym = target->symtree->n.sym))
+	{
+	  sym->ts = tsym->result ? tsym->result->ts : tsym->ts;
+	  if (sym->ts.type == BT_CLASS)
+		{
+		  if (CLASS_DATA (sym)->as)
+		target->rank = CLASS_DATA (sym)->as->rank;
+		  sym->attr.class_ok = 1;
+		}
+	}
 	}

   rank = target->rank;
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 166b702cd9a..92678b816a1 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -5669,7 +5669,7 @@ gfc_expression_rank (gfc_expr *e)
   if (ref->type != REF_ARRAY)
 	continue;

-  if (ref->u.ar.type == AR_FULL)
+  if (ref->u.ar.type == AR_FULL && ref->u.ar.as)
 	{
 	  rank = ref->u.ar.as->rank;
 	  break;
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 50b71e67234..b70c079fc55 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -1746,6 +1746,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
   e = sym->assoc->target;

   class_target = (e->expr_type == EXPR_VARIABLE)
+		&& e->ts.type == BT_CLASS
 		&& (gfc_is_class_scalar_expr (e)
 			|| gfc_is_class_array_ref (e, NULL));

@@ -2037,7 +2038,12 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)

   /* Class associate-names come this way because they are
 	 unconditionally associate pointers and the symbol is scalar.  */
-  if (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.dimension)
+  if (sym->ts.type == BT_CLASS && e->expr_type ==EXPR_FUNCTION)
+	{
+	  gfc_conv_expr (, e);
+	  se.expr = gfc_evaluate_now (se.expr, );
+	}
+  else if (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.dimension)
 	{
 	  tree target_expr;
 	  /* For a class array we need a descriptor for the selector.  */
! { dg-do run }
!
! Test the fix for PR112834 in which class array function selectors caused
! problems for both ASSOCIATE and SELECT_TYPE.
!
! Contributed by Paul Thomas  
!
module m
  implicit none
  type t
integer :: i = 0
  end type t
  integer :: i = 0
  type(t), parameter 

Re: [PATCH] Fortran: allow RESTRICT qualifier also for optional arguments [PR100988]

2023-12-04 Thread Paul Richard Thomas
Hi Harald,

The patch is OK for mainline.

Thanks

Paul


On Mon, 4 Dec 2023 at 22:47, Harald Anlauf  wrote:

> Dear all,
>
> the attached patch picks up an observation by Tobias that we did
> not specify the RESTRICT qualifier for optional arguments even
> if that was allowed.  In principle this might have prevented
> better optimization.
>
> While looking more closely, I found and fixed an issue with CLASS
> dummy arguments that mishandled this.  This revealed a few cases
> in the testsuite that were matching the wrong patterns...
>
> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
>
> Thanks,
> Harald
>
>


Re: [PATCH] Fortran: fix TARGET attribute of associating entity in ASSOCIATE [PR112764]

2023-11-30 Thread Paul Richard Thomas
Hi Harald,

The original testcase is accepted by the two other brands to which I have
access.

OK for mainline and, I would suggest, 13-branch.

Thanks

Paul


On Wed, 29 Nov 2023 at 21:16, Harald Anlauf  wrote:

> Dear all,
>
> the attached simple patch fixes the handling of the TARGET
> attribute of an associate variable in an ASSOCIATE construct.
>
> See e.g. F2018:11.1.3.3 for a standard reference.
>
> (Note that the patch does not touch the pointer or allocatable
> attributes, as that would lead to several testsuite regressions
> and thus needs more work.)
>
> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
>
> Thanks,
> Harald
>
>


Re: [PATCH v2] Fortran: fix reallocation on assignment of polymorphic variables [PR110415]

2023-11-29 Thread Paul Richard Thomas
Hi Andrew,

This is OK by me.

I attach a slightly edited version of the patch itself in the hope that it
will make the code a bit clearer.

Thanks and welcome!

Paul


On Mon, 27 Nov 2023 at 17:35, Andrew Jenner  wrote:

> This is the second version of the patch - previous discussion at:
> https://gcc.gnu.org/pipermail/gcc-patches/2023-November/636671.html
>
> This patch adds the testcase from PR110415 and fixes the bug.
>
> The problem is that in a couple of places in trans_class_assignment in
> trans-expr.cc, we need to get the run-time size of the polymorphic
> object from the vtbl, but we are currently getting that vtbl from the
> lhs of the assignment rather than the rhs. This gives us the old value
> of the size but we need to pass the new size to __builtin_malloc and
> __builtin_realloc.
>
> I'm fixing this by adding a parameter to trans_class_vptr_len_assignment
> to retrieve the tree corresponding the vptr from the object on the rhs
> of the assignment, and then passing this where it is needed. In the case
> where trans_class_vptr_len_assignment returns NULL_TREE for the rhs vptr
> we use the lhs vptr as before.
>
> To get this to work I also needed to change the implementation of
> trans_class_vptr_len_assignment to create a temporary for the assignment
> in more circumstances. Currently, the "a = func()" assignment in MAIN__
> doesn't hit the "Create a temporary for complication expressions" case
> on line 9951 because "DECL_P (rse->expr)" is true - the expression has
> already been placed into a temporary. That means we don't hit the "if
> (temp_rhs ..." case on line 10038 and go on to get the vptr_expr from
> "gfc_lval_expr_from_sym (gfc_find_vtab (>ts))" on line 10057 which
> is the vtbl of the static type rather than the dynamic one from the rhs.
> So with this fix we create an extra temporary, but that should be
> optimised away in the middle-end so there should be no run-time effect.
>
> I'm not sure if this is the best way to fix this (the Fortran front-end
> is new territory for me) but I've verified that the testcase passes with
> this change, fails without it, and that the change does not introduce
> any FAILs when running the gfortran testcases on x86_64-pc-linux-gnu.
>
> After the previous submission, Tobias Burnus found a closely related
> problem and contributed testcases and a fix for it, which I have
> incorporated into this version of the patch. The problem in this case is
> with the __builtin_realloc call that is executed if one polymorphic
> variable is replaced by another. The return value of this call was being
> ignored rather than used to replace the pointer being reallocated.
>
> Is this OK for mainline, GCC 13 and OG13?
>
> Thanks,
>
> Andrew
>
> 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.
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 1b8be081a17..35b000bf8d5 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -9892,7 +9892,9 @@ 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 = NULL,
+ tree * from_lenp = NULL,
+ tree * from_vptrp = NULL)
 {
   gfc_se se;
   gfc_expr * vptr_expr;
@@ -9900,12 +9902,15 @@ 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))
+  if (re->expr_type != EXPR_VARIABLE
+  && re->expr_type != EXPR_NULL
+  && rse->expr != NULL_TREE)
 {
-  if (re->ts.type == BT_CLASS && !GFC_CLASS_TYPE_P (TREE_TYPE (rse->expr)))
+  if (re->ts.type == BT_CLASS
+  && !GFC_CLASS_TYPE_P (TREE_TYPE (rse->expr)))
 	class_expr = gfc_get_class_from_expr (rse->expr);
 
   if (rse->loop)
@@ -9959,8 +9964,8 @@ trans_class_vptr_len_assignment (stmtblock_t *block, gfc_expr * le,
   /* Get the vptr from the rhs expression only, when it is 

[Patch, fortran] PR112459 - gfortran -w option causes derived-type finalization at creation time

2023-11-11 Thread Paul Richard Thomas
Hi All,

Evidently -w causes gfc_option.allow_std to be set to default, which allows
anything and everything to happen, including these f2003/8 finalizations.
The fix is trivial.

Regtests fine - OK for mainline and -13 branch?

Paul

Fortran: Prevent unwanted finalization with -w option [PR112459]

2023-11-11  Paul Thomas  

gcc/fortran
PR fortran/112459
* trans-array.cc (gfc_trans_array_constructor_value): Replace
gfc_notification_std with explicit logical expression that
selects F2003/2008 and excludes -std=default/gnu.
*trans-array.cc (gfc_conv_expr): Ditto.

gcc/testsuite/
PR fortran/112459
* gfortran.dg/pr112459.f90: New test.
! { dg-do compile }
! { dg-options "-w -fdump-tree-original" }
!
! Correct unexpected finalization with -std=default/gnu and -w
!
! Contributed by Sebastian Bardeau  
!
module mymod
  type mysubtype
integer(kind=4), allocatable :: a(:)
  end type mysubtype
  type :: mytype
integer :: i
type(mysubtype) :: sub
  contains
final :: mytype_final
  end type mytype
contains
  subroutine mysubtype_final(sub)
type(mysubtype), intent(inout) :: sub
print *,'MYSUBTYPE>FINAL'
if (allocated(sub%a)) deallocate(sub%a)
  end subroutine mysubtype_final
  subroutine mytype_final(typ)
type(mytype), intent(inout) :: typ
print *,"MYTYPE>FINAL"
call mysubtype_final(typ%sub)
  end subroutine mytype_final
end module mymod
!
program myprog
  use mymod
  type(mytype), pointer :: c
  print *,"Before allocation"
  allocate(c)
  print *,"After allocation"
end program myprog
! Final subroutines were called with std=gnu and -w = > 14 "_final"s.
! { dg-final { scan-tree-dump-times "_final" 12 "original" } }
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index bbb81f40aa9..ef54a20dafd 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -2311,7 +2311,9 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock,
  Corrigenda 1 TO 4 for fortran 2008 (f08/0011).
 
  Transmit finalization of this constructor through 'finalblock'. */
-  if (!gfc_notification_std (GFC_STD_F2018_DEL) && finalblock != NULL
+  if ((gfc_option.allow_std & (GFC_STD_F2008 | GFC_STD_F2003))
+  && !(gfc_option.allow_std & GFC_STD_GNU)
+  && finalblock != NULL
   && gfc_may_be_finalized (ts)
   && ctr > 0 && desc != NULL_TREE
   && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 1b8be081a17..a69d7c7114d 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -9698,7 +9698,9 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr)
 	 executable construct containing the reference. This, in fact,
 	 was later deleted by the Combined Techical Corrigenda 1 TO 4 for
 	 fortran 2008 (f08/0011).  */
-  if (!gfc_notification_std (GFC_STD_F2018_DEL) && expr->must_finalize
+  if ((gfc_option.allow_std & (GFC_STD_F2008 | GFC_STD_F2003))
+	  && !(gfc_option.allow_std & GFC_STD_GNU)
+	  && expr->must_finalize
 	  && gfc_may_be_finalized (expr->ts))
 	{
 	  gfc_warning (0, "The structure constructor at %C has been"


Re: [PATCH] Fortran: Fix generate_error library function fnspec

2023-11-04 Thread Paul Richard Thomas
Hi Martin,

This looks to be 'obvious' and is certainly OK for mainline. Backport if
you wish.

Thanks

Paul


On Fri, 3 Nov 2023 at 12:54, Martin Jambor  wrote:

> Hi,
>
> when developing an otherwise unrelated patch I've discovered that the
> fnspec for the Fortran library function generate_error is wrong. It is
> currently ". R . R " where the first R describes the first parameter
> and means that it "is only read and does not escape."  The function
> itself, however, with signature:
>
>   bool
>   generate_error_common (st_parameter_common *cmp, int family, const char
> *message)
>
> contains the following:
>
>   /* Report status back to the compiler.  */
>   cmp->flags &= ~IOPARM_LIBRETURN_MASK;
>
> which does not correspond to the fnspec and breaks testcase
> gfortran.dg/large_unit_2.f90 when my patch is applied, since it tries
> to re-use the flags from before the call.
>
> This patch replaces the "R" with "W" which stands for "specifies that
> the memory pointed to by the parameter does not escape."
>
> Bootstrapped and tested on x86_64-linux.  OK for master?
>
>
> 2023-11-02  Martin Jambor  
>
> * trans-decl.cc (gfc_build_builtin_function_decls): Fix fnspec of
> generate_error.
>
> ---
>  gcc/fortran/trans-decl.cc | 2 +-
>  1 file changed, 1 insertion(+), 1 deletion(-)
>
> diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
> index a3f037bd07b..b86cfec7d49 100644
> --- a/gcc/fortran/trans-decl.cc
> +++ b/gcc/fortran/trans-decl.cc
> @@ -3821,7 +3821,7 @@ gfc_build_builtin_function_decls (void)
> void_type_node, -2, pchar_type_node, pchar_type_node);
>
>gfor_fndecl_generate_error = gfc_build_library_function_decl_with_spec (
> -   get_identifier (PREFIX("generate_error")), ". R . R ",
> +   get_identifier (PREFIX("generate_error")), ". W . R ",
> void_type_node, 3, pvoid_type_node, integer_type_node,
> pchar_type_node);
>
> --
> 2.42.0
>
>


Re: [PATCH] Fortran: passing of allocatable/pointer arguments to OPTIONAL+VALUE [PR92887]

2023-11-03 Thread Paul Richard Thomas
Hi Harald,

This looks good to me. OK for mainline.

Thanks for the patch.

Paul


On Wed, 1 Nov 2023 at 22:10, Harald Anlauf  wrote:

> Dear all,
>
> I've dusted off and cleaned up a previous attempt to fix the handling
> of allocatable or pointer actual arguments to OPTIONAL+VALUE dummies.
> The standard says that a non-allocated / non-associated actual argument
> in that case shall be treated as non-present.
>
> However, gfortran's calling conventions demand that the presence status
> for OPTIONAL+VALUE is passed as a hidden argument, while we need to
> pass something on the stack which has the right type.  The solution
> is to conditionally create a temporary when needed.
>
> Testcase checked with NAG.
>
> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
>
> Thanks,
> Harald
>
>


[Patch, fortran] PR112316 - [13 Regression] Fix for PR87477 rejects valid code with a bogus error...

2023-11-03 Thread Paul Richard Thomas
Hi All,

I have pushed as 'obvious' a fix for this regression to both 13-branch and
mainline. The patch itself looks substantial but it consists entirely of
the removal of a condition and repagination of the corresponding block.
Please see below for part of my first comment on the PR for an explanation.

Paul

A temporary work around is to invert the order of the contained procedures.

The problem is caused by a stupid (on my part :-( ) oversight:
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index e103ebee557..f88f9be3be8 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -5196,7 +5196,7 @@ parse_associate (void)
}
}

-  if (target->rank)
+  if (1)
{
  int rank = 0;
  rank = target->rank;

fixes the problem and regtests OK.


Re: [Patch, fortran] PR98498 - Interp request: defined operators and unlimited polymorphic

2023-11-02 Thread Paul Richard Thomas
Hi Harald,

I was overthinking the problem. The rejected cases led me to a fix that can
only be described as a considerable simplification compared with the first
patch!

The testcase now reflects the requirements of the standard and
regtests without failures.

OK for mainline?

Thanks

Paul

Fortran: Defined operators with unlimited polymorphic args [PR98498]

2023-11-02  Paul Thomas  

gcc/fortran
PR fortran/98498
* interface.cc (upoly_ok): Defined operators using unlimited
polymorphic formal arguments must not override the intrinsic
operator use.

gcc/testsuite/
PR fortran/98498
* gfortran.dg/interface_50.f90: New test.


On Wed, 1 Nov 2023 at 20:12, Harald Anlauf  wrote:

> Hi Paul,
>
> Am 01.11.23 um 19:02 schrieb Paul Richard Thomas:
> > The interpretation request came in a long time ago but I only just got
> > around to implementing it.
> >
> > The updated text from the standard is in the comment. Now I am writing
> > this, I think that I should perhaps use switch(op)/case rather than using
> > if/else if and depending on the order of the gfc_intrinsic_op enum being
> > maintained. Thoughts?
>
> the logic is likely harder to parse with if/else than with
> switch(op)/case.  However, I do not think that the order of
> the enum will ever be changed, as the module format relies
> on that very order.
>
> > The testcase runs fine with both mainline and nagfor. I think that
> > compile-only with counts of star-eq and star_not should suffice.
>
> I found other cases that are rejected even with your patch,
> but which are accepted by nagfor.  Example:
>
> print *, ('a' == c)
>
> Nagfor prints F at runtime as expected, as it correctly resolves
> this to star_eq.  Further examples can be easily constructed.
>
> Can you have a look?
>
> Thanks,
> Harald
>
> > Regtests with no regressions. OK for mainline?
> >
> > Paul
> >
> > Fortran: Defined operators with unlimited polymorphic args [PR98498]
> >
> > 2023-11-01  Paul Thomas  
> >
> > gcc/fortran
> > PR fortran/98498
> > * interface.cc (upoly_ok): New function.
> > (gfc_extend_expr): Use new function to ensure that defined
> > operators using unlimited polymorphic formal arguments do not
> > override their intrinsic uses.
> >
> > gcc/testsuite/
> > PR fortran/98498
> > * gfortran.dg/interface_50.f90: New test.
> >
>
>
diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index 8c4571e0aa6..fc4fe662eab 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -4737,6 +4737,17 @@ gfc_extend_expr (gfc_expr *e)
 	  if (sym != NULL)
 	break;
 	}
+
+  /* F2018(15.4.3.4.2) requires that the use of unlimited polymorphic
+	 formal arguments does not override the intrinsic uses.  */
+  gfc_push_suppress_errors ();
+  if (sym
+	  && (UNLIMITED_POLY (sym->formal->sym)
+	  || (sym->formal->next
+		  && UNLIMITED_POLY (sym->formal->next->sym)))
+	  && !gfc_check_operator_interface (sym, e->value.op.op, e->where))
+	sym = NULL;
+  gfc_pop_suppress_errors ();
 }
 
   /* TODO: Do an ambiguity-check and error if multiple matching interfaces are
! { dg-do compile }
! { dg-options "-fdump-tree-original" }
!
! Tests the fix for PR98498, which was subject to an interpretation request
! as to whether or not the interface operator overrode the intrinsic use.
! (See PR for correspondence)
!
! Contributed by Paul Thomas  
!
MODULE mytypes
  IMPLICIT none

  TYPE pvar
 character(len=20) :: name
 integer   :: level
  end TYPE pvar

  interface operator (==)
 module procedure star_eq
  end interface

  interface operator (.not.)
 module procedure star_not
  end interface

contains
  function star_eq(a, b)
implicit none
class(*), intent(in) :: a, b
logical :: star_eq
select type (a)
  type is (pvar)
  select type (b)
type is (pvar)
  if((a%level .eq. b%level) .and. (a%name .eq. b%name)) then
star_eq = .true.
  else
star_eq = .false.
  end if
type is (integer)
  star_eq = (a%level == b)
  end select
  class default
star_eq = .false.
end select
  end function star_eq

  function star_not (a)
implicit none
class(*), intent(in) :: a
type(pvar) :: star_not
select type (a)
  type is (pvar)
star_not = a
star_not%level = -star_not%level
  type is (real)
star_not = pvar ("real", -int(a))
  class default
star_not = pvar ("noname", 0)
end select
  end function

end MODULE mytypes

program test_eq
   use mytypes
   implicit none

   type(pvar) x, y
   integer :: i = 4
   real :: r = 2.0
   character(len = 4, kin

[Patch, fortran] PR98498 - Interp request: defined operators and unlimited polymorphic

2023-11-01 Thread Paul Richard Thomas
The interpretation request came in a long time ago but I only just got
around to implementing it.

The updated text from the standard is in the comment. Now I am writing
this, I think that I should perhaps use switch(op)/case rather than using
if/else if and depending on the order of the gfc_intrinsic_op enum being
maintained. Thoughts?

The testcase runs fine with both mainline and nagfor. I think that
compile-only with counts of star-eq and star_not should suffice.

Regtests with no regressions. OK for mainline?

Paul

Fortran: Defined operators with unlimited polymorphic args [PR98498]

2023-11-01  Paul Thomas  

gcc/fortran
PR fortran/98498
* interface.cc (upoly_ok): New function.
(gfc_extend_expr): Use new function to ensure that defined
operators using unlimited polymorphic formal arguments do not
override their intrinsic uses.

gcc/testsuite/
PR fortran/98498
* gfortran.dg/interface_50.f90: New test.
diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index 8c4571e0aa6..ba7fb5dfea5 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -4616,6 +4616,35 @@ build_compcall_for_operator (gfc_expr* e, gfc_actual_arglist* actual,
 }
 
 
+/* Check if the type of an actual argument is OK to use with an
+   unlimited polymorphic formal argument in a defined operation.  */
+
+static bool
+upoly_ok (bt type, gfc_intrinsic_op op)
+{
+  bool ok = false;
+  if (type == BT_DERIVED || type == BT_CLASS)
+ok = true;
+  else if ((op >= INTRINSIC_UPLUS && op <= INTRINSIC_POWER)
+	   && (type == BT_LOGICAL || type == BT_CHARACTER))
+ok = true;
+  else if ((op == INTRINSIC_CONCAT) && (type != BT_CHARACTER))
+ok = true;
+  else if ((op >= INTRINSIC_GT && op <= INTRINSIC_LE)
+	   && (type == BT_COMPLEX))
+ok = true;
+  else if ((op >= INTRINSIC_GT_OS) && (op <= INTRINSIC_LE_OS)
+	   && (type == BT_COMPLEX))
+ok = true;
+  else if ((op >= INTRINSIC_AND) && (op <= INTRINSIC_NEQV)
+	   && (type != BT_LOGICAL))
+ok = true;
+  else if ((op == INTRINSIC_NOT) && (type != BT_LOGICAL))
+ok = true;
+  return ok;
+}
+
+
 /* This subroutine is called when an expression is being resolved.
The expression node in question is either a user defined operator
or an intrinsic operator with arguments that aren't compatible
@@ -4737,6 +4766,24 @@ gfc_extend_expr (gfc_expr *e)
 	  if (sym != NULL)
 	break;
 	}
+
+  /* F2018(15.4.3.4.2): "If the operator is an intrinsic-operator (R608),
+	 the number of dummy arguments shall be consistent with the intrinsic
+	 uses of that operator, and the types, kind type parameters, or ranks
+	 of the dummy arguments shall differ from those required for the
+	 intrinsic operation (10.1.5)." ie. the use of unlimited polymorphic
+	 formal arguments must not override the intrinsic uses.  */
+  if (sym && (UNLIMITED_POLY (sym->formal->sym)
+		  || (sym->formal->next
+		  && UNLIMITED_POLY (sym->formal->next->sym
+	{
+	  bool arg2 = (actual->next != NULL);
+	  bool a1ok = upoly_ok (actual->expr->ts.type, e->value.op.op);
+	  bool a2ok = arg2 && upoly_ok (actual->next->expr->ts.type,
+	e->value.op.op);
+	  if ((!arg2 && !a1ok) || (arg2 && (!a1ok && !a2ok)))
+	sym = NULL;
+	}
 }
 
   /* TODO: Do an ambiguity-check and error if multiple matching interfaces are
! { dg-do compile }
! { dg-options "-fdump-tree-original" }
!
! Tests the fix for PR98498, which was subject to an interpretation request
! as to whether or not the interface operator overrode the intrinsic use.
! (See PR for correspondence)
!
! Contributed by Paul Thomas  
!
MODULE mytypes
  IMPLICIT none

  TYPE pvar
 character(len=20) :: name
 integer   :: level
  end TYPE pvar

  interface operator (==)
 module procedure star_eq
  end interface

  interface operator (.not.)
 module procedure star_not
  end interface

contains
  function star_eq(a, b)
implicit none
class(*), intent(in) :: a, b
logical :: star_eq
select type (a)
  type is (pvar)
  select type (b)
type is (pvar)
  if((a%level .eq. b%level) .and. (a%name .eq. b%name)) then
star_eq = .true.
  else
star_eq = .false.
  end if
type is (integer)
  star_eq = (a%level == b)
  end select
  class default
star_eq = .false.
end select
  end function star_eq

  function star_not (a)
implicit none
class(*), intent(in) :: a
type(pvar) :: star_not
select type (a)
  type is (pvar)
star_not = a
star_not%level = -star_not%level
  type is (real)
star_not = pvar ("real", -int(a))
  class default
star_not = pvar ("noname", 0)
end select
  end function

end MODULE mytypes

program test_eq
   use mytypes
   implicit none

   type(pvar) x, y
   integer :: i = 4
   real :: r = 2.0
! Check that intrinsic use of .not. and == is not overridden.
   if (.not.(i == 2*int (r))) stop 1
   if (r == 1.0) stop 2

! Test defined 

[Patch, fortran] PR64120

2023-10-31 Thread Paul Richard Thomas
I found this 'obvious' fix, while going through PRs assigned to me.

Regtests. OK for mainline?

Cheers

Paul


Fortran: Allocatable automatic charlen must not be saved [PR64120].

2023-10-31  Paul Thomas  

gcc/fortran
PR fortran/64120
* trans-decl.cc (gfc_trans_deferred_vars): Detect automatic
character length and allow allocatable variants to be nullified
on scope entry and freed on scope exit. Remove trailing white
space.

gcc/testsuite/
PR fortran/64120
* gfortran.dg/pr64120_2.f90: New test.
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index a3f037bd07b..5e0e78ace40 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -4689,9 +4689,14 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 && (sym->ts.u.derived->attr.alloc_comp
 || gfc_is_finalizable (sym->ts.u.derived,
 			   NULL));
+  bool automatic_char_len;
   if (sym->assoc)
 	continue;
 
+  automatic_char_len = sym->ts.type == BT_CHARACTER
+			   && sym->ts.u.cl && sym->ts.u.cl->length
+			   && sym->ts.u.cl->length->expr_type == EXPR_VARIABLE;
+
   /* Set the vptr of unlimited polymorphic pointer variables so that
 	 they do not cause segfaults in select type, when the selector
 	 is an intrinsic type.  */
@@ -4951,7 +4956,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 		|| (sym->ts.type == BT_CLASS
 			&& CLASS_DATA (sym)->attr.allocatable)))
 	{
-	  if (!sym->attr.save && flag_max_stack_var_size != 0)
+	  if ((!sym->attr.save || automatic_char_len)
+	   && flag_max_stack_var_size != 0)
 	{
 	  tree descriptor = NULL_TREE;
 
@@ -5210,8 +5216,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 	tree tmp = lookup_attribute ("omp allocate",
  DECL_ATTRIBUTES (n->sym->backend_decl));
 	tmp = TREE_VALUE (tmp);
-	TREE_PURPOSE (tmp) = se.expr;	
-	TREE_VALUE (tmp) = align;	
+	TREE_PURPOSE (tmp) = se.expr;
+	TREE_VALUE (tmp) = align;
 	TREE_PURPOSE (TREE_CHAIN (tmp)) = init_stmtlist;
 	TREE_VALUE (TREE_CHAIN (tmp)) = cleanup_stmtlist;
   }
! { dg-do compile }
! { dg-options "-fdump-tree-original" }
!
! Test fix of second testcase in PR64120.
! The first testcase is allocatable_scalar_14.f90.
!
! Contributed by Francois-Xavier Coudert  
!
program test
   logical :: L
   L = g(1)
   write(*,*) L
   L = g(2)
   write(*,*) L
contains
  logical function g(x)
  integer :: x
  character(len=x), allocatable :: s
  save
  if(.NOT.allocated(s)) then
allocate(s)
g = .FALSE.
  else
g = .TRUE.
  end if
  write(*,*) len(s)
  end function g
end
! { dg-final { scan-tree-dump-times "s = 0B;" 2 "original" } }
! { dg-final { scan-tree-dump-times "__builtin_free" 1 "original" } }


[Patch, fortran] PR104555 - ICE in gfc_compare_derived_types, at fortran/interface.cc:628 since r10-2912-g70570ec192745095

2023-10-29 Thread Paul Richard Thomas
Bizarrely, since the fix for pr101625, the testcase compiles and runs
correctly with s/select type (y => x)/select type (y => (x))/ !

The fix is straightforward and appears to be one of those wrinkles arising
from the use of associate variables as a selector. The fault is reasonable
since the expression is a reference to the _data field, which is of derived
type. However, being a select type selector, the selector must be a
class with that declared type.

Regtests fine. OK for mainline?

Paul

Fortran: Fix a problem with SELECT TYPE selectors [PR104555].

2023-10-29  Paul Thomas  

gcc/fortran
PR fortran/104555
* resolve.cc (resolve_select_type): If the selector expression
has no class component references and the expression is a
derived type, copy the typespec of the symbol to that of the
expression.

gcc/testsuite/
PR fortran/104555
* gfortran.dg/pr104555.f90: New test.
! { dg-do compile }
!
! Test the fix for PR104555 in which the select type statement caused an
! ICE because the selector expression was type(t) rather than class(t).
!
! Contributed by Gerhard Steinmetz  
!
program p
   type t
  character(:), allocatable :: a
   end type
   call s(t("abcd"))
   call s([t("efgh")])
contains
   subroutine s(x)
  class(t) :: x(..)
  select rank (x)
  rank (0)
 print *, "|", x%a, "|"
 select type (y => x)
 type is (t)
   print *, "|", y%a, "|"
 end select
  rank (1)
 print *, "|", x(1)%a, "|"
 select type (y => x)
 type is (t)
   print *, "|", y(1)%a, "|"
 end select
  end select
   end
end
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 9f4dc072645..b394f7fc79c 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -9578,6 +9578,12 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
 	{
 	  if (code->expr1->symtree->n.sym->attr.untyped)
 	code->expr1->symtree->n.sym->ts = code->expr2->ts;
+	  /* Sometimes the selector expression is given the typespec of the
+	 '_data' field, which is logical enough but inappropraite here. */
+	  if (code->expr2->ts.type == BT_DERIVED
+	  && code->expr2->symtree
+	  && code->expr2->symtree->n.sym->ts.type == BT_CLASS)
+	code->expr2->ts = code->expr2->symtree->n.sym->ts;
 	  selector_type = CLASS_DATA (code->expr2)
 	? CLASS_DATA (code->expr2)->ts.u.derived : code->expr2->ts.u.derived;
 	}


Re: [PATCH] Fortran: diagnostics of MODULE PROCEDURE declaration conflicts [PR104649]

2023-10-27 Thread Paul Richard Thomas
Hi Harald,

That's good for mainline.

Thanks for the patch

Paul


On Thu, 26 Oct 2023 at 21:43, Harald Anlauf  wrote:

> Dear all,
>
> the attached patch improves the diagnostics of MODULE PROCEDURE declaration
> conflicts, when one of the declarations is an alternate return.  We used to
> ICE before.
>
> Steve identified the cause of the issue and provided a partial fix.
>
> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
>
> Thanks,
> Harald
>
>


[Patch, fortran] PR104625 ICE in fixup_array_ref, at fortran/resolve.cc:9275 since r10-2912-g70570ec192745095

2023-10-26 Thread Paul Richard Thomas
Hi All,

The attached patch fixes the original problem, in which parentheses around
the selector in select type constructs caused ICES. Stacked parentheses
caused problems in trans-stmt.cc. Rather than tracking this down, the
redundant parentheses were removed on resolution of the selector
expression.

Fixing the primary problem revealed "Unclassifiable statement" errors when
using array references of the associate variable and this was fixed as
well. Finally, the error triggered by using associate variables associated
with non-variable selectors was corrected to ensure that only vector
indexed selectors were flagged up as such. The secondary error in
associate_55.f90 was corrected for this, since the selector might or might
not be vector indexed.

Regtests fine - OK for trunk?

Paul

Fortran: Fix some problems with SELECT TYPE selectors [PR104625].

2023-10-26  Paul Thomas  

gcc/fortran
PR fortran/104625
* expr.cc (gfc_check_vardef_context): Check that the target
does have a vector index before emitting the specific error.
* match.cc (copy_ts_from_selector_to_associate): Ensure that
class valued operator expressions set the selector rank and
use the rank to provide the associate variable with an
appropriate array spec.
* resolve.cc (resolve_operator): Reduce stacked parentheses to
a single pair.
(fixup_array_ref): Extract selector symbol from parentheses.

gcc/testsuite/
PR fortran/104625
* gfortran.dg/pr104625.f90: New test.
* gfortran.dg/associate_55.f90: Change error check text.
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 663fe63dea6..c668baeef8c 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -6474,7 +6474,8 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
 	{
 	  if (context)
 	{
-	  if (assoc->target->expr_type == EXPR_VARIABLE)
+	  if (assoc->target->expr_type == EXPR_VARIABLE
+		  && gfc_has_vector_index (assoc->target))
 		gfc_error ("%qs at %L associated to vector-indexed target"
 			   " cannot be used in a variable definition"
 			   " context (%s)",
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index c926f38058f..05995c6f97f 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -6341,12 +6341,13 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector)
   else if (selector->ts.type == BT_CLASS
 	   && CLASS_DATA (selector)
 	   && CLASS_DATA (selector)->as
-	   && ref && ref->type == REF_ARRAY)
+	   && ((ref && ref->type == REF_ARRAY)
+	   || selector->expr_type == EXPR_OP))
 {
   /* Ensure that the array reference type is set.  We cannot use
 	 gfc_resolve_expr at this point, so the usable parts of
 	 resolve.cc(resolve_array_ref) are employed to do it.  */
-  if (ref->u.ar.type == AR_UNKNOWN)
+  if (ref && ref->u.ar.type == AR_UNKNOWN)
 	{
 	  ref->u.ar.type = AR_ELEMENT;
 	  for (int i = 0; i < ref->u.ar.dimen + ref->u.ar.codimen; i++)
@@ -6360,7 +6361,7 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector)
 	  }
 	}
 
-  if (ref->u.ar.type == AR_FULL)
+  if (!ref || ref->u.ar.type == AR_FULL)
 	selector->rank = CLASS_DATA (selector)->as->rank;
   else if (ref->u.ar.type == AR_SECTION)
 	selector->rank = ref->u.ar.dimen;
@@ -6372,12 +6373,15 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector)
 
   if (rank)
 {
-  for (int i = 0; i < ref->u.ar.dimen + ref->u.ar.codimen; i++)
-	if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT
-	|| (ref->u.ar.dimen_type[i] == DIMEN_UNKNOWN
-		&& ref->u.ar.end[i] == NULL
-		&& ref->u.ar.stride[i] == NULL))
-	  rank--;
+  if (ref)
+	{
+	  for (int i = 0; i < ref->u.ar.dimen + ref->u.ar.codimen; i++)
+	if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT
+	  || (ref->u.ar.dimen_type[i] == DIMEN_UNKNOWN
+		  && ref->u.ar.end[i] == NULL
+		  && ref->u.ar.stride[i] == NULL))
+	  rank--;
+	}
 
   if (rank)
 	{
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 861f69ac20f..9f4dc072645 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -4138,6 +4138,16 @@ resolve_operator (gfc_expr *e)
   bool dual_locus_error;
   bool t = true;
 
+  /* Reduce stacked parentheses to single pair  */
+  while (e->expr_type == EXPR_OP
+	 && e->value.op.op == INTRINSIC_PARENTHESES
+	 && e->value.op.op1->expr_type == EXPR_OP
+	 && e->value.op.op1->value.op.op == INTRINSIC_PARENTHESES)
+{
+  gfc_expr *tmp = gfc_copy_expr (e->value.op.op1);
+  gfc_replace_expr (e, tmp);
+}
+
   /* Resolve all subnodes-- give them types.  */
 
   switch (e->value.op.op)
@@ -9451,8 +9461,25 @@ fixup_array_ref (gfc_expr **expr1, gfc_expr *expr2,
 {
   gfc_ref *nref = (*expr1)->ref;
   gfc_symbol *sym1 = (*expr1)->symtree->n.sym;
-  gfc_symbol *sym2 = expr2 ? expr2->symtree->n.sym : NULL;
+  gfc_symbol *sym2;
+  gfc_expr *selector = gfc_copy_expr (expr2);
+
   (*expr1)->rank = rank;
+  if (selector)
+{
+  gfc_resolve_expr (selector);
+

Re: [Patch, fortran] PR67740 - Wrong association status of allocatable character pointer in derived types

2023-10-11 Thread Paul Richard Thomas
Hi Harald and Bernhard,

Indeed, you are right about the space. However, the compile is intentional.
This catches the fix:
! { dg-final { scan-tree-dump-times "co._data1_length = 10;" 1 "original" }
}

Also, it helps to get the PR number right!

I was rushing to get the patch out before leaving for work and so even more
error prone than usual

Cheers

Paul





On Wed, 11 Oct 2023 at 20:21, Harald Anlauf  wrote:

> Hi Paul,
>
> the patch is fine, but I forgot the mention that the testcase needs fixing:
>
> Instead of
>
> ! {dg-do compile }
>
> you'll likely want
>
> ! { dg-do run }
>
> (Note the space before the dg-command.)
>
> Cheers,
> Harald
>
> On 10/11/23 21:06, Harald Anlauf wrote:
> > Hi Paul,
> >
> > On 10/11/23 10:48, Paul Richard Thomas wrote:
> >> Hi All,
> >>
> >> The title line of the PR should have been changed a long time since. As
> >> noted in comment 5, the original problem was fixed in 10.5.
> >>
> >> This patch fixes the problem described in comments 4 and 6, where the
> >> hidden string length component was not being set in pointer assignment
> of
> >> character arrays.
> >>
> >> The fix regtests. OK for trunk and 13-branch?
> >
> > this is OK for both.
> >
> > I'd suggest to wait a couple of days or a week before backporting.
> >
> > Thanks for the patch!
> >
> > Harald
> >
> >> Thanks are due to Harald for bringing this to my attention.
> >>
> >> Paul
> >>
> >> Fortran: Set hidden string length for pointer components [PR67440]
> >>
> >> 2023-10-11  Paul Thomas  
> >>
> >> gcc/fortran
> >> PR fortran/pr67740
> >> * trans-expr.cc (gfc_trans_pointer_assignment): Set the hidden
> >> string length component for pointer assignment to character
> >> pointer components.
> >>
> >> gcc/testsuite/
> >> PR fortran/87477
> >> * gfortran.dg/pr67740.f90: New test
> >>
> >
> >
>
>


[Patch, fortran] PR67740 - Wrong association status of allocatable character pointer in derived types

2023-10-11 Thread Paul Richard Thomas
Hi All,

The title line of the PR should have been changed a long time since. As
noted in comment 5, the original problem was fixed in 10.5.

This patch fixes the problem described in comments 4 and 6, where the
hidden string length component was not being set in pointer assignment of
character arrays.

The fix regtests. OK for trunk and 13-branch?

Thanks are due to Harald for bringing this to my attention.

Paul

Fortran: Set hidden string length for pointer components [PR67440]

2023-10-11  Paul Thomas  

gcc/fortran
PR fortran/pr67740
* trans-expr.cc (gfc_trans_pointer_assignment): Set the hidden
string length component for pointer assignment to character
pointer components.

gcc/testsuite/
PR fortran/87477
* gfortran.dg/pr67740.f90: New test
! {dg-do compile }
! { dg-options "-fdump-tree-original" }
!
! Check the fix for the testcase in comment 4, where the hidden string length
! component of the array pointer component was not set.
!
! Contributed by Sebastien Bardeau  
!
program test2
  implicit none
  character(len=10), allocatable, target :: s(:)
  character(len=:),  pointer :: sptr(:)
  type :: pointer_typec0_t
character(len=:), pointer :: data0
character(len=:), pointer :: data1(:)
  end type pointer_typec0_t
  type(pointer_typec0_t) :: co
  !
  allocate(s(3))
  s(1) = '1234567890'
  s(2) = 'qwertyuio '
  s(3) = 'asdfghjk  '
  !
  sptr => s
  co%data0 => s(1)
  co%data1 => s
  !
  if (any (sptr .ne. s)) stop 1
  if (co%data0 .ne. s(1)) stop 2
  if (any (co%data1 .ne. s)) stop 3 ! Hidden string length was not set
end program test2
! { dg-final { scan-tree-dump-times "co._data1_length = 10;" 1 "original" } }diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 860b73c4968..7beefa2e69c 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -10403,11 +10403,36 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
 	}
 
   if (expr1->ts.type == BT_CHARACTER
-	  && expr1->symtree->n.sym->ts.deferred
-	  && expr1->symtree->n.sym->ts.u.cl->backend_decl
-	  && VAR_P (expr1->symtree->n.sym->ts.u.cl->backend_decl))
+	  && expr1->ts.deferred)
 	{
-	  tmp = expr1->symtree->n.sym->ts.u.cl->backend_decl;
+	  gfc_symbol *psym = expr1->symtree->n.sym;
+	  tmp = NULL_TREE;
+	  if (psym->ts.type == BT_CHARACTER)
+	{
+	  gcc_assert (psym->ts.u.cl->backend_decl
+			  && VAR_P (psym->ts.u.cl->backend_decl));
+	  tmp = psym->ts.u.cl->backend_decl;
+	}
+	  else if (expr1->ts.u.cl->backend_decl
+		   && VAR_P (expr1->ts.u.cl->backend_decl))
+	tmp = expr1->ts.u.cl->backend_decl;
+	  else if (TREE_CODE (lse.expr) == COMPONENT_REF)
+	{
+	  gfc_ref *ref = expr1->ref;
+	  for (;ref; ref = ref->next)
+		{
+		  if (ref->type == REF_COMPONENT
+		  && ref->u.c.component->ts.type == BT_CHARACTER
+		  && gfc_deferred_strlen (ref->u.c.component, ))
+		tmp = fold_build3_loc (input_location, COMPONENT_REF,
+	   TREE_TYPE (tmp),
+	   TREE_OPERAND (lse.expr, 0),
+	   tmp, NULL_TREE);
+		}
+	}
+
+	  gcc_assert (tmp);
+
 	  if (expr2->expr_type != EXPR_NULL)
 	gfc_add_modify (, tmp,
 			fold_convert (TREE_TYPE (tmp), strlen_rhs));


[Patch, fortran] PR111674 - [13/14 regression] Failure to finalize an allocatable subobject of a non-finalizable type

2023-10-04 Thread Paul Richard Thomas
This was fixed as 'obvious' with an off-list OK, posted on the PR, from
Harald. Applied to 13-branch and trunk then closed as fixed.

Cheers

Paul

Fortran: Alloc comp of non-finalizable type not finalized [PR111674]

2023-10-04  Paul Thomas  

gcc/fortran
PR fortran/37336
PR fortran/111674
* trans-expr.cc (gfc_trans_scalar_assign): Finalize components
on deallocation if derived type is not finalizable.

gcc/testsuite/
PR fortran/37336
PR fortran/111674
* gfortran.dg/allocate_with_source_25.f90: Final count in tree
dump reverts from 4 to original 6.
* gfortran.dg/finalize_38.f90: Add test for fix of PR111674.


Re: [Fortran, Patch, Coarray, PR 37336] Fix crash in finalizer when derived type coarray is already freed.

2023-10-01 Thread Paul Richard Thomas
Hi Andre,

All is well that ends well! Thanks for working on this.

Regards

Paul

On Sat, 30 Sept 2023 at 14:16, Andre Vehreschild  wrote:
>
> Hi all,
>
> back porting to gcc-13 unfortunately caused a regression due to
> gfc_deallocate_with_status() having a different parameter count. This is fixed
> as obvious by 874b895fffd921659b37dc05bc94eea48e9a0157.
>
> Sorry for breaking gfortran-13. I still don't know why it checkout fine on my
> system in the beginning. I must have done something wrong.
>
> Please accept my apologies and regards,
> Andre
>
> On Fri, 29 Sep 2023 15:13:56 +0200
> Andre Vehreschild via Fortran  wrote:
>
> > Hi Paul,
> >
> > thanks. Commit to trunk as a680274616ec6b26ccfdcee400ed7f54e341d40c
> > and backported to gcc-13 as d9b3269bdccac2db9200303494c4e82f2aeb7bbc
> >
> > Thanks for the fast review.
> >
> > Regards,
> >   Andre
> >
> > On Fri, 29 Sep 2023 13:38:57 +0100
> > Paul Richard Thomas  wrote:
> >
> > > Hi Andre,
> > >
> > > Yes indeed - it's fine for trunk and, I would suggest, 13-branch.
> > >
> > > Cheers
> > >
> > > Paul
> > >
> > > On Fri, 29 Sept 2023 at 11:01, Andre Vehreschild  wrote:
> > > >
> > > > Hi Paul,
> > > >
> > > > thanks for the quick review. I've added a testcase with a module and a
> > > > finalizer in the derived type. This also is no problem.
> > > >
> > > > Regtests ok on x86_64_linux_gnu/f37. Ok for trunk?
> > > >
> > > > Regards,
> > > > Andre
> > > >
> > > > On Thu, 28 Sep 2023 19:21:12 +0100
> > > > Paul Richard Thomas  wrote:
> > > >
> > > > > Hi Andre,
> > > > >
> > > > > The patch looks fine to me. Since you mention it in the comment, is it
> > > > > worth declaring the derived type 'foo' in a module and giving it a
> > > > > final routine?
> > > > >
> > > > > Thanks for the patch.
> > > > >
> > > > > Paul
> > > > >
> > > > > On Thu, 28 Sept 2023 at 13:45, Andre Vehreschild via Fortran
> > > > >  wrote:
> > > > > >
> > > > > > Hi all,
> > > > > >
> > > > > > attached patch fixes a crash in coarray programs when an allocatable
> > > > > > derived typed coarray was freed explicitly. The generated cleanup 
> > > > > > code
> > > > > > did not take into account, that the coarray may have been 
> > > > > > deallocated
> > > > > > already. The patch fixes this by moving the statements accessing
> > > > > > components inside the derived type into the block guard by its
> > > > > > allocated check.
> > > > > >
> > > > > > Regtested ok on f37/x86_64. Ok for master?
> > > > > >
> > > > > > Regards,
> > > > > > Andre
> > > > > > --
> > > > > > Andre Vehreschild * Email: vehre ad gmx dot de
> > > >
> > > >
> > > > --
> > > > Andre Vehreschild * Email: vehre ad gmx dot de
> >
> >
> > --
> > Andre Vehreschild * Email: vehre ad gmx dot de
>
>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de


Re: [Fortran, Patch, Coarray, PR 37336] Fix crash in finalizer when derived type coarray is already freed.

2023-09-29 Thread Paul Richard Thomas
Hi Andre,

Yes indeed - it's fine for trunk and, I would suggest, 13-branch.

Cheers

Paul

On Fri, 29 Sept 2023 at 11:01, Andre Vehreschild  wrote:
>
> Hi Paul,
>
> thanks for the quick review. I've added a testcase with a module and a
> finalizer in the derived type. This also is no problem.
>
> Regtests ok on x86_64_linux_gnu/f37. Ok for trunk?
>
> Regards,
> Andre
>
> On Thu, 28 Sep 2023 19:21:12 +0100
> Paul Richard Thomas  wrote:
>
> > Hi Andre,
> >
> > The patch looks fine to me. Since you mention it in the comment, is it
> > worth declaring the derived type 'foo' in a module and giving it a
> > final routine?
> >
> > Thanks for the patch.
> >
> > Paul
> >
> > On Thu, 28 Sept 2023 at 13:45, Andre Vehreschild via Fortran
> >  wrote:
> > >
> > > Hi all,
> > >
> > > attached patch fixes a crash in coarray programs when an allocatable 
> > > derived
> > > typed coarray was freed explicitly. The generated cleanup code did not 
> > > take
> > > into account, that the coarray may have been deallocated already. The 
> > > patch
> > > fixes this by moving the statements accessing components inside the 
> > > derived
> > > type into the block guard by its allocated check.
> > >
> > > Regtested ok on f37/x86_64. Ok for master?
> > >
> > > Regards,
> > > Andre
> > > --
> > > Andre Vehreschild * Email: vehre ad gmx dot de
>
>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de


Re: [Fortran, Patch, Coarray, PR 37336] Fix crash in finalizer when derived type coarray is already freed.

2023-09-28 Thread Paul Richard Thomas
Hi Andre,

The patch looks fine to me. Since you mention it in the comment, is it
worth declaring the derived type 'foo' in a module and giving it a
final routine?

Thanks for the patch.

Paul

On Thu, 28 Sept 2023 at 13:45, Andre Vehreschild via Fortran
 wrote:
>
> Hi all,
>
> attached patch fixes a crash in coarray programs when an allocatable derived
> typed coarray was freed explicitly. The generated cleanup code did not take
> into account, that the coarray may have been deallocated already. The patch
> fixes this by moving the statements accessing components inside the derived 
> type
> into the block guard by its allocated check.
>
> Regtested ok on f37/x86_64. Ok for master?
>
> Regards,
> Andre
> --
> Andre Vehreschild * Email: vehre ad gmx dot de


[Patch, fortran] PR68155 - ICE on initializing character array in type (len_lhs <> len_rhs)

2023-09-20 Thread Paul Richard Thomas
Hi All,

This is a straightforward patch that is adequately explained by the ChangeLog.

Regtests fine - OK for trunk?

Cheers

Paul

Fortran: Pad mismatched charlens in component initializers [PR68155]

2023-09-20  Paul Thomas  

gcc/fortran
PR fortran/68155
* decl.cc (fix_initializer_charlen): New function broken out of
add_init_expr_to_sym.
(add_init_expr_to_sym, build_struct): Call the new function.

gcc/testsuite/
PR fortran/68155
* gfortran.dg/pr68155.f90: New test.
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 8182ef29f43..4a3c5b86de0 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -1960,6 +1960,45 @@ gfc_free_enum_history (void)
 }
 
 
+/* Function to fix initializer character length if the length of the
+   symbol or component is constant.  */
+
+static bool
+fix_initializer_charlen (gfc_typespec *ts, gfc_expr *init)
+{
+  if (!gfc_specification_expr (ts->u.cl->length))
+return false;
+
+  int k = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false);
+
+  /* resolve_charlen will complain later on if the length
+ is too large.  Just skip the initialization in that case.  */
+  if (mpz_cmp (ts->u.cl->length->value.integer,
+	   gfc_integer_kinds[k].huge) <= 0)
+{
+  HOST_WIDE_INT len
+		= gfc_mpz_get_hwi (ts->u.cl->length->value.integer);
+
+  if (init->expr_type == EXPR_CONSTANT)
+	gfc_set_constant_character_len (len, init, -1);
+  else if (init->expr_type == EXPR_ARRAY)
+	{
+	  gfc_constructor *cons;
+
+	  /* Build a new charlen to prevent simplification from
+	 deleting the length before it is resolved.  */
+	  init->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
+	  init->ts.u.cl->length = gfc_copy_expr (ts->u.cl->length);
+	  cons = gfc_constructor_first (init->value.constructor);
+	  for (; cons; cons = gfc_constructor_next (cons))
+	gfc_set_constant_character_len (len, cons->expr, -1);
+	}
+}
+
+  return true;
+}
+
+
 /* Function called by variable_decl() that adds an initialization
expression to a symbol.  */
 
@@ -2073,40 +2112,10 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
 gfc_copy_expr (init->ts.u.cl->length);
 		}
 	}
-	  /* Update initializer character length according symbol.  */
-	  else if (sym->ts.u.cl->length->expr_type == EXPR_CONSTANT)
-	{
-	  if (!gfc_specification_expr (sym->ts.u.cl->length))
-		return false;
-
-	  int k = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind,
-	 false);
-	  /* resolve_charlen will complain later on if the length
-		 is too large.  Just skeep the initialization in that case.  */
-	  if (mpz_cmp (sym->ts.u.cl->length->value.integer,
-			   gfc_integer_kinds[k].huge) <= 0)
-		{
-		  HOST_WIDE_INT len
-		= gfc_mpz_get_hwi (sym->ts.u.cl->length->value.integer);
-
-		  if (init->expr_type == EXPR_CONSTANT)
-		gfc_set_constant_character_len (len, init, -1);
-		  else if (init->expr_type == EXPR_ARRAY)
-		{
-		  gfc_constructor *c;
-
-		  /* Build a new charlen to prevent simplification from
-			 deleting the length before it is resolved.  */
-		  init->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
-		  init->ts.u.cl->length
-			= gfc_copy_expr (sym->ts.u.cl->length);
-
-		  for (c = gfc_constructor_first (init->value.constructor);
-			   c; c = gfc_constructor_next (c))
-			gfc_set_constant_character_len (len, c->expr, -1);
-		}
-		}
-	}
+	  /* Update initializer character length according to symbol.  */
+	  else if (sym->ts.u.cl->length->expr_type == EXPR_CONSTANT
+		   && !fix_initializer_charlen (>ts, init))
+	return false;
 	}
 
   if (sym->attr.flavor == FL_PARAMETER && sym->attr.dimension && sym->as
@@ -2369,6 +2378,13 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
   c->initializer = *init;
   *init = NULL;
 
+  /* Update initializer character length according to component.  */
+  if (c->ts.type == BT_CHARACTER && c->ts.u.cl->length
+  && c->ts.u.cl->length->expr_type == EXPR_CONSTANT
+  && c->initializer && c->initializer->ts.type == BT_CHARACTER
+  && !fix_initializer_charlen (>ts, c->initializer))
+return false;
+
   c->as = *as;
   if (c->as != NULL)
 {
! { dg-do run }
!
! Fix for PR68155 in which initializers of constant length, character
! components of derived types were not being padded if they were too short.
! Originally, mismatched lengths caused ICEs. This seems to have been fixed
! in 9-branch.
!
! Contributed by Gerhard Steinmetz  
!
program p
  implicit none
  type t
character(3) :: c1(2) = [ 'b', 'c']  ! OK
character(3) :: c2(2) = [ character(1) :: 'b', 'c'] // ""! OK
character(3) :: c3(2) = [ 'b', 'c'] // ""! was not padded
character(3) :: c4(2) = [ '' , '' ] // ""! was not padded
character(3) :: c5(2) = [ 'b', 'c'] // 'a'   ! was not padded
character(3) :: c6(2) = [

Re: [PATCH] fortran: Remove reference count update [PR108957]

2023-09-15 Thread Paul Richard Thomas via Gcc-patches
Hi Mikael,

The comment is very welcome! Looks good to me. OK for mainline.

Thanks for the patch.

Paul

On Fri, 15 Sept 2023 at 08:19, Mikael Morin via Fortran
 wrote:
>
> Hello,
>
> Harald reminded me recently that there was a working patch attached to the PR.
> I added a documentation comment with the hope that it may help avoid
> making the same mistake in the future.
> Regression tested on x86_64-pc-linux-gnu.
> OK for master?
>
> -- >8 --
>
> Remove one reference count incrementation following the assignment of a
> symbol pointer to a local variable.  Most symbol pointers are "weak" pointer
> and don't need any reference count update when they are assigned, and it is
> especially the case of local variables.
>
> This fixes a memory leak with the testcase from the PR (not included).
>
> PR fortran/108957
>
> gcc/fortran/ChangeLog:
>
> * gfortran.h (gfc_symbol): Add comment documenting reference counting.
> * parse.cc (parse_interface): Remove reference count incrementation.
> ---
>  gcc/fortran/gfortran.h | 20 
>  gcc/fortran/parse.cc   |  3 ---
>  2 files changed, 20 insertions(+), 3 deletions(-)
>
> diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
> index f4a1c106cea..6caf7765ac6 100644
> --- a/gcc/fortran/gfortran.h
> +++ b/gcc/fortran/gfortran.h
> @@ -1944,7 +1944,27 @@ typedef struct gfc_symbol
>   according to the Fortran standard.  */
>unsigned pass_as_value:1;
>
> +  /* Reference counter, used for memory management.
> +
> + Some symbols may be present in more than one namespace, for example
> + function and subroutine symbols are present both in the outer namespace 
> and
> + the procedure body namespace.  Freeing symbols with the namespaces they 
> are
> + in would result in double free for those symbols.  This field counts
> + references and is used to delay the memory release until the last 
> reference
> + to the symbol is removed.
> +
> + Not every symbol pointer is accounted for reference counting.  Fields
> + gfc_symtree::n::sym are, and gfc_finalizer::proc_sym as well.  But most 
> of
> + them (dummy arguments, generic list elements, etc) are "weak" pointers;
> + the reference count isn't updated when they are assigned, and they are
> + ignored when the surrounding structure memory is released.  This is not 
> a
> + problem because there is always a namespace as surrounding context and
> + symbols have a name they can be referred with in that context, so the
> + namespace keeps the symbol from being freed, keeping the pointer valid.
> + When the namespace ceases to exist, and the symbols with it, the other
> + structures referencing symbols cease to exist as well.  */
>int refs;
> +
>struct gfc_namespace *ns;/* namespace containing this symbol */
>
>tree backend_decl;
> diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
> index 8f09ddf753c..58386805ffe 100644
> --- a/gcc/fortran/parse.cc
> +++ b/gcc/fortran/parse.cc
> @@ -4064,9 +4064,6 @@ loop:
>accept_statement (st);
>prog_unit = gfc_new_block;
>prog_unit->formal_ns = gfc_current_ns;
> -  if (prog_unit == prog_unit->formal_ns->proc_name
> -  && prog_unit->ns != prog_unit->formal_ns)
> -prog_unit->refs++;
>
>  decl:
>/* Read data declaration statements.  */
> --
> 2.40.1
>


Re: [PATCH] Fortran: improve bounds-checking for array sections [PR30802]

2023-09-15 Thread Paul Richard Thomas via Gcc-patches
Hi Harald,

The statement,

in array_bound_check_elemental is redundant since the call is
determined by a more restrictive condition.

+  if (!(gfc_option.rtcheck & GFC_RTCHECK_BOUNDS))
+return;

Apart from that, it looks good to me. OK for mainline.

Thanks for the patch.

Paul

On Thu, 14 Sept 2023 at 21:22, Harald Anlauf via Fortran
 wrote:
>
> Dear all,
>
> array bounds checking was missing a few cases of array sections
> that are handled via gfc_conv_expr_descriptor.  Bounds checking
> was done for the dimensions with ranges, but not for elemental
> dimensions.
>
> The attached patch implements that and fixes pr30802 and also
> pr97039, maybe a few more similar cases.
>
> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
>
> Thanks,
> Harald
>


[Patch/fortran] PR87477 [meta-bug] [F03] issues concerning the ASSOCIATE statement

2023-08-27 Thread Paul Richard Thomas via Gcc-patches
After two months on trunk, this has been backported:

Fortran: Fix some problems blocking associate meta-bug [PR87477]

2023-08-27  Paul Thomas  

gcc/fortran
PR fortran/87477
* parse.cc (parse_associate): Replace the existing evaluation
of the target rank with calls to gfc_resolve_ref and
gfc_expression_rank. Identify untyped target function results
with structure constructors by finding the appropriate derived
type.
* resolve.cc (resolve_symbol): Allow associate variables to be
assumed shape.

gcc/testsuite/
PR fortran/87477
* gfortran.dg/associate_54.f90 : Cope with extra error.

PR fortran/102109
* gfortran.dg/pr102109.f90 : New test.

PR fortran/102112
* gfortran.dg/pr102112.f90 : New test.

PR fortran/102190
* gfortran.dg/pr102190.f90 : New test.

PR fortran/102532
* gfortran.dg/pr102532.f90 : New test.

PR fortran/109948
* gfortran.dg/pr109948.f90 : New test.

PR fortran/99326
* gfortran.dg/pr99326.f90 : New test.

Regards

Paul


[Patch, fortran] PR92586 - ICE in gimplify_expr, at gimplify.c:13479 with nested allocatable derived types

2023-08-26 Thread Paul Richard Thomas via Gcc-patches
Committed as 'obvious'. 13-branch to follow.

commit r14-3501-g44bcb51eb0d5cac6eb2de54541ca8e6c2d738160
Author: Paul Thomas 
Date:   Sat Aug 26 14:37:49 2023 +0100

Fortran: Supply a missing dereference [PR92586]

2023-08-26  Paul Thomas  

gcc/fortran
PR fortran/92586
* trans-expr.cc (gfc_trans_arrayfunc_assign): Supply a missing
dereference for the call to gfc_deallocate_alloc_comp_no_caf.

gcc/testsuite/
PR fortran/92586
* gfortran.dg/pr92586.f90 : New test

Paul


Re: [PATCH] Fortran: implement vector sections in DATA statements [PR49588]

2023-08-22 Thread Paul Richard Thomas via Gcc-patches
Hi Harald,

It all looks good to me and does indeed make the code clearer. OK for trunk.

Thanks for the patch.

I was shocked to find that there are 217 older bugs than 49588. Does
anybody test older bugs to check if any of them have been fixed?

Paul

On Mon, 21 Aug 2023 at 20:48, Harald Anlauf via Fortran
 wrote:
>
> Dear all,
>
> the attached patch implements vector sections in DATA statements.
>
> The implementation is simpler than the size of the patch suggests,
> as part of changes try to clean up the existing code to make it
> easier to understand, as ordinary sections (start:end:stride)
> and vector sections may actually share some common code.
>
> The basisc idea of the implementation is that one needs a
> temporary vector that keeps track of the offsets into the
> array constructors for the indices in the array reference
> that are vectors.
>
> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
>
> Thanks,
> Harald
>


Re: [Patch, fortran] PR109684 - compiling failure: complaining about a final subroutine of a type being not PURE (while it is indeed PURE)

2023-08-09 Thread Paul Richard Thomas via Gcc-patches
I took a look at my calendar and decided to backport right away.

r13-7703-ged049e5d5f36cc0f4318cd93bb6b33ed6f6f2ba7

BTW It is a regression :-)

Paul

On Wed, 9 Aug 2023 at 12:10, Paul Richard Thomas
 wrote:
>
> Committed to trunk as 'obvious' in
> r14-3098-gb8ec3c952324f866f191883473922e250be81341
>
> 13-branch to follow in a few days.
>
> Paul


[Patch, fortran] PR109684 - compiling failure: complaining about a final subroutine of a type being not PURE (while it is indeed PURE)

2023-08-09 Thread Paul Richard Thomas via Gcc-patches
Committed to trunk as 'obvious' in
r14-3098-gb8ec3c952324f866f191883473922e250be81341

13-branch to follow in a few days.

Paul


Re: [PATCH] fortran: Release symbols in reversed order [PR106050]

2023-07-11 Thread Paul Richard Thomas via Gcc-patches
Hi Mikhail,

That's more than OK by me.

Thanks for attacking this PR.

I have a couple more of Steve's orphans waiting to be packaged up -
91960 and 104649. I'll submit them this evening.100607 is closed-fixed
and 103796 seems to be fixed.

Regards

Paul

On Tue, 11 Jul 2023 at 13:08, Mikael Morin via Fortran
 wrote:
>
> Hello,
>
> I saw the light regarding this PR after Paul posted a comment yesterday.
>
> Regression test in progress on x86_64-pc-linux-gnu.
> I plan to push in the next hours.
>
> Mikael
>
> -- >8 --
>
> Release symbols in reversed order wrt the order they were allocated.
> This fixes an error recovery ICE in the case of a misplaced
> derived type declaration.  Such a declaration creates nested
> symbols, one for the derived type and one for each type parameter,
> which should be immediately released as the declaration is
> rejected.  This breaks if the derived type is released first.
> As the type parameter symbols are in the namespace of the derived
> type, releasing the derived type releases the type parameters, so
> one can't access them after that, even to release them.  Hence,
> the type parameters should be released first.
>
> PR fortran/106050
>
> gcc/fortran/ChangeLog:
>
> * symbol.cc (gfc_restore_last_undo_checkpoint): Release symbols
> in reverse order.
>
> gcc/testsuite/ChangeLog:
>
> * gfortran.dg/pdt_33.f90: New test.
> ---
>  gcc/fortran/symbol.cc|  2 +-
>  gcc/testsuite/gfortran.dg/pdt_33.f90 | 15 +++
>  2 files changed, 16 insertions(+), 1 deletion(-)
>  create mode 100644 gcc/testsuite/gfortran.dg/pdt_33.f90
>
> diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
> index 37a9e8fa0ae..4a71d84b3fe 100644
> --- a/gcc/fortran/symbol.cc
> +++ b/gcc/fortran/symbol.cc
> @@ -3661,7 +3661,7 @@ gfc_restore_last_undo_checkpoint (void)
>gfc_symbol *p;
>unsigned i;
>
> -  FOR_EACH_VEC_ELT (latest_undo_chgset->syms, i, p)
> +  FOR_EACH_VEC_ELT_REVERSE (latest_undo_chgset->syms, i, p)
>  {
>/* Symbol in a common block was new. Or was old and just put in common 
> */
>if (p->common_block
> diff --git a/gcc/testsuite/gfortran.dg/pdt_33.f90 
> b/gcc/testsuite/gfortran.dg/pdt_33.f90
> new file mode 100644
> index 000..0521513f2f8
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/pdt_33.f90
> @@ -0,0 +1,15 @@
> +! { dg-do compile }
> +!
> +! PR fortran/106050
> +! The following used to trigger an error recovery ICE by releasing
> +! the symbol T before the symbol K which was leading to releasing
> +! K twice as it's in T's namespace.
> +!
> +! Contributed by G. Steinmetz 
> +
> +program p
> +   a = 1
> +   type t(k)  ! { dg-error "Unexpected derived type 
> declaration" }
> +  integer, kind :: k = 4  ! { dg-error "not allowed outside a TYPE 
> definition" }
> +   end type   ! { dg-error "Expecting END PROGRAM" }
> +end
> --
> 2.40.1
>


--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein


[Patch, fortran] Fix default type bugs in gfortran [PR99139, PR99368]

2023-07-08 Thread Paul Richard Thomas via Gcc-patches
The attached patch incorporates two of Steve's "Orphaned Patches" -
https://gcc.gnu.org/pipermail/fortran/2023-June/059423.html

They have in common that they both involve faults in use of default
type and that I was the ultimate cause of the bugs.

The patch regtests with the attached testcases.

I will commit in the next 24 hours unless there are any objections.

Paul

Fortran: Fix default type bugs in gfortran [PR99139, PR99368]

2023-07-08  Steve Kargl  

gcc/fortran
PR fortran/99139
PR fortran/99368
* match.cc (gfc_match_namelist): Check for host associated or
defined types before applying default type.
(gfc_match_select_rank): Apply default type to selector of
unlnown type if possible.
* resolve.cc (resolve_fl_variable): Do not apply local default
initialization to assumed rank entities.

gcc/testsuite/
PR fortran/999139
* gfortran.dg/pr99139.f90 : New test

PR fortran/99368
* gfortran.dg/pr99368.f90 : New test

Fortran: Fix default type bugs in gfortran [PR99139, PR99368]

2023-07-08  Steve Kargl  

gcc/fortran
PR fortran/99139
PR fortran/99368
* match.cc (gfc_match_namelist): Check for host associated or
defined types before applying default type.
(gfc_match_select_rank): Apply default type to selector of
unlnown type if possible.
* resolve.cc (resolve_fl_variable): Do not apply local default
initialization to assumed rank entities.

gcc/testsuite/
PR fortran/999139
* gfortran.dg/pr99139.f90 : New test

PR fortran/99368
* gfortran.dg/pr99368.f90 : New test
! { dg-do compile }
! { dg-options "-finit-local-zero" }
!
! Contributed by Gerhard Steinmetz  
!
! Original implicitly typed 'x' gave a bad symbol ICE
subroutine s1(x)
   target :: x(..)
   select rank (y => x)
   rank (1)
   rank (2)
   end select
end

! Comment #2: Failed with above option
subroutine s2(x, z)
   real, target :: x(..)
   real :: z(10)
   select rank (y => x) ! Error was:Assumed-rank variable y at (1) may only be
! used as actual argument
   rank (1)
   rank (2)
   end select
end
! { dg-do compile }
!
! Contributed by Gerhard Steinmetz  
!
program p
   type y ! { dg-error "Derived type" }
   end type
contains
   subroutine s1
  namelist /x/ y ! { dg-error "conflicts with namelist object" }
  character(3) y
   end
   subroutine s2
  namelist /z/ y ! { dg-error "conflicts with namelist object" }
  character(3) y
   end
enddiff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index ca64e59029e..a778bae0b9f 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -5622,10 +5622,32 @@ gfc_match_namelist (void)
 		  gfc_error_check ();
 		}
 	  else
-		/* If the type is not set already, we set it here to the
-		   implicit default type.  It is not allowed to set it
-		   later to any other type.  */
-		gfc_set_default_type (sym, 0, gfc_current_ns);
+		{
+		  /* Before the symbol is given an implicit type, check to
+		 see if the symbol is already available in the namespace,
+		 possibly through host association.  Importantly, the
+		 symbol may be a user defined type.  */
+
+		  gfc_symbol *tmp;
+
+		  gfc_find_symbol (sym->name, NULL, 1, );
+		  if (tmp
+		  && tmp->attr.generic
+		  && (tmp = gfc_find_dt_in_generic (tmp)))
+		{
+		  if (tmp->attr.flavor == FL_DERIVED)
+			{
+			  gfc_error ("Derived type %qs at %L conflicts with "
+ "namelist object %qs at %C",
+ tmp->name, >declared_at, sym->name);
+			  goto error;
+			}
+		}
+
+		  /* Set type of the symbol to its implicit default type.  It is
+		 not allowed to set it later to any other type.  */
+		  gfc_set_default_type (sym, 0, gfc_current_ns);
+		}
 	}
 	  if (sym->attr.in_namelist == 0
 	  && !gfc_add_in_namelist (>attr, sym->name, NULL))
@@ -6805,8 +6827,20 @@ gfc_match_select_rank (void)
 
   gfc_current_ns = gfc_build_block_ns (ns);
   m = gfc_match (" %n => %e", name, );
+
   if (m == MATCH_YES)
 {
+  /* If expr2 corresponds to an implicitly typed variable, then the
+	 actual type of the variable may not have been set.  Set it here.  */
+  if (!gfc_current_ns->seen_implicit_none
+	  && expr2->expr_type == EXPR_VARIABLE
+	  && expr2->ts.type == BT_UNKNOWN
+	  && expr2->symtree && expr2->symtree->n.sym)
+	{
+	  gfc_set_default_type (expr2->symtree->n.sym, 0, gfc_current_ns);
+	  expr2->ts.type = expr2->symtree->n.sym->ts.type;
+	}
+
   expr1 = gfc_get_expr ();
   expr1->expr_type = EXPR_VARIABLE;
   expr1->where = expr2->where;
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 8e018b6e7e8..f7cfdfc133f 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -13510,7 +13510,8 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
 	}
 }
 
-  if (sym->value == NULL && sym->attr.referenced)
+  if (sym->value == NULL && sym->attr.referenced
+  && !(sym->as && sym->as->type == AS_ASSUMED_RANK))
 apply_default_init_local (sym); /* Try to apply a default initialization.  */
 
   /* Determine if the 

Re: [PATCH] Fortran: simplification of FINDLOC for constant complex arguments [PR110585]

2023-07-08 Thread Paul Richard Thomas via Gcc-patches
Hi Harald,

This is indeed obvious :-)

Thanks for the patch.

Paul

On Fri, 7 Jul 2023 at 19:32, Harald Anlauf via Fortran
 wrote:
>
> Dear all,
>
> I intend to commit the attached obvious patch within 24h unless
> someone objects.  gfc_compare_expr() did not handle the case of
> complex constants, which may be compared for equality.  This
> case is needed in the simplification of the FINDLOC intrinsic.
>
> Regtested on x86_64-pc-linux-gnu.
>
> Thanks,
> Harald
>


-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein


Re: PR82943 - Suggested patch to fix

2023-06-30 Thread Paul Richard Thomas via Gcc-patches
Hi All,

I have gone through the PDT problem reports and made sure that they
block PR82173.

To my utter astonishment (i) There might be only one duplicate; and
(ii) Only 82649, 84119, 90218, 95541, 99079, 102901 & 105380 (out of
50 PRs) depend on the representation.

Regards

Paul


Re: PR82943 - Suggested patch to fix

2023-06-30 Thread Paul Richard Thomas via Gcc-patches
Hi Alexander,

I suggest that you take a look at PR82649 before going too far down
the road of fixing PDT bugs. This PR underlines just how wrong the PDT
representation is - mea culpa!

The mechanics for constructing PDTs are in
decl.cc(gfc_get_pdt_instance). They need to be turned inside out to
create a container, not unlike the class containers, with
{data-field(assumed rank array?), kind and len parameters}. This will
then trigger all manner of failures in trans-***.cc in particular.

It had been my intention to turn to PDTs after I complete my scourge
of associate construct bugs. If you want to take this on, please do so
and I will give you all the help that I can. You will see from PR82649
that I have been promising to get on to this for a long time but have
not had the time thus far :-( If you want to get on with parsing bugs
to start with, please be my guest!

I notice that searching for PDT in PR title lines generates 48 hits,
while the PDT meta-bug PR82173 only has 28 blockers. I will get on
with the housekeeping this weekend by updating PR82173 and eliminating
duplicates.

Welcome, Alexander!

Paul

On Fri, 30 Jun 2023 at 05:42, Steve Kargl via Fortran
 wrote:
>
> On Thu, Jun 29, 2023 at 10:38:42PM -0500, Alexander Westbrooks via Fortran 
> wrote:
> > I have finished my testing, and updated my patch and relevant Changelogs. I
> > added 4 new tests and all the existing tests in the current testsuite
> > for gfortran passed or failed as expected. Do I need to attach the test
> > results here?
>
> Yes.  It helps others also do testing to have one self-contained
> patch (which I don't know to generate with git and new files :-( ).
> It may also be a good idea to attach the patch and test cases to
> the PR in bugzilla so that they don't accidentally get lost.
>
> > The platform I tested on was a Docker container running in Docker Desktop,
> > running the "mcr.microsoft.com/devcontainers/universal:2-linux" image.
> >
> > I also made sure that my code changes followed the coding standards. Please
> > let me know if there is anything else that I need to do. I don't have
> > write-access to the repository.
>
> See the legal link that Harald provided.  At one time, one needed to
> assign copyright to the FSF with a wet-ink signature on some form.
> Now, I think you just need to attest that you have the right to
> provide the code to the gcc project.
>
> PS: Welcome to the gfortran development world.  Don't be put off
> if there is a delay in getting feedback/review.  There are too
> few contributors and too little time.   If a week passes simply
> ping the mailing list.  I'll try to carve out some time to look
> over your patch this weekend.
>
> --
> steve
>
>
> >
> > Thanks,
> >
> > Alexander
> >
> > On Wed, Jun 28, 2023 at 4:14 PM Harald Anlauf  wrote:
> >
> > > Hi Alex,
> > >
> > > welcome to the gfortran community.  It is great that you are trying
> > > to get actively involved.
> > >
> > > You already did quite a few things right: patches shall be sent to
> > > the gcc-patches ML, but Fortran reviewers usually notice them only
> > > where they are copied to the fortran ML.
> > >
> > > There are some general recommendations on the formatting of C code,
> > > like indentation, of the patches, and of the commit log entries.
> > >
> > > Regarding coding standards, see https://www.gnu.org/prep/standards/ .
> > >
> > > Regarding testcases, a recommendation is to have a look at
> > > existing testcases, e.g. in gcc/testsuite/gfortran.dg/, and then
> > > decide if the testcase shall test the compile-time or run-time
> > > behaviour, and add the necessary dejagnu directives.
> > >
> > > You should also verify if your patch passes regression testing.
> > > For changes to gfortran, it is usually sufficient to run
> > >
> > > make check-fortran -j 
> > >
> > > where  is the number of parallel tests.
> > > You would need to report also the platform where you tested on.
> > >
> > > There is also a legal issue to consider before non-trivial patches can
> > > be accepted for incorporation: https://gcc.gnu.org/contribute.html#legal
> > >
> > > If your patch is accepted and if you do not have write-access to the
> > > repository, one of the maintainers will likely take care of it.
> > > If you become a regular contributor, you will probably want to consider
> > > getting write access.
> > >
> > > Cheers,
> > > Harald
> > >
> > >
> > >
> > > On 6/24/23 19:17, Alexander Westbrooks via Gcc-patches wrote:
> > > > Hello,
> > > >
> > > > I am new to the GFortran community. Over the past two weeks I created a
> > > > patch that should fix PR82943 for GFortran. I have attached it to this
> > > > email. The patch allows the code below to compile successfully. I am
> > > > working on creating test cases next, but I am new to the process so it
> > > may
> > > > take me some time. After I make test cases, do I email them to you as
> > > well?
> > > > Do I need to make a pull-request on github in order to get the patch
> > > > 

Re: [Patch, fortran] PR49213 - [OOP] gfortran rejects structure constructor expression

2023-06-28 Thread Paul Richard Thomas via Gcc-patches
Hi Harald,

I'll change to gfc_charlen_type_node.

Thanks for your patience in reviewing this patch :-)

Cheers

Paul

On Tue, 27 Jun 2023 at 20:27, Harald Anlauf  wrote:
>
> Hi Paul,
>
> this is much better now.
>
> I have only a minor comment left: in the calculation of the
> size of a character string you are using an intermediate
> gfc_array_index_type, whereas I have learned to use
> gfc_charlen_type_node now, which seems like the natural
> type here.
>
> OK for trunk, and thanks for your patience!
>
> Harald
>
>
> On 6/27/23 12:30, Paul Richard Thomas via Gcc-patches wrote:
> > Hi Harald,
> >
> > Let's try again :-)
> >
> > OK for trunk?
> >
> > Regards
> >
> > Paul
> >
> > Fortran: Enable class expressions in structure constructors [PR49213]
> >
> > 2023-06-27  Paul Thomas  
> >
> > gcc/fortran
> > PR fortran/49213
> > * expr.cc (gfc_is_ptr_fcn): Remove reference to class_pointer.
> > * resolve.cc (resolve_assoc_var): Call gfc_is_ptr_fcn to allow
> > associate names with pointer function targets to be used in
> > variable definition context.
> > * trans-decl.cc (get_symbol_decl): Remove extraneous line.
> > * trans-expr.cc (alloc_scalar_allocatable_subcomponent): Obtain
> > size of intrinsic and character expressions.
> > (gfc_trans_subcomponent_assign): Expand assignment to class
> > components to include intrinsic and character expressions.
> >
> > gcc/testsuite/
> > PR fortran/49213
> > * gfortran.dg/pr49213.f90 : New test
> >
> > On Sat, 24 Jun 2023 at 20:50, Harald Anlauf  wrote:
> >>
> >> Hi Paul!
> >>
> >> On 6/24/23 15:18, Paul Richard Thomas via Gcc-patches wrote:
> >>> I have included the adjustment to 'gfc_is_ptr_fcn' and eliminating the
> >>> extra blank line, introduced by my last patch. I played safe and went
> >>> exclusively for class functions with attr.class_pointer set on the
> >>> grounds that these have had all the accoutrements checked and built
> >>> (ie. class_ok). I am still not sure if this is necessary or not.
> >>
> >> maybe it is my fault, but I find the version in the patch confusing:
> >>
> >> @@ -816,7 +816,7 @@ bool
> >>gfc_is_ptr_fcn (gfc_expr *e)
> >>{
> >>  return e != NULL && e->expr_type == EXPR_FUNCTION
> >> - && (gfc_expr_attr (e).pointer
> >> + && ((e->ts.type != BT_CLASS && gfc_expr_attr (e).pointer)
> >> || (e->ts.type == BT_CLASS
> >> && CLASS_DATA (e)->attr.class_pointer));
> >>}
> >>
> >> The caller 'gfc_is_ptr_fcn' has e->expr_type == EXPR_FUNCTION, so
> >> gfc_expr_attr (e) boils down to:
> >>
> >> if (e->value.function.esym && e->value.function.esym->result)
> >>  {
> >>gfc_symbol *sym = e->value.function.esym->result;
> >>attr = sym->attr;
> >>if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
> >>  {
> >>attr.dimension = CLASS_DATA (sym)->attr.dimension;
> >>attr.pointer = CLASS_DATA (sym)->attr.class_pointer;
> >>attr.allocatable = CLASS_DATA (sym)->attr.allocatable;
> >>  }
> >>  }
> >> ...
> >> else if (e->symtree)
> >>  attr = gfc_variable_attr (e, NULL);
> >>
> >> So I thought this should already do what you want if you do
> >>
> >> gfc_is_ptr_fcn (gfc_expr *e)
> >> {
> >> return e != NULL && e->expr_type == EXPR_FUNCTION && gfc_expr_attr
> >> (e).pointer;
> >> }
> >>
> >> or what am I missing?  The additional checks in gfc_expr_attr are
> >> there to avoid ICEs in case CLASS_DATA (sym) has issues, and we all
> >> know Gerhard who showed that he is an expert in exploiting this.
> >>
> >> To sum up, I'd prefer to use the safer form if it works.  If it
> >> doesn't, I would expect a latent issue.
> >>
> >> The rest of the code looked good to me, but I was suspicious about
> >> the handling of CHARACTER.
> >>
> >> Nasty as I am, I modified the testcase to use character(kind=4)
> >> instead of kind=1 (see attached).  This either fails here (stop 10),
> >> or if I activate the marked line
> >>
&

Re: [Patch, fortran] PR49213 - [OOP] gfortran rejects structure constructor expression

2023-06-27 Thread Paul Richard Thomas via Gcc-patches
Hi Harald,

Let's try again :-)

OK for trunk?

Regards

Paul

Fortran: Enable class expressions in structure constructors [PR49213]

2023-06-27  Paul Thomas  

gcc/fortran
PR fortran/49213
* expr.cc (gfc_is_ptr_fcn): Remove reference to class_pointer.
* resolve.cc (resolve_assoc_var): Call gfc_is_ptr_fcn to allow
associate names with pointer function targets to be used in
variable definition context.
* trans-decl.cc (get_symbol_decl): Remove extraneous line.
* trans-expr.cc (alloc_scalar_allocatable_subcomponent): Obtain
size of intrinsic and character expressions.
(gfc_trans_subcomponent_assign): Expand assignment to class
components to include intrinsic and character expressions.

gcc/testsuite/
PR fortran/49213
* gfortran.dg/pr49213.f90 : New test

On Sat, 24 Jun 2023 at 20:50, Harald Anlauf  wrote:
>
> Hi Paul!
>
> On 6/24/23 15:18, Paul Richard Thomas via Gcc-patches wrote:
> > I have included the adjustment to 'gfc_is_ptr_fcn' and eliminating the
> > extra blank line, introduced by my last patch. I played safe and went
> > exclusively for class functions with attr.class_pointer set on the
> > grounds that these have had all the accoutrements checked and built
> > (ie. class_ok). I am still not sure if this is necessary or not.
>
> maybe it is my fault, but I find the version in the patch confusing:
>
> @@ -816,7 +816,7 @@ bool
>   gfc_is_ptr_fcn (gfc_expr *e)
>   {
> return e != NULL && e->expr_type == EXPR_FUNCTION
> - && (gfc_expr_attr (e).pointer
> + && ((e->ts.type != BT_CLASS && gfc_expr_attr (e).pointer)
>|| (e->ts.type == BT_CLASS
>&& CLASS_DATA (e)->attr.class_pointer));
>   }
>
> The caller 'gfc_is_ptr_fcn' has e->expr_type == EXPR_FUNCTION, so
> gfc_expr_attr (e) boils down to:
>
>if (e->value.function.esym && e->value.function.esym->result)
> {
>   gfc_symbol *sym = e->value.function.esym->result;
>   attr = sym->attr;
>   if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
> {
>   attr.dimension = CLASS_DATA (sym)->attr.dimension;
>   attr.pointer = CLASS_DATA (sym)->attr.class_pointer;
>   attr.allocatable = CLASS_DATA (sym)->attr.allocatable;
> }
> }
> ...
>else if (e->symtree)
> attr = gfc_variable_attr (e, NULL);
>
> So I thought this should already do what you want if you do
>
> gfc_is_ptr_fcn (gfc_expr *e)
> {
>return e != NULL && e->expr_type == EXPR_FUNCTION && gfc_expr_attr
> (e).pointer;
> }
>
> or what am I missing?  The additional checks in gfc_expr_attr are
> there to avoid ICEs in case CLASS_DATA (sym) has issues, and we all
> know Gerhard who showed that he is an expert in exploiting this.
>
> To sum up, I'd prefer to use the safer form if it works.  If it
> doesn't, I would expect a latent issue.
>
> The rest of the code looked good to me, but I was suspicious about
> the handling of CHARACTER.
>
> Nasty as I am, I modified the testcase to use character(kind=4)
> instead of kind=1 (see attached).  This either fails here (stop 10),
> or if I activate the marked line
>
> !cont = tContainer('hello!')   ! ### ICE! ###
>
> I get an ICE.
>
> Can you have another look?
>
> Thanks,
> Harald
>
> >
>
> > OK for trunk?
> >
> > Paul
> >
> > Fortran: Enable class expressions in structure constructors [PR49213]
> >
> > 2023-06-24  Paul Thomas  
> >
> > gcc/fortran
> > PR fortran/49213
> > * expr.cc (gfc_is_ptr_fcn): Guard pointer attribute to exclude
> > class expressions.
> > * resolve.cc (resolve_assoc_var): Call gfc_is_ptr_fcn to allow
> > associate names with pointer function targets to be used in
> > variable definition context.
> > * trans-decl.cc (get_symbol_decl): Remove extraneous line.
> > * trans-expr.cc (alloc_scalar_allocatable_subcomponent): Obtain
> > size of intrinsic and character expressions.
> > (gfc_trans_subcomponent_assign): Expand assignment to class
> > components to include intrinsic and character expressions.
> >
> > gcc/testsuite/
> > PR fortran/49213
> > * gfortran.dg/pr49213.f90 : New test



-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
! { dg-do run }
!
! Contributed by Neil Carlson  
!
program main
  character(2) :: c

  type :: S
integer :: n
  end type
  type(S) :: Sobj

  type, extends(S) :: S2
integer :: m
  end type
  type(S2) :: S2obj

  type :: T
class(S), allocatable :: x
  en

[Patch, fortran] PR49213 - [OOP] gfortran rejects structure constructor expression

2023-06-24 Thread Paul Richard Thomas via Gcc-patches
Hi All,

I was looking through Neil Carlson's collection of gfortran bugs and
was shocked to find this rather fundamental PR. At 12 years old, it is
certainly a "golden oldie"!

The patch is rather straightforward and seems to do the job of
admitting derived, intrinsic and character expressions to allocatable
class components in structure constructors.

I have included the adjustment to 'gfc_is_ptr_fcn' and eliminating the
extra blank line, introduced by my last patch. I played safe and went
exclusively for class functions with attr.class_pointer set on the
grounds that these have had all the accoutrements checked and built
(ie. class_ok). I am still not sure if this is necessary or not.

OK for trunk?

Paul

Fortran: Enable class expressions in structure constructors [PR49213]

2023-06-24  Paul Thomas  

gcc/fortran
PR fortran/49213
* expr.cc (gfc_is_ptr_fcn): Guard pointer attribute to exclude
class expressions.
* resolve.cc (resolve_assoc_var): Call gfc_is_ptr_fcn to allow
associate names with pointer function targets to be used in
variable definition context.
* trans-decl.cc (get_symbol_decl): Remove extraneous line.
* trans-expr.cc (alloc_scalar_allocatable_subcomponent): Obtain
size of intrinsic and character expressions.
(gfc_trans_subcomponent_assign): Expand assignment to class
components to include intrinsic and character expressions.

gcc/testsuite/
PR fortran/49213
* gfortran.dg/pr49213.f90 : New test
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index c960dfeabd9..92061d69781 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -816,7 +816,7 @@ bool
 gfc_is_ptr_fcn (gfc_expr *e)
 {
   return e != NULL && e->expr_type == EXPR_FUNCTION
-	  && (gfc_expr_attr (e).pointer
+	  && ((e->ts.type != BT_CLASS && gfc_expr_attr (e).pointer)
 		  || (e->ts.type == BT_CLASS
 		  && CLASS_DATA (e)->attr.class_pointer));
 }
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 82e6ac53aa1..217d69d4e0b 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -1350,6 +1350,9 @@ resolve_structure_cons (gfc_expr *expr, int init)
 	  && CLASS_DATA (comp)->as)
  	rank = CLASS_DATA (comp)->as->rank;
 
+  if (comp->ts.type == BT_CLASS && cons->expr->ts.type == BT_DERIVED)
+	  gfc_find_derived_vtab (cons->expr->ts.u.derived);
+
   if (cons->expr->expr_type != EXPR_NULL && rank != cons->expr->rank
 	  && (comp->attr.allocatable || cons->expr->rank))
 	{
@@ -1381,7 +1384,7 @@ resolve_structure_cons (gfc_expr *expr, int init)
 			 gfc_basic_typename (comp->ts.type));
 	  t = false;
 	}
-	  else
+	  else if (!UNLIMITED_POLY (comp))
 	{
 	  bool t2 = gfc_convert_type (cons->expr, >ts, 1);
 	  if (t)
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 18589e17843..b0fd25e92a3 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1915,7 +1915,6 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	gcc_assert (!sym->value || sym->value->expr_type == EXPR_NULL);
 }
 
-
   gfc_finish_var_decl (decl, sym);
 
   if (sym->ts.type == BT_CHARACTER)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 3c209bcde97..5a1ff0c1d21 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -8781,6 +8781,7 @@ alloc_scalar_allocatable_subcomponent (stmtblock_t *block, tree comp,
   tree size;
   tree size_in_bytes;
   tree lhs_cl_size = NULL_TREE;
+  gfc_se se;
 
   if (!comp)
 return;
@@ -8815,16 +8816,26 @@ alloc_scalar_allocatable_subcomponent (stmtblock_t *block, tree comp,
 }
   else if (cm->ts.type == BT_CLASS)
 {
-  gcc_assert (expr2->ts.type == BT_CLASS || expr2->ts.type == BT_DERIVED);
-  if (expr2->ts.type == BT_DERIVED)
+  if (expr2->ts.type != BT_CLASS)
 	{
-	  tmp = gfc_get_symbol_decl (expr2->ts.u.derived);
-	  size = TYPE_SIZE_UNIT (tmp);
+	  if (expr2->ts.type == BT_CHARACTER)
+	{
+	  gfc_init_se (, NULL);
+	  gfc_conv_expr (, expr2);
+	  size = fold_convert (size_type_node, se.string_length);
+	}
+	  else
+	{
+	  if (expr2->ts.type == BT_DERIVED)
+		tmp = gfc_get_symbol_decl (expr2->ts.u.derived);
+	  else
+		tmp = gfc_typenode_for_spec (>ts);
+	  size = TYPE_SIZE_UNIT (tmp);
+	}
 	}
   else
 	{
 	  gfc_expr *e2vtab;
-	  gfc_se se;
 	  e2vtab = gfc_find_and_cut_at_last_class_ref (expr2);
 	  gfc_add_vptr_component (e2vtab);
 	  gfc_add_size_component (e2vtab);
@@ -8975,6 +8986,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm,
 {
   gfc_init_se (, NULL);
   gfc_conv_expr (, expr);
+  tree size;
 
   /* Take care about non-array allocatable components here.  The alloc_*
 	 routine below is motivated by the alloc_scalar_allocatable_for_
@@ -8990,7 +9002,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm,
 	  && expr->symtree->n.sym->attr.dummy)
 	se.expr = build_fold_indirect_ref_loc (input_location, se.expr);
 
-  if (cm->ts.type == BT_CLASS && 

Re: [Patch, fortran] PR107900 Select type with intrinsic type inside associate causes ICE / Segmenation fault

2023-06-22 Thread Paul Richard Thomas via Gcc-patches
Hi Both,

> while I only had a minor question regarding gfc_is_ptr_fcn(),
> can you still try to enlighten me why that second part
> was necessary?  (I believed it to be redundant and may have
> overlooked the obvious.)

Blast! I forgot about checking that. Lurking in the back of my mind
and going back to the first days of OOP in gfortran is a distinction
between a class entity with the pointer attribute and one whose data
component has the class_pointer attribute. I'll check it out and do
whatever is needed.


> > +  else if (context && gfc_is_ptr_fcn (assoc->target))
> > + {
> > +   if (!gfc_notify_std (GFC_STD_F2018, "%qs at %L associated to "
> > +"pointer function target being used in a "
> > +"variable definition context (%s)", name,
> > +>where, context))
>
> I'm curious why you decided to put context in braces and not simply use
> quotes as per %qs?

That's the way it's done in the preceding errors. I had to keep the
context in context, so to speak.

> > +/* Build the associate name  */
> > +static int
> > +build_associate_name (const char *name, gfc_expr **e1, gfc_expr **e2)
> > +{
>
> > +return 1;
>
> > +  return 0;
> > +}
>
> I've gone through the frontend recently and changed several such
> boolean functions to use bool where appropriate. May i ask folks to use
> narrower types in new code, please?
> Iff later in the pipeline it is considered appropriate or benefical to
> promote types, these will eventually be promoted.
>
> > diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
> > index e6a4337c0d2..18589e17843 100644
> > --- a/gcc/fortran/trans-decl.cc
> > +++ b/gcc/fortran/trans-decl.cc
>
> > @@ -1906,6 +1915,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
> >   gcc_assert (!sym->value || sym->value->expr_type == EXPR_NULL);
> >  }
> >
> > +
>

'twas accidental. There had previously been another version of the fix
that I commented out and the extra line crept in when I deleted it.
Thanks for the spot.

>
> Please kindly excuse my comment and, again, thanks!
>
> >gfc_finish_var_decl (decl, sym);
> >
> >if (sym->ts.type == BT_CHARACTER)

Regards

Paul


Re: [Patch, fortran] PR107900 Select type with intrinsic type inside associate causes ICE / Segmenation fault

2023-06-21 Thread Paul Richard Thomas via Gcc-patches
Committed as r14-2022-g577223aebc7acdd31e62b33c1682fe54a622ae27

Thanks for the help and the review Harald. Thanks to Steve too for
picking up Neil Carlson's bugs.

Cheers

Paul

On Tue, 20 Jun 2023 at 22:57, Harald Anlauf  wrote:
>
> Hi Paul,
>
> On 6/20/23 12:54, Paul Richard Thomas via Gcc-patches wrote:
> > Hi Harald,
> >
> > Fixing the original testcase in this PR turned out to be slightly more
> > involved than I expected. However, it resulted in an open door to fix
> > some other PRs and the attached much larger patch.
> >
> > This time, I did remember to include the testcases in the .diff :-)
>
> indeed! :-)
>
> I've only had a superficial look so far although it looks very good.
> (I have to trust your experience with unlimited polymorphism.)
>
> However, I was wondering about the following helper function:
>
> +bool
> +gfc_is_ptr_fcn (gfc_expr *e)
> +{
> +  return e != NULL && e->expr_type == EXPR_FUNCTION
> + && (gfc_expr_attr (e).pointer
> + || (e->ts.type == BT_CLASS
> + && CLASS_DATA (e)->attr.class_pointer));
> +}
> +
> +
>   /* Copy a shape array.  */
>
> Is there a case where gfc_expr_attr (e).pointer returns false
> and you really need the || part?  Looking at gfc_expr_attr
> and the present context, it might just not be necessary.
>
> > I believe that, between the Change.Logs and the comments, it is
> > reasonably self-explanatory.
> >
> > OK for trunk?
>
> OK from my side.
>
> Thanks for the patch!
>
> Harald
>
> > Regards
> >
> > Paul
> >
> > Fortran: Fix some bugs in associate [PR87477]
> >
> > 2023-06-20  Paul Thomas  
> >
> > gcc/fortran
> > PR fortran/87477
> > PR fortran/88688
> > PR fortran/94380
> > PR fortran/107900
> > PR fortran/110224
> > * decl.cc (char_len_param_value): Fix memory leak.
> > (resolve_block_construct): Remove unnecessary static decls.
> > * expr.cc (gfc_is_ptr_fcn): New function.
> > (gfc_check_vardef_context): Use it to permit pointer function
> > result selectors to be used for associate names in variable
> > definition context.
> > * gfortran.h: Prototype for gfc_is_ptr_fcn.
> > * match.cc (build_associate_name): New function.
> > (gfc_match_select_type): Use the new function to replace inline
> > version and to build a new associate name for the case where
> > the supplied associate name is already used for that purpose.
> > * resolve.cc (resolve_assoc_var): Call gfc_is_ptr_fcn to allow
> > associate names with pointer function targets to be used in
> > variable definition context.
> > * trans-decl.cc (gfc_get_symbol_decl): Unlimited polymorphic
> > variables need deferred initialisation of the vptr.
> > (gfc_trans_deferred_vars): Do the vptr initialisation.
> > * trans-stmt.cc (trans_associate_var): Ensure that a pointer
> > associate name points to the target of the selector and not
> > the selector itself.
> >
> > gcc/testsuite/
> > PR fortran/87477
> > PR fortran/107900
> > * gfortran.dg/pr107900.f90 : New test
> >
> > PR fortran/110224
> > * gfortran.dg/pr110224.f90 : New test
> >
> > PR fortran/88688
> > * gfortran.dg/pr88688.f90 : New test
> >
> > PR fortran/94380
> > * gfortran.dg/pr94380.f90 : New test
> >
> > PR fortran/95398
> > * gfortran.dg/pr95398.f90 : Set -std=f2008, bump the line
> > numbers in the error tests by two and change the text in two.
>


-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein


Re: [Patch, fortran] PR108961 - Segfault when associating to pointer from C_F_POINTER

2023-06-21 Thread Paul Richard Thomas via Gcc-patches
Committed as r14-2021-gcaf0892eea67349d9a1e44590c3440768136fe2b

Thanks for the pointers, Tobias and Mikael, I used them both.

Paul

On Tue, 20 Jun 2023 at 21:47, Mikael Morin  wrote:
>
> Le 20/06/2023 à 18:30, Tobias Burnus a écrit :
> > On 20.06.23 18:19, Paul Richard Thomas via Fortran wrote:
> >
> >> Is there a better way to detect a type(c_ptr) formal argument?
> > u.derived->intmod_sym_id == ISOCBINDING_PTR ?
> && u.derived->from_intmod == INTMOD_ISO_C_BINDING ?
>


-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein


[Patch, fortran] PR108961 - Segfault when associating to pointer from C_F_POINTER

2023-06-20 Thread Paul Richard Thomas via Gcc-patches
Dear All,

This patch is verging on obvious. The PR was originally, incorrectly
blocking PR87477 and the testcase has remained in my 'associate'
directory. I thought that it is time to get shot of it!

Is there a better way to detect a type(c_ptr) formal argument?

Subject to advice on the question, OK for trunk?

Paul
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 45a984b6bdb..0823efd5abc 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -7353,6 +7353,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	 need the length.  */
   if (parmse.string_length != NULL_TREE
 	  && !sym->attr.is_bind_c
+	  && !(fsym && fsym->ts.type == BT_DERIVED
+	   && !strcmp (fsym->ts.u.derived->name, "c_ptr"))
 	  && !(fsym && UNLIMITED_POLY (fsym)))
 	vec_safe_push (stringargs, parmse.string_length);
 


Change.Logs
Description: Binary data
! { dg-do run }
!
! Contributed by Jeffrey Hill  
!
module associate_ptr
use iso_c_binding
contains
subroutine c_f_strpointer(cptr, ptr2)
type(c_ptr), target, intent(in) :: cptr
character(kind=c_char,len=4), pointer :: ptr1
character(kind=c_char,len=:), pointer, intent(out) :: ptr2
call c_f_pointer(cptr, ptr1)
if (ptr1 .ne. 'abcd') stop 1
ptr2 => ptr1  ! Failed here
end subroutine
end module

program test_associate_ptr
use associate_ptr
character(kind=c_char, len=1), target :: char_array(7)
character(kind=c_char,len=:), pointer :: ptr2
char_array = ['a', 'b', 'c', 'd', c_null_char, 'e', 'f']
! The first argument was providing a constant hidden string length => segfault
call c_f_strpointer(c_loc(char_array), ptr2)
if (ptr2 .ne. 'abcd') stop 2
end program


Re: [Patch] Fortran's gfc_match_char: %S to match symbol with host_assoc

2023-06-20 Thread Paul Richard Thomas via Gcc-patches
Hi Tobias,

This looks good to me. I'm interested to see it in use :-)

OK for trunk

Paul

On Tue, 20 Jun 2023 at 11:50, Tobias Burnus  wrote:
>
> When just matching a symbol, one can use 'gfc_match_symbol (, host_assoc)'
> and has the option to match with and without host association.
>
> However, when matching something more complex via 'gfc_match' like
> "something ( %s ) , " the match uses host_assoc = false.
> While it can be combined ("something (" + symbol + " ) ,"), this requires
> keeping track of the previous location and resetting it.
>
> It seems to be much simply to add a new flag supporting host_assoc = true,
> which this patch does (using '%S'). The advantage is also that when looking
> at the comment or at the "%s" implementation, it is clear that there are two
> variants, making it less likely to choose the wrong matching.
>
> OK for mainline?
>
> Tobias
>
> PS: I will use it in an upcoming OpenMP to parse 'uses_allocators'.
> -
> Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 
> München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas 
> Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht 
> München, HRB 106955



-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein


Re: [Patch, fortran] PR107900 Select type with intrinsic type inside associate causes ICE / Segmenation fault

2023-06-20 Thread Paul Richard Thomas via Gcc-patches
Hi Harald,

Fixing the original testcase in this PR turned out to be slightly more
involved than I expected. However, it resulted in an open door to fix
some other PRs and the attached much larger patch.

This time, I did remember to include the testcases in the .diff :-)

I believe that, between the Change.Logs and the comments, it is
reasonably self-explanatory.

OK for trunk?

Regards

Paul

Fortran: Fix some bugs in associate [PR87477]

2023-06-20  Paul Thomas  

gcc/fortran
PR fortran/87477
PR fortran/88688
PR fortran/94380
PR fortran/107900
PR fortran/110224
* decl.cc (char_len_param_value): Fix memory leak.
(resolve_block_construct): Remove unnecessary static decls.
* expr.cc (gfc_is_ptr_fcn): New function.
(gfc_check_vardef_context): Use it to permit pointer function
result selectors to be used for associate names in variable
definition context.
* gfortran.h: Prototype for gfc_is_ptr_fcn.
* match.cc (build_associate_name): New function.
(gfc_match_select_type): Use the new function to replace inline
version and to build a new associate name for the case where
the supplied associate name is already used for that purpose.
* resolve.cc (resolve_assoc_var): Call gfc_is_ptr_fcn to allow
associate names with pointer function targets to be used in
variable definition context.
* trans-decl.cc (gfc_get_symbol_decl): Unlimited polymorphic
variables need deferred initialisation of the vptr.
(gfc_trans_deferred_vars): Do the vptr initialisation.
* trans-stmt.cc (trans_associate_var): Ensure that a pointer
associate name points to the target of the selector and not
the selector itself.

gcc/testsuite/
PR fortran/87477
PR fortran/107900
* gfortran.dg/pr107900.f90 : New test

PR fortran/110224
* gfortran.dg/pr110224.f90 : New test

PR fortran/88688
* gfortran.dg/pr88688.f90 : New test

PR fortran/94380
* gfortran.dg/pr94380.f90 : New test

PR fortran/95398
* gfortran.dg/pr95398.f90 : Set -std=f2008, bump the line
numbers in the error tests by two and change the text in two.
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index d09c8bc97d9..844345df77e 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -1086,6 +1086,8 @@ char_len_param_value (gfc_expr **expr, bool *deferred)
   p = gfc_copy_expr (*expr);
   if (gfc_is_constant_expr (p) && gfc_simplify_expr (p, 1))
 gfc_replace_expr (*expr, p);
+  else
+gfc_free_expr (p);

   if ((*expr)->expr_type == EXPR_FUNCTION)
 {
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index d5cfbe0cc55..c960dfeabd9 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -812,6 +812,16 @@ gfc_has_vector_index (gfc_expr *e)
 }


+bool
+gfc_is_ptr_fcn (gfc_expr *e)
+{
+  return e != NULL && e->expr_type == EXPR_FUNCTION
+	  && (gfc_expr_attr (e).pointer
+		  || (e->ts.type == BT_CLASS
+		  && CLASS_DATA (e)->attr.class_pointer));
+}
+
+
 /* Copy a shape array.  */

 mpz_t *
@@ -6470,6 +6480,22 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
 	}
 	  return false;
 	}
+  else if (context && gfc_is_ptr_fcn (assoc->target))
+	{
+	  if (!gfc_notify_std (GFC_STD_F2018, "%qs at %L associated to "
+			   "pointer function target being used in a "
+			   "variable definition context (%s)", name,
+			   >where, context))
+	return false;
+	  else if (gfc_has_vector_index (e))
+	{
+	  gfc_error ("%qs at %L associated to vector-indexed target"
+			 " cannot be used in a variable definition"
+			 " context (%s)",
+			 name, >where, context);
+	  return false;
+	}
+	}

   /* Target must be allowed to appear in a variable definition context.  */
   if (!gfc_check_vardef_context (assoc->target, pointer, false, false, NULL))
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index a58c60e9828..30631abd788 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3659,6 +3659,7 @@ bool gfc_is_constant_expr (gfc_expr *);
 bool gfc_simplify_expr (gfc_expr *, int);
 bool gfc_try_simplify_expr (gfc_expr *, int);
 bool gfc_has_vector_index (gfc_expr *);
+bool gfc_is_ptr_fcn (gfc_expr *);

 gfc_expr *gfc_get_expr (void);
 gfc_expr *gfc_get_array_expr (bt type, int kind, locus *);
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index e7be7fddc64..0e4b5440393 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -6377,6 +6377,39 @@ build_class_sym:
 }


+/* Build the associate name  */
+static int
+build_associate_name (const char *name, gfc_expr **e1, gfc_expr **e2)
+{
+  gfc_expr *expr1 = *e1;
+  gfc_expr *expr2 = *e2;
+  gfc_symbol *sym;
+
+  /* For the case where the associate name is already an associate name.  */
+  if (!expr2)
+expr2 = expr1;
+  expr1 = gfc_get_expr ();
+  expr1->expr_type = EXPR_VARIABLE;
+  expr1->where = expr2->where;
+  if (gfc_get_sym_tree (name, NULL, >symtree, false))
+return 1;
+
+  sym = expr1->symtree->n.sym;
+  if (expr2->ts.type == BT_UNKNOWN)
+  sym->attr.untyped = 1;
+  else
+  

[Patch, fortran] PR107900 Select type with intrinsic type inside associate causes ICE / Segmenation fault

2023-06-17 Thread Paul Richard Thomas via Gcc-patches
Hi All,

The attached patch is amply described by the comments and the
changelog. It also includes the fix for the memory leak in decl.cc, as
promised some days ago.

OK for trunk?

Regards

Paul

PS This leaves 89645 and 99065 as the only real blockers to PR87477.
These will take a little while to fix. They come about because the
type of the associate name is determined by that of a derived type
function that hasn't been parsed at the time that component references
are being parsed. If the order of the contained procedures is
reversed, both test cases compile correctly. The fix will comprise
matching the component name to the accessible derived types, while
keeping track of all the references in case the match is ambiguous and
has to be fixed up later.


Change107900.Logs
Description: Binary data
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index d09c8bc97d9..844345df77e 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -1086,6 +1086,8 @@ char_len_param_value (gfc_expr **expr, bool *deferred)
   p = gfc_copy_expr (*expr);
   if (gfc_is_constant_expr (p) && gfc_simplify_expr (p, 1))
 gfc_replace_expr (*expr, p);
+  else
+gfc_free_expr (p);
 
   if ((*expr)->expr_type == EXPR_FUNCTION)
 {
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index e6a4337c0d2..ab5f94e9f03 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1875,6 +1875,13 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	  && !(sym->attr.use_assoc && !intrinsic_array_parameter)))
 gfc_defer_symbol_init (sym);
 
+  /* Nullify so that select type doesn't fall over if the variable
+ is not associated.  */
+  if (sym->ts.type == BT_CLASS && UNLIMITED_POLY (sym)
+  && sym->attr.flavor == FL_VARIABLE && !sym->assoc
+  && !sym->attr.dummy && CLASS_DATA (sym)->attr.class_pointer)
+gfc_defer_symbol_init (sym);
+
   if (sym->ts.type == BT_CHARACTER
   && sym->attr.allocatable
   && !sym->attr.dimension
@@ -1906,6 +1913,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	gcc_assert (!sym->value || sym->value->expr_type == EXPR_NULL);
 }
 
+
   gfc_finish_var_decl (decl, sym);
 
   if (sym->ts.type == BT_CHARACTER)
@@ -4652,6 +4660,21 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
   if (sym->assoc)
 	continue;
 
+  /* Nullify unlimited polymorphic variables so that they do not cause
+	 segfaults in select type, when the selector is an intrinsic type.  */
+  if (sym->ts.type == BT_CLASS && UNLIMITED_POLY (sym)
+	  && sym->attr.flavor == FL_VARIABLE && !sym->assoc
+	  && !sym->attr.dummy && CLASS_DATA (sym)->attr.class_pointer)
+	{
+	  gfc_expr *lhs = gfc_lval_expr_from_sym (sym);
+	  gfc_expr *rhs = gfc_get_null_expr (NULL);
+	  tmp = gfc_trans_pointer_assignment (lhs, rhs);
+	  gfc_init_block ();
+	  gfc_add_expr_to_block (, tmp);
+	  gfc_add_init_cleanup (block, gfc_finish_block (), NULL);
+	  continue;
+	}
+
   if (sym->ts.type == BT_DERIVED
 	  && sym->ts.u.derived
 	  && sym->ts.u.derived->attr.pdt_type)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 45a984b6bdb..eeae13998a3 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -10034,6 +10034,19 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
 			build_zero_cst (TREE_TYPE (lse.string_length)));
 	}
 
+  /* Unlimited polymorphic arrays, nullified in gfc_trans_deferred_vars,
+ arrive here as a scalar expr. Find the descriptor data field.  */
+  if (expr1->ts.type == BT_CLASS && UNLIMITED_POLY (expr1)
+	  && expr2->expr_type == EXPR_NULL
+	  && !expr1->ref && !expr1->rank
+	  && (CLASS_DATA (expr1)->attr.dimension
+	  || CLASS_DATA (expr1)->attr.codimension))
+	{
+	  lse.expr = gfc_get_class_from_expr (lse.expr);
+	  lse.expr = gfc_class_data_get (lse.expr);
+	  lse.expr = gfc_conv_descriptor_data_get (lse.expr);
+	}
+
   gfc_add_modify (, lse.expr,
 		  fold_convert (TREE_TYPE (lse.expr), rse.expr));
 


Re: [Patch, fortran] PR87477 - (associate) - [meta-bug] [F03] issues concerning the ASSOCIATE statement

2023-06-08 Thread Paul Richard Thomas via Gcc-patches
Thanks Gents!

The solution is to gfc_free_expr (p) if the replacement is not made.

I am regtesting a patch for PR107900. I'll include the fix for the
memory leak in the patch for that.

Cheers

Paul


On Thu, 8 Jun 2023 at 09:30, Harald Anlauf  wrote:
>
> On 6/8/23 09:46, Mikael Morin wrote:
> > Le 08/06/2023 à 07:57, Paul Richard Thomas via Fortran a écrit :
> >> Hi Harald,
> >>
> >> In answer to your question:
> >> void
> >> gfc_replace_expr (gfc_expr *dest, gfc_expr *src)
> >> {
> >>free_expr0 (dest);
> >>*dest = *src;
> >>free (src);
> >> }
> >> So it does indeed do the job.
> >>
> > Sure, but his comment was about the case gfc_replace_expr is *not*
> > executed.
>
> Right.  The following legal code exhibits the leak, pointing
> to the gfc_copy_expr:
>
> subroutine paul (n)
>integer  :: n
>character(n) :: c
> end
>
> >> I should perhaps have remarked that, following the divide error,
> >> gfc_simplify_expr was returning a mutilated version of the expression
> >> and this was somehow connected with successfully simplifying the
> >> parentheses. Copying and replacing on no errors deals with the
> >> problem.
> >>
> > Is the expression mutilated enough that it can't be safely freed?
> >
> >
> >
>


-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein


Re: [Patch, fortran] PR87477 - (associate) - [meta-bug] [F03] issues concerning the ASSOCIATE statement

2023-06-07 Thread Paul Richard Thomas via Gcc-patches
Hi Harald,

In answer to your question:
void
gfc_replace_expr (gfc_expr *dest, gfc_expr *src)
{
  free_expr0 (dest);
  *dest = *src;
  free (src);
}
So it does indeed do the job.

I should perhaps have remarked that, following the divide error,
gfc_simplify_expr was returning a mutilated version of the expression
and this was somehow connected with successfully simplifying the
parentheses. Copying and replacing on no errors deals with the
problem.

Thanks

Paul

On Wed, 7 Jun 2023 at 19:38, Harald Anlauf  wrote:
>
> Hi Paul!
>
> On 6/7/23 18:10, Paul Richard Thomas via Gcc-patches wrote:
> > Hi All,
> >
> > Three more fixes for PR87477. Please note that PR99350 was a blocker
> > but, as pointed out in comment #5 of the PR, this has nothing to do
> > with the associate construct.
> >
> > All three fixes are straight forward and the .diff + ChangeLog suffice
> > to explain them. 'rankguessed' was made redundant by the last PR87477
> > fix.
> >
> > Regtests on x86_64 - good for mainline?
> >
> > Paul
> >
> > Fortran: Fix some more blockers in associate meta-bug [PR87477]
> >
> > 2023-06-07  Paul Thomas  
> >
> > gcc/fortran
> > PR fortran/99350
> > * decl.cc (char_len_param_value): Simplify a copy of the expr
> > and replace the original if there is no error.
>
> This seems to lack a gfc_free_expr (p) in case the gfc_replace_expr
> is not executed, leading to a possible memleak.  Can you check?
>
> @@ -1081,10 +1082,10 @@ char_len_param_value (gfc_expr **expr, bool
> *deferred)
> if (!gfc_expr_check_typed (*expr, gfc_current_ns, false))
>   return MATCH_ERROR;
>
> -  /* If gfortran gets an EXPR_OP, try to simplify it.  This catches things
> - like CHARACTER(([1])).   */
> -  if ((*expr)->expr_type == EXPR_OP)
> -gfc_simplify_expr (*expr, 1);
> +  /* Try to simplify the expression to catch things like
> CHARACTER(([1])).   */
> +  p = gfc_copy_expr (*expr);
> +  if (gfc_is_constant_expr (p) && gfc_simplify_expr (p, 1))
> +gfc_replace_expr (*expr, p);
> else
>   gfc_free_expr (p);
>
> > * gfortran.h : Remove the redundant field 'rankguessed' from
> > 'gfc_association_list'.
> > * resolve.cc (resolve_assoc_var): Remove refs to 'rankguessed'.
> >
> > PR fortran/107281
> > * resolve.cc (resolve_variable): Associate names with constant
> > or structure constructor targets cannot have array refs.
> >
> > PR fortran/109451
> > * trans-array.cc (gfc_conv_expr_descriptor): Guard expression
> > character length backend decl before using it. Suppress the
> > assignment if lhs equals rhs.
> > * trans-io.cc (gfc_trans_transfer): Scalarize transfer of
> > associate variables pointing to a variable. Add comment.
> > * trans-stmt.cc (trans_associate_var): Remove requirement that
> > the character length be deferred before assigning the value
> > returned by gfc_conv_expr_descriptor. Also, guard the backend
> > decl before testing with VAR_P.
> >
> > gcc/testsuite/
> > PR fortran/99350
> > * gfortran.dg/pr99350.f90 : New test.
> >
> > PR fortran/107281
> > * gfortran.dg/associate_5.f03 : Changed error message.
> > * gfortran.dg/pr107281.f90 : New test.
> >
> > PR fortran/109451
> > * gfortran.dg/associate_61.f90 : New test
>
> Otherwise LGTM.
>
> Thanks for the patch!
>
> Harald
>
>


-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein


[Patch, fortran] PR87477 - (associate) - [meta-bug] [F03] issues concerning the ASSOCIATE statement

2023-06-07 Thread Paul Richard Thomas via Gcc-patches
Hi All,

Three more fixes for PR87477. Please note that PR99350 was a blocker
but, as pointed out in comment #5 of the PR, this has nothing to do
with the associate construct.

All three fixes are straight forward and the .diff + ChangeLog suffice
to explain them. 'rankguessed' was made redundant by the last PR87477
fix.

Regtests on x86_64 - good for mainline?

Paul

Fortran: Fix some more blockers in associate meta-bug [PR87477]

2023-06-07  Paul Thomas  

gcc/fortran
PR fortran/99350
* decl.cc (char_len_param_value): Simplify a copy of the expr
and replace the original if there is no error.
* gfortran.h : Remove the redundant field 'rankguessed' from
'gfc_association_list'.
* resolve.cc (resolve_assoc_var): Remove refs to 'rankguessed'.

PR fortran/107281
* resolve.cc (resolve_variable): Associate names with constant
or structure constructor targets cannot have array refs.

PR fortran/109451
* trans-array.cc (gfc_conv_expr_descriptor): Guard expression
character length backend decl before using it. Suppress the
assignment if lhs equals rhs.
* trans-io.cc (gfc_trans_transfer): Scalarize transfer of
associate variables pointing to a variable. Add comment.
* trans-stmt.cc (trans_associate_var): Remove requirement that
the character length be deferred before assigning the value
returned by gfc_conv_expr_descriptor. Also, guard the backend
decl before testing with VAR_P.

gcc/testsuite/
PR fortran/99350
* gfortran.dg/pr99350.f90 : New test.

PR fortran/107281
* gfortran.dg/associate_5.f03 : Changed error message.
* gfortran.dg/pr107281.f90 : New test.

PR fortran/109451
* gfortran.dg/associate_61.f90 : New test
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index f5d39e2a3d8..d09c8bc97d9 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -1056,6 +1056,7 @@ static match
 char_len_param_value (gfc_expr **expr, bool *deferred)
 {
   match m;
+  gfc_expr *p;
 
   *expr = NULL;
   *deferred = false;
@@ -1081,10 +1082,10 @@ char_len_param_value (gfc_expr **expr, bool *deferred)
   if (!gfc_expr_check_typed (*expr, gfc_current_ns, false))
 return MATCH_ERROR;
 
-  /* If gfortran gets an EXPR_OP, try to simplify it.  This catches things
- like CHARACTER(([1])).   */
-  if ((*expr)->expr_type == EXPR_OP)
-gfc_simplify_expr (*expr, 1);
+  /* Try to simplify the expression to catch things like CHARACTER(([1])).   */
+  p = gfc_copy_expr (*expr);
+  if (gfc_is_constant_expr (p) && gfc_simplify_expr (p, 1))
+gfc_replace_expr (*expr, p);
 
   if ((*expr)->expr_type == EXPR_FUNCTION)
 {
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 3e5f942d7fd..a65dd571591 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2914,9 +2914,6 @@ typedef struct gfc_association_list
  for memory handling.  */
   unsigned dangling:1;
 
-  /* True when the rank of the target expression is guessed during parsing.  */
-  unsigned rankguessed:1;
-
   char name[GFC_MAX_SYMBOL_LEN + 1];
   gfc_symtree *st; /* Symtree corresponding to name.  */
   locus where;
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 2ba3101f1fe..f2604314570 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -5872,7 +5872,15 @@ resolve_variable (gfc_expr *e)
   if (sym->ts.type == BT_CLASS)
 	gfc_fix_class_refs (e);
   if (!sym->attr.dimension && e->ref && e->ref->type == REF_ARRAY)
-	return false;
+	{
+	  /* Unambiguously scalar!  */
+	  if (sym->assoc->target
+	  && (sym->assoc->target->expr_type == EXPR_CONSTANT
+		  || sym->assoc->target->expr_type == EXPR_STRUCTURE))
+	gfc_error ("Scalar variable %qs has an array reference at %L",
+		   sym->name, >where);
+	  return false;
+	}
   else if (sym->attr.dimension && (!e->ref || e->ref->type != REF_ARRAY))
 	{
 	  /* This can happen because the parser did not detect that the
@@ -9279,7 +9287,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
   gfc_array_spec *as;
   /* The rank may be incorrectly guessed at parsing, therefore make sure
 	 it is corrected now.  */
-  if (sym->ts.type != BT_CLASS && (!sym->as || sym->assoc->rankguessed))
+  if (sym->ts.type != BT_CLASS && !sym->as)
 	{
 	  if (!sym->as)
 	sym->as = gfc_get_array_spec ();
@@ -9292,8 +9300,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
 	sym->attr.codimension = 1;
 	}
   else if (sym->ts.type == BT_CLASS
-	   && CLASS_DATA (sym)
-	   && (!CLASS_DATA (sym)->as || sym->assoc->rankguessed))
+	   && CLASS_DATA (sym) && !CLASS_DATA (sym)->as)
 	{
 	  if (!CLASS_DATA (sym)->as)
 	CLASS_DATA (sym)->as = gfc_get_array_spec ();
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 1c7ea900ea1..e1c75e9fe02 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -7934,7 +7934,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 	  else
 	tmp = se->string_length;
 
-	  if (expr->ts.deferred && VAR_P 

Re: [Patch, fortran] PR37336 finalization

2023-06-03 Thread Paul Richard Thomas via Gcc-patches
Hi Thomas,

I want to get something approaching correct finalization to the
distros, which implies 12-branch at present. Hopefully I can do the
same with associate in a month or two's time.

I am dithering about changing the F2003/08 part of finalization since
the default is 2018 compliance. That said, it does need a change since
the suppression of constructor finalization is also suppressing
finalization of function results within the compilers. I'll do that
first, perhaps?

Cheers

Paul



On Sat, 3 Jun 2023 at 06:50, Thomas Koenig  wrote:
>
> Hi Paul,
>
> > I propose to backport
> > r13-6747-gd7caf313525a46f200d7f5db1ba893f853774aee to 12-branch very
> > soon.
>
> Is this something that we usually do?
>
> While finalization was basically broken before, some people still used
> working subsets (or subsets that were broken, and they adapted or
> wrote their code accordingly).
>
> What is the general opinion on that?  I'm undecided.
>
> > Before that, I propose to remove the F2003/2008 finalization of
> > structure and array constructors in 13- and 14-branches. I can see why
> > it was removed from the standard in a correction to F2008 and think
> > that it is likely to cause endless confusion and maintenance
> > complications. However, finalization of function results within
> > constructors will be retained.
>
> That, I agree with.  Should it be noted somewhere as an intentional
> deviation from the standard?
>
> Best regards
>
> Thomas
>


--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein


Re: [PATCH, committed] Fortran: fix diagnostics for SELECT RANK [PR100607]

2023-06-02 Thread Paul Richard Thomas via Gcc-patches
Hi Harald,

It looks good to me. Thanks to you and Steve for the fix. I suggest
that it is such and obvious one that it deserved back-porting.

Cheers

Paul

On Fri, 2 Jun 2023 at 19:06, Harald Anlauf via Fortran
 wrote:
>
> Dear all,
>
> I've committed that attached simple patch on behalf of Steve
> after discussion in the PR and regtesting on x86_64-pc-linux-gnu.
>
> It fixes a duplicate error message and an ICE.
>
> Pushed as r14-1505-gfae09dfc0e6bf4cfe35d817558827aea78c6426f .
>
> Thanks,
> Harald
>


-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein


Re: [Patch, fortran] PR37336 finalization

2023-06-02 Thread Paul Richard Thomas via Gcc-patches
Hi All,

I propose to backport
r13-6747-gd7caf313525a46f200d7f5db1ba893f853774aee to 12-branch very
soon. Before that, I propose to remove the F2003/2008 finalization of
structure and array constructors in 13- and 14-branches. I can see why
it was removed from the standard in a correction to F2008 and think
that it is likely to cause endless confusion and maintenance
complications. However, finalization of function results within
constructors will be retained.

If there are any objections, please let me know.

Paul


Re: [Patch, fortran] PR87477 - [meta-bug] [F03] issues concerning the ASSOCIATE statement

2023-06-02 Thread Paul Richard Thomas via Gcc-patches
Thanks Mikael. Pushed as r14-1487-g3c2eba4b7a2355ed5099e35332388206c484744d

I should have credited you with the comments that you made about the half
baked patch, which pushed me to this patch.

Regards

Paul


On Thu, 1 Jun 2023 at 18:58, Mikael Morin  wrote:

> Le 01/06/2023 à 17:20, Paul Richard Thomas via Fortran a écrit :
> > Hi All,
> >
> > This started out as the search for a fix to pr109948 and evolved to roll
> in
> > 5 other prs.
> >
> > Basically parse_associate was far too clunky and, in anycase, existing
> > functions in resolve.cc were well capable of doing the determination of
> the
> > target expression rank. While I was checking the comments, the lightbulb
> > flashed with respect to prs 102109/112/190 and the chunk dealing with
> > function results of unknown type was born.
> >
> > Thanks to the changes in parse.cc, the problem in pr99326 migrated
> > upstream to the resolution and the chunklet in resolve.cc was an obvious
> > fix.
> >
> > I am minded to s/{ dg-do run}/{ dg-do compile } for all six testcases.
> Makes sense, the PRs were bogus errors and ICEs, so all compile time
> issues.
>
> > At
> > the testing stage, I wanted to check that the testcases actually did what
> > they are supposed to do :-)
> >
> > Bootstraps and regtests OK - good for head?
> >
> OK.  Thanks for this.
>
> > Paul
> >
> > PS I need to do some housekeeping on pr87477 now. Some of the blockers
> have
> > "fixed themselves" and others are awaiting backporting. I think that
> there
> > are only 4 or so left, of which 89645 and 99065 are the most difficult to
> > deal with.
>
>

-- 
"If you can't explain it simply, you don't understand it well enough" -
Albert Einstein


[Patch, fortran] PR87477 - [meta-bug] [F03] issues concerning the ASSOCIATE statement

2023-06-01 Thread Paul Richard Thomas via Gcc-patches
Hi All,

This started out as the search for a fix to pr109948 and evolved to roll in
5 other prs.

Basically parse_associate was far too clunky and, in anycase, existing
functions in resolve.cc were well capable of doing the determination of the
target expression rank. While I was checking the comments, the lightbulb
flashed with respect to prs 102109/112/190 and the chunk dealing with
function results of unknown type was born.

Thanks to the changes in parse.cc, the problem in pr99326 migrated
upstream to the resolution and the chunklet in resolve.cc was an obvious
fix.

I am minded to s/{ dg-do run}/{ dg-do compile } for all six testcases. At
the testing stage, I wanted to check that the testcases actually did what
they are supposed to do :-)

Bootstraps and regtests OK - good for head?

Paul

PS I need to do some housekeeping on pr87477 now. Some of the blockers have
"fixed themselves" and others are awaiting backporting. I think that there
are only 4 or so left, of which 89645 and 99065 are the most difficult to
deal with.
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 5e2a95688d2..3947444f17c 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -4919,6 +4919,7 @@ parse_associate (void)
   gfc_state_data s;
   gfc_statement st;
   gfc_association_list* a;
+  gfc_array_spec *as;
 
   gfc_notify_std (GFC_STD_F2003, "ASSOCIATE construct at %C");
 
@@ -4934,8 +4935,7 @@ parse_associate (void)
   for (a = new_st.ext.block.assoc; a; a = a->next)
 {
   gfc_symbol* sym;
-  gfc_ref *ref;
-  gfc_array_ref *array_ref;
+  gfc_expr *target;
 
   if (gfc_get_sym_tree (a->name, NULL, >st, false))
 	gcc_unreachable ();
@@ -4952,6 +4952,7 @@ parse_associate (void)
 	 for parsing component references on the associate-name
 	 in case of association to a derived-type.  */
   sym->ts = a->target->ts;
+  target = a->target;
 
   /* Don’t share the character length information between associate
 	 variable and target if the length is not a compile-time constant,
@@ -4971,31 +4972,37 @@ parse_associate (void)
 	   && sym->ts.u.cl->length->expr_type == EXPR_CONSTANT))
 	sym->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
 
-  /* Check if the target expression is array valued.  This cannot always
-	 be done by looking at target.rank, because that might not have been
-	 set yet.  Therefore traverse the chain of refs, looking for the last
-	 array ref and evaluate that.  */
-  array_ref = NULL;
-  for (ref = a->target->ref; ref; ref = ref->next)
-	if (ref->type == REF_ARRAY)
-	  array_ref = >u.ar;
-  if (array_ref || a->target->rank)
+  /* Check if the target expression is array valued. This cannot be done
+	 by calling gfc_resolve_expr because the context is unavailable.
+	 However, the references can be resolved and the rank of the target
+	 expression set.  */
+  if (target->ref && gfc_resolve_ref (target)
+	  && target->expr_type != EXPR_ARRAY
+	  && target->expr_type != EXPR_COMPCALL)
+	gfc_expression_rank (target);
+
+  /* Determine whether or not function expressions with unknown type are
+	 structure constructors. If so, the function result can be converted
+	 to be a derived type.
+	 TODO: Deal with references to sibling functions that have not yet been
+	 parsed (PRs 89645 and 99065).  */
+  if (target->expr_type == EXPR_FUNCTION && target->ts.type == BT_UNKNOWN)
 	{
-	  gfc_array_spec *as;
-	  int dim, rank = 0;
-	  if (array_ref)
+	  gfc_symbol *derived;
+	  /* The derived type has a leading uppercase character.  */
+	  gfc_find_symbol (gfc_dt_upper_string (target->symtree->name),
+			   my_ns->parent, 1, );
+	  if (derived && derived->attr.flavor == FL_DERIVED)
 	{
-	  a->rankguessed = 1;
-	  /* Count the dimension, that have a non-scalar extend.  */
-	  for (dim = 0; dim < array_ref->dimen; ++dim)
-		if (array_ref->dimen_type[dim] != DIMEN_ELEMENT
-		&& !(array_ref->dimen_type[dim] == DIMEN_UNKNOWN
-			 && array_ref->end[dim] == NULL
-			 && array_ref->start[dim] != NULL))
-		  ++rank;
+	  sym->ts.type = BT_DERIVED;
+	  sym->ts.u.derived = derived;
 	}
-	  else
-	rank = a->target->rank;
+	}
+
+  if (target->rank)
+	{
+	  int rank = 0;
+	  rank = target->rank;
 	  /* When the rank is greater than zero then sym will be an array.  */
 	  if (sym->ts.type == BT_CLASS && CLASS_DATA (sym))
 	{
@@ -5006,8 +5013,8 @@ parse_associate (void)
 		  /* Don't just (re-)set the attr and as in the sym.ts,
 		 because this modifies the target's attr and as.  Copy the
 		 data and do a build_class_symbol.  */
-		  symbol_attribute attr = CLASS_DATA (a->target)->attr;
-		  int corank = gfc_get_corank (a->target);
+		  symbol_attribute attr = CLASS_DATA (target)->attr;
+		  int corank = gfc_get_corank (target);
 		  gfc_typespec type;
 
 		  if (rank || corank)
@@ -5042,7 +5049,7 @@ parse_associate (void)
 	  as = gfc_get_array_spec ();
 	  as->type = AS_DEFERRED;
 	  

Re: [Patch, fortran] PR103716 - [10/11/12/13/14 Regression] ICE in gimplify_expr, at gimplify.c:15964

2023-05-09 Thread Paul Richard Thomas via Gcc-patches
Duuh! There's even a choice :-)

Paul


On Tue, 9 May 2023 at 19:29, Harald Anlauf  wrote:

> Hi Paul,
>
> On 5/9/23 18:00, Paul Richard Thomas via Gcc-patches wrote:
> > Hi All,
> >
> > This problem caused the gimplifier failure because the reference chain
> > ending in an inquiry_len still retained a full array reference. This had
> > already been corrected for deferred character lengths but the fix extends
> > this to all characters without a length expression and integer
> expressions,
> > which is the correct type of course, that retain a full  array_spec. The
> > nullification of the se->string length in conv_inquiry is a
> > belts-and-braces measure to stop it from winding up as a hidden argument
> in
> > procedure calls.
> >
> > OK for trunk and, after a decent delay, backporting?
>
> ENOTESTCASE.
>
> Nevertheless the patch LGTM and is also OK for backporting.
>
> Thanks for fixing this!
>
> Harald
>
>
> > Cheers
> >
> > Paul
> >
> > Fortran: Fix assumed length chars and len inquiry [PR103716]
> >
> > 2023-05-09  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 : New test.
>
>

-- 
"If you can't explain it simply, you don't understand it well enough" -
Albert Einstein
! { dg-do run }
!
! The gimplifier used to throw a fit on the write statements in f1 and f2.
!
! Contributed by Gerhard Steinmetz  
!
module m
  character(6) :: buffer
contains
  integer function g(x)
integer :: x
g = x
  end
  integer function f1(x)
character(*) :: x(*)
write (buffer(1:3),'(i2)') g(x%len)
  end
  integer function f2(x)
character(*) :: x(3)
write (buffer(4:6),'(i2)') g(x%len)
  end
end module m

  use m
  integer :: i(2), j
  character(2), dimension(3) :: chr = ['ab','cd','ef']
  i(1) = f1(chr)
  i(2) = f2(chr)
  if (any (i .eq.2)) stop 1
  if (trim(buffer) .ne. ' 2  2') stop 2
end
! { 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

[Patch, fortran] PR103716 - [10/11/12/13/14 Regression] ICE in gimplify_expr, at gimplify.c:15964

2023-05-09 Thread Paul Richard Thomas via Gcc-patches
Hi All,

This problem caused the gimplifier failure because the reference chain
ending in an inquiry_len still retained a full array reference. This had
already been corrected for deferred character lengths but the fix extends
this to all characters without a length expression and integer expressions,
which is the correct type of course, that retain a full  array_spec. The
nullification of the se->string length in conv_inquiry is a
belts-and-braces measure to stop it from winding up as a hidden argument in
procedure calls.

OK for trunk and, after a decent delay, backporting?

Cheers

Paul

Fortran: Fix assumed length chars and len inquiry [PR103716]

2023-05-09  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 : New test.
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 55d8e326a87..8f0dd8b6dee 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -5504,7 +5504,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 09cdd9263c4..3225b419989 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -2861,11 +2861,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:


[Patch, fortran] PR97122 - Spurious FINAL ... must be in the specification part of a MODULE

2023-05-09 Thread Paul Richard Thomas via Gcc-patches
Hi All,

Thanks to Steve Kargl for the fix. It caused finalize_8.f03 to fail because
this testcase checked that finalizable derived types could not be specified
in a submodule. I have replaced the original test with a test of the patch.

Thanks also to Malcolm Cohen for guidance on this.

OK for trunk?

Paul

Fortran: Allow declaration of finalizable DT in a submodule [PR97122]

2023-05-09  Paul Thomas  
   Steven G. Kargl  

gcc/fortran
PR fortran/97122
* decl.cc (variable_decl): Clean up white space issues.
(gfc_match_final_decl): Declaration of finalizable derived type
is allowed in a submodule.

gcc/testsuite/
PR fortran/97122
* gfortran.dg/finalize_8.f03 : Replace testcase that checks
declaration of finalizable derived types in submodules works.
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 233bf244d62..6d6ce0854de 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -2698,7 +2698,7 @@ variable_decl (int elem)
 	}
 
   gfc_seen_div0 = false;
-  
+
   /* F2018:C830 (R816) An explicit-shape-spec whose bounds are not
 	 constant expressions shall appear only in a subprogram, derived
 	 type definition, BLOCK construct, or interface body.  */
@@ -2769,7 +2769,7 @@ variable_decl (int elem)
 	  if (e->expr_type != EXPR_CONSTANT)
 		{
 		  n = gfc_copy_expr (e);
-		  if (!gfc_simplify_expr (n, 1)  && gfc_seen_div0) 
+		  if (!gfc_simplify_expr (n, 1)  && gfc_seen_div0)
 		{
 		  m = MATCH_ERROR;
 		  goto cleanup;
@@ -2784,12 +2784,12 @@ variable_decl (int elem)
 	  if (e->expr_type != EXPR_CONSTANT)
 		{
 		  n = gfc_copy_expr (e);
-		  if (!gfc_simplify_expr (n, 1)  && gfc_seen_div0) 
+		  if (!gfc_simplify_expr (n, 1)  && gfc_seen_div0)
 		{
 		  m = MATCH_ERROR;
 		  goto cleanup;
 		}
-		  
+
 		  if (n->expr_type == EXPR_CONSTANT)
 		gfc_replace_expr (e, n);
 		  else
@@ -11637,8 +11637,9 @@ gfc_match_final_decl (void)
   block = gfc_state_stack->previous->sym;
   gcc_assert (block);
 
-  if (!gfc_state_stack->previous || !gfc_state_stack->previous->previous
-  || gfc_state_stack->previous->previous->state != COMP_MODULE)
+  if (gfc_state_stack->previous->previous
+  && gfc_state_stack->previous->previous->state != COMP_MODULE
+  && gfc_state_stack->previous->previous->state != COMP_SUBMODULE)
 {
   gfc_error ("Derived type declaration with FINAL at %C must be in the"
 		 " specification part of a MODULE");
diff --git a/gcc/testsuite/gfortran.dg/finalize_8.f03 b/gcc/testsuite/gfortran.dg/finalize_8.f03
index b2027a0ba6d..b7fa10dda31 100644
--- a/gcc/testsuite/gfortran.dg/finalize_8.f03
+++ b/gcc/testsuite/gfortran.dg/finalize_8.f03
@@ -1,35 +1,49 @@
-! { dg-do compile }
-
-! Parsing of finalizer procedure definitions.
-! Check that FINAL-declarations are only allowed on types defined in the
-! specification part of a module.
-
-MODULE final_type
+! { dg-do run }
+!
+! PR97122: Declaration of a finalizable derived type in a submodule
+! IS allowed.
+!
+! Contributed by Ian Harvey  
+!
+MODULE m
   IMPLICIT NONE
 
-CONTAINS
+  INTERFACE
+MODULE SUBROUTINE other(i)
+  IMPLICIT NONE
+  integer, intent(inout) :: i
+END SUBROUTINE other
+  END INTERFACE
 
-  SUBROUTINE bar
-IMPLICIT NONE
+  integer :: mi
 
-TYPE :: mytype
-  INTEGER, ALLOCATABLE :: fooarr(:)
-  REAL :: foobar
-CONTAINS
-  FINAL :: myfinal ! { dg-error "in the specification part of a MODULE" }
-END TYPE mytype
-
-  CONTAINS
+END MODULE m
 
-SUBROUTINE myfinal (el)
-  TYPE(mytype) :: el
-END SUBROUTINE myfinal
+SUBMODULE (m) s
+  IMPLICIT NONE
 
-  END SUBROUTINE bar
+  TYPE :: t
+integer :: i
+  CONTAINS
+FINAL :: final_t  ! Used to be an error here
+  END TYPE t
 
-END MODULE final_type
+CONTAINS
 
-PROGRAM finalizer
-  IMPLICIT NONE
-  ! Do nothing here
-END PROGRAM finalizer
+  SUBROUTINE final_t(arg)
+TYPE(t), INTENT(INOUT) :: arg
+mi = -arg%i
+  END SUBROUTINE final_t
+
+  module subroutine other(i)  ! 'ti' is finalized
+integer, intent(inout) :: i
+type(t) :: ti
+ti%i = i
+  END subroutine other
+END SUBMODULE s
+
+  use m
+  integer :: i = 42
+  call other(i)
+  if (mi .ne. -i) stop 1
+end


[Patch, fortran] PRs 105152, 100193, 87946, 103389, 104429 and 82774

2023-04-22 Thread Paul Richard Thomas via Gcc-patches
Hi All,

As usual, I received a string of emails on retargeting for PRs for which I
was either responsible or was on the cc list. This time I decided to take a
look at them all, in order to reward the tireless efforts of Richi, Jakub
and Martin with some attention at least.

I have fixed the PRs in the title line: See the attached changelog, patch
and testcases.

OK for 14-branch?

Of the others:
PR100815 - fixed already for 12-branch on. Martin located the fix from
Tobias, for which thanks. It's quite large but has stood the test of time.
Should I backport to 11-branch?
PR103366 - fixed on 12-branch on. I closed it.
PR103715 - might be fixed but the report is for gcc with checking enabled.
I will give that a go.
PR103716 - a gimple problem with assumed shape characters. A TODO.
PR103931 - I couldn't reproduce the bug, which involves 'ambiguous c_ptr'.
To judge by the comments, it seems that this bug is a bit elusive.
PR65381 - Seems to be fixed for 12-branch on
PR82064 - Seems to be fixed.
PR83209 - Coarray allocation - seems to be fixed.
PR84244 - Coarray segfault. I have no acquaintance with the inner works of
coarrays and so don't think that I can fix this one.
PR87674 - Segfault in runtime with non-overridable proc-pointer. A TODO.
PR96087 - A module procedure problem. A TODO.

I have dejagnu-ified testcases for the already fixed PRs ready to go.
Should these be committed or do we assume that the fixes already provided
adequate tests?

Regards

Paul
! { dg-do compile }
!
! Contributed by Gerhard Steinmetz  
!
program p
   use iso_c_binding
   type, bind(c) :: t
  integer(c_int) :: a
   end type
   interface
  function f(x) bind(c) result(z)
 import :: c_int, t
 type(t) :: x(:)
 integer(c_int) :: z
  end
   end interface
   class(*), allocatable :: y(:)
   n = f(y) ! { dg-error "either an unlimited polymorphic or assumed type" }
end
! { dg-do compile }
!
! Contributed by Gerhard Steinmetz  
!
module m
   implicit none
   type t
  procedure(f), pointer, nopass :: g
   end type
contains
   function f()
  character(:), allocatable :: f
  f = 'abc'
   end
   subroutine s
  type(t) :: z
  z%g = 'x'  ! { dg-error "is a procedure pointer" }
  if ( z%g() /= 'abc' ) stop
   end
end
program p
   use m
   implicit none
   call s
end
! { dg-do run }
!
! Contributed by Gerhard Steinmetz  
!
module m
   type t
   contains
  generic :: h => g
  procedure, private :: g
   end type
contains
   function g(x, y) result(z)
  class(t), intent(in) :: x
  real, intent(in) :: y(:, :)
  real :: z(size(y, 2))
  integer :: i
  do i = 1, size(y, 2)
z(i) = i
  end do
   end
end
module m2
   use m
   type t2
  class(t), allocatable :: u(:)
   end type
end
   use m2
   type(t2) :: x
   real :: y(1,5)
   allocate (x%u(1))
   if (any (int(f (x, y)) .ne. [1,2,3,4,5])) stop 1
   deallocate (x%u)
contains
   function f(x, y) result(z)
  use m2
  type(t2) :: x
  real :: y(:, :)
  real :: z(size(y, 2))
  z = x%u(1)%h(y)  ! Used to segfault here
   end
end
! { dg-do run }
!
! Contributed by Gerhard Steinmetz  
!
program p
   type t
  integer, allocatable :: a(:)
   end type
   type(t) :: y
   y%a = [1,2]
   call s((y))
   if (any (y%a .ne. [3,4])) stop 1
contains
   subroutine s(x)
  class(*) :: x
  select type (x)
type is (t)
  x%a = x%a + 2
class default
  stop 2
  end select
   end
end
! { dg-do run }
module m
   type t
  real :: r
   contains
  procedure :: op
  procedure :: assign
  generic :: operator(*) => op
  generic :: assignment(=) => assign
   end type
contains
   function op (x, y)
  class(t), allocatable :: op
  class(t), intent(in) :: x
  real, intent(in) :: y
  allocate (op, source = t (x%r * y))
   end
   subroutine assign (z, x)
  type(t), intent(in) :: x
  class(t), intent(out) :: z
  z%r = x%r
   end
end
program p
   use m
   class(t), allocatable :: x
   real :: y = 2
   allocate (x, source = t (2.0))
   x = x * y
   if (int (x%r) .ne. 4) stop 1
   if (allocated (x)) deallocate (x)
end
! { dg-do run }
!
! Contributed by Steve Kargl  
!
program main
   implicit none
   type stuff
  character(:), allocatable :: key
   end type stuff
   type(stuff) nonsense, total
   nonsense = stuff('Xe')
   total = stuff(nonsense%key) ! trim nonsense%key made this work
   if (nonsense%key /= total%key) call abort
   if (len(total%key) /= 2) call abort
end program main


Change.Logs
Description: Binary data
diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index e9843e9549c..fa505ab7ed9 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -3312,6 +3312,16 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	}
 	}
 
+  if (UNLIMITED_POLY (a->expr)
+	  && !(f->sym->ts.type == BT_ASSUMED || UNLIMITED_POLY (f->sym)))
+	{
+	  gfc_error 

  1   2   3   4   5   6   7   8   9   10   >