date:20240331

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

ICE with elemental finalizer

2024-03-31 Thread Andrew Benson

I opened PR114535 for the following ICE:

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114535

The following code (which must be in two files to trigger the error) causes
an ICE using the latest gfortran.

$ cat ice1.F90
module iv
  type, public :: vs
   contains
 final :: destructor
  end type vs
contains
 elemental subroutine destructor(s)
type(vs), intent(inout) :: s
  end subroutine destructor
end module iv

$ cat ice2.F90 module d
contains
  function en() result(dd)
use :: iv
type(vs) :: dd
return
  end function en
end module d

module ni
contains
  subroutine iss()
use :: d
return
  end subroutine iss
end module ni

$ gfortran -v
Using built-in specs.
COLLECT_GCC=gfortran
COLLECT_LTO_WRAPPER=/data001/abenson/Galacticus/Tools_Devel/bin/../libexec/gcc/x86_64-pc-linux-gnu/14.0.1/lto-wrapper
Target: x86_64-pc-linux-gnu
Configured with: ../gcc-git/configure
--prefix=/home/abenson/Galacticus/Tools_Devel
--enable-languages=c,c++,fortran --disable-multilib
Thread model: posix
Supported LTO compression algorithms: zlib
gcc version 14.0.1 20240330 (experimental) (GCC)

$ gfortran -c ice1.F90 -o ice1.o
$ gfortran -c ice2.F90 -o ice2.o
 ice2.F90:16:13:
   16 | end module ni |
 1
internal compiler error: in gfc_trans_call, at fortran/trans-stmt.cc:400
0x78ddb6 gfc_trans_call(gfc_code*,
bool, tree_node*, tree_node*, bool)
../../gcc-git/gcc/fortran/trans-stmt.cc:400 0xaa8a1b
trans_code
 ../../gcc-git/gcc/fortran/trans.cc:2431
0xb47c14 gfc_trans_simple_do
../../gcc-git/gcc/fortran/trans-stmt.cc:2521
0xb47c14 gfc_trans_do(gfc_code*, tree_node*)
../../gcc-git/gcc/fortran/trans-stmt.cc:2653
0xaa898a trans_code
 ../../gcc-git/gcc/fortran/trans.cc:2463
0xb485e9 gfc_trans_integer_select
 ../../gcc-git/gcc/fortran/trans-stmt.cc:3199
0xb485e9 gfc_trans_select(gfc_code*)
../../gcc-git/gcc/fortran/trans-stmt.cc:3692
0xaa8957 trans_code
../../gcc-git/gcc/fortran/trans.cc:2475
0xadd6fb gfc_generate_function_code(gfc_namespace*)
../../gcc-git/gcc/fortran/trans-decl.cc:7879
0xaadbf1 gfc_generate_module_code(gfc_namespace*)
../../gcc-git/gcc/fortran/trans.cc:2785
0xa5113d translate_all_program_units
../../gcc-git/gcc/fortran/parse.cc:7086
0xa5113d gfc_parse_file()
../../gcc-git/gcc/fortran/parse.cc:7413
0xaa546f gfc_be_parse_file
../../gcc-git/gcc/fortran/f95-lang.cc:241
Please submit a full bug report, with preprocessed source (by using
-freport-bug).
Please include the complete backtrace with any bug report.
See  for instructions.

This only occurs if the FINAL subroutine is ELEMENTAL.


--

* Andrew Benson: http://users.obs.carnegiescience.edu/abenson

* Galacticus: https://github.com/galacticusorg/galacticus

[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

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

ICE with elemental finalizer

3 matches

Site Navigation

Mail list logo

Footer information