[patch, fortran, committed] Fix PR 96556, segfault on NULL pointer dereference

[patch, fortran, committed] Fix PR 96556, segfault on NULL pointer dereference

[Thomas König]

[-- Attachment #1: Type: text/plain, Size: 662 bytes --]

Hi,

in the code about DO loop warning I recently introduced, there was
a hidden NULL pointer dereference found by Jürgen Reuter and fixed
as obvious and simple in r11-2636.

Fix NULL pointer dereference in doloop_contained_function_call.

Thanks to Jürgen for the bug report and to Dominique for spotting
what commit this was caused by.

Unfortunately, not all bugs are quite as simple and obvious as this
one :-)

gcc/fortran/ChangeLog:

	PR fortran/96556
	* frontend-passes.c (doloop_contained_function_call):
	Do not dereference a NULL pointer for value.function.esym.

gcc/testsuite/ChangeLog:

	PR fortran/96556
	* gfortran.dg/do_check_15.f90: New test.

[-- Attachment #2: p1.diff --]
[-- Type: text/x-patch, Size: 2295 bytes --]

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 6bcb1f06b1c..83f6fd804b1 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -2329,7 +2329,8 @@ doloop_contained_function_call (gfc_expr **e,
   gfc_symbol *sym, *do_var;
   contained_info *info;
 
-  if (expr->expr_type != EXPR_FUNCTION || expr->value.function.isym)
+  if (expr->expr_type != EXPR_FUNCTION || expr->value.function.isym
+      || expr->value.function.esym == NULL)
     return 0;
 
   sym = expr->value.function.esym;
diff --git a/gcc/testsuite/gfortran.dg/do_check_15.f90 b/gcc/testsuite/gfortran.dg/do_check_15.f90
new file mode 100644
index 00000000000..f67452b4660
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_check_15.f90
@@ -0,0 +1,58 @@
+! { dg-do compile }
+! PR fortran/96556 - this used to cause an ICE.
+! Test case by Juergen Reuter.
+module polarizations
+
+  implicit none
+  private
+
+  type :: smatrix_t
+     private
+     integer :: dim = 0
+     integer :: n_entry = 0
+     integer, dimension(:,:), allocatable :: index
+   contains
+     procedure :: write => smatrix_write
+  end type smatrix_t
+
+  type, extends (smatrix_t) :: pmatrix_t
+     private
+   contains
+     procedure :: write => pmatrix_write
+     procedure :: normalize => pmatrix_normalize
+  end type pmatrix_t
+
+contains
+
+  subroutine msg_error (string)
+    character(len=*), intent(in), optional :: string
+  end subroutine msg_error
+  
+  subroutine smatrix_write (object)
+    class(smatrix_t), intent(in) :: object
+  end subroutine smatrix_write
+
+  subroutine pmatrix_write (object)
+    class(pmatrix_t), intent(in) :: object
+    call object%smatrix_t%write ()
+  end subroutine pmatrix_write
+
+  subroutine pmatrix_normalize (pmatrix)
+    class(pmatrix_t), intent(inout) :: pmatrix
+    integer :: i, hmax
+    logical :: fermion, ok
+    do i = 1, pmatrix%n_entry
+       associate (index => pmatrix%index(:,i))
+         if (index(1) == index(2)) then
+            call error ("diagonal must be real")
+         end if
+       end associate
+    end do
+  contains
+    subroutine error (msg)
+      character(*), intent(in) :: msg
+      call pmatrix%write ()
+    end subroutine error
+  end subroutine pmatrix_normalize
+
+end module polarizations