--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/gfortran.dg/asan/pointer_assign_16.f90	Mon May 25 07:50:57 2020 +0900
@@ -0,0 +1,304 @@
+! { dg-do run }
+! PR fortran/94788 - this leads to a double free.
+! Test case by Juergen Reuter.
+module iso_varying_string
+  implicit none
+  integer, parameter, private :: GET_BUFFER_LEN = 1
+  type, public :: varying_string
+     private
+     character(LEN=1), dimension(:), allocatable :: chars
+  end type varying_string
+
+  interface assignment(=)
+     module procedure op_assign_CH_VS
+     module procedure op_assign_VS_CH
+  end interface assignment(=)
+
+  interface char
+     module procedure char_auto
+     module procedure char_fixed
+  end interface char
+
+ interface len
+     module procedure len_
+  end interface len
+
+  interface var_str
+     module procedure var_str_
+  end interface var_str
+
+  public :: assignment(=)
+  public :: char
+  public :: len
+  public :: var_str
+
+  private :: op_assign_CH_VS
+  private :: op_assign_VS_CH
+  private :: op_eq_VS_VS
+  private :: op_eq_CH_VS
+  private :: op_eq_VS_CH
+  private :: char_auto
+  private :: char_fixed
+  private :: len_
+  private :: var_str_
+
+contains
+
+  elemental function len_ (string) result (length)
+    type(varying_string), intent(in) :: string
+    integer                          :: length
+    if(ALLOCATED(string%chars)) then
+       length = SIZE(string%chars)
+    else
+       length = 0
+    endif
+  end function len_
+
+  elemental subroutine op_assign_CH_VS (var, exp)
+    character(LEN=*), intent(out)    :: var
+    type(varying_string), intent(in) :: exp
+    var = char(exp)
+  end subroutine op_assign_CH_VS
+
+  elemental subroutine op_assign_VS_CH (var, exp)
+    type(varying_string), intent(out) :: var
+    character(LEN=*), intent(in)      :: exp
+    var = var_str(exp)
+  end subroutine op_assign_VS_CH
+
+  elemental function op_eq_VS_VS (string_a, string_b) result (op_eq)
+    type(varying_string), intent(in) :: string_a
+    type(varying_string), intent(in) :: string_b
+    logical                          :: op_eq
+    op_eq = char(string_a) == char(string_b)
+  end function op_eq_VS_VS
+
+  elemental function op_eq_CH_VS (string_a, string_b) result (op_eq)
+    character(LEN=*), intent(in)     :: string_a
+    type(varying_string), intent(in) :: string_b
+    logical                          :: op_eq
+    op_eq = string_a == char(string_b)
+  end function op_eq_CH_VS
+
+  elemental function op_eq_VS_CH (string_a, string_b) result (op_eq)
+    type(varying_string), intent(in) :: string_a
+    character(LEN=*), intent(in)     :: string_b
+    logical                          :: op_eq
+    op_eq = char(string_a) == string_b
+  end function op_eq_VS_CH
+
+
+  pure function char_auto (string) result (char_string)
+    type(varying_string), intent(in) :: string
+    character(LEN=len(string))       :: char_string
+    integer                          :: i_char
+    forall(i_char = 1:len(string))
+       char_string(i_char:i_char) = string%chars(i_char)
+    end forall
+
+  end function char_auto
+
+  pure function char_fixed (string, length) result (char_string)
+    type(varying_string), intent(in) :: string
+    integer, intent(in)              :: length
+    character(LEN=length)            :: char_string
+    char_string = char(string)
+  end function char_fixed
+
+  elemental function var_str_ (char) result (string)
+    character(LEN=*), intent(in) :: char
+    type(varying_string)         :: string
+    integer                      :: length
+    integer                      :: i_char
+    length = LEN(char)
+    ALLOCATE(string%chars(length))
+    forall(i_char = 1:length)
+       string%chars(i_char) = char(i_char:i_char)
+    end forall
+  end function var_str_
+
+end module iso_varying_string
+
+
+module parser
+  implicit none
+  private
+  public :: parse_node_t
+  public :: parse_tree_t
+  type :: parse_node_t
+     private
+  end type parse_node_t
+
+  type :: parse_tree_t
+     private
+     type(parse_node_t), pointer :: root_node => null ()
+   contains
+     procedure :: get_root_ptr => parse_tree_get_root_ptr
+  end type parse_tree_t
+
+contains
+  function parse_tree_get_root_ptr (parse_tree) result (node)
+    class(parse_tree_t), intent(in) :: parse_tree
+    type(parse_node_t), pointer :: node
+    node => parse_tree%root_node
+  end function parse_tree_get_root_ptr
+
+end module parser
+
+
+
+module rt_data
+  use iso_varying_string, string_t => varying_string
+  use parser, only: parse_node_t
+  implicit none
+  private
+
+  public :: rt_data_t
+
+  type :: rt_parse_nodes_t
+     type(parse_node_t), pointer :: weight_expr => null ()
+  end type rt_parse_nodes_t
+
+  type :: rt_data_t
+     type(rt_parse_nodes_t) :: pn
+     type(string_t) :: logfile
+   contains
+     procedure :: global_init => rt_data_global_init
+     procedure :: local_init => rt_data_local_init
+     procedure :: activate => rt_data_activate
+  end type rt_data_t
+
+
+contains
+
+  subroutine rt_data_global_init (global, logfile)
+    class(rt_data_t), intent(out), target :: global
+    type(string_t), intent(in), optional :: logfile
+    integer :: seed
+    if (present (logfile)) then
+       global%logfile = logfile
+    else
+       global%logfile = ""
+    end if
+    call system_clock (seed)
+  end subroutine rt_data_global_init
+
+  subroutine rt_data_local_init (local, global, env)
+    class(rt_data_t), intent(inout), target :: local
+    type(rt_data_t), intent(in), target :: global
+    integer, intent(in), optional :: env
+    local%logfile = global%logfile
+  end subroutine rt_data_local_init
+
+  subroutine rt_data_activate (local)
+    class(rt_data_t), intent(inout), target :: local
+    class(rt_data_t), pointer :: global
+    
+    ! global => local%context
+    ! if (associated (global)) then
+    !    local%logfile = global%logfile
+    !    local%pn = global%pn
+    ! end if
+  end subroutine rt_data_activate
+
+end module rt_data
+
+module events
+  implicit none
+  private
+  public :: event_t
+
+  type :: event_config_t
+  end type event_config_t
+
+  type :: event_t
+     type(event_config_t) :: config
+  end type event_t
+
+end module events
+
+
+module simulations
+  use iso_varying_string, string_t => varying_string
+  use events 
+  use rt_data
+
+  implicit none
+  private
+
+  public :: simulation_t
+
+  type, extends (event_t) :: entry_t
+     private
+     type(entry_t), pointer :: next => null ()
+  end type entry_t
+
+  type, extends (entry_t) :: alt_entry_t
+   contains
+     procedure :: init_alt => alt_entry_init
+  end type alt_entry_t
+
+  type :: simulation_t
+     private
+     type(rt_data_t), pointer :: local => null ()
+     integer :: n_alt = 0
+     type(entry_t), dimension(:), allocatable :: entry
+     type(alt_entry_t), dimension(:,:), allocatable :: alt_entry
+   contains
+     procedure :: init => simulation_init
+  end type simulation_t
+
+
+contains
+
+  subroutine alt_entry_init (entry, local)
+    class(alt_entry_t), intent(inout), target :: entry
+    type(rt_data_t), intent(inout), target :: local
+    integer :: i
+  end subroutine alt_entry_init
+
+  subroutine simulation_init (simulation, &
+       integrate, generate, local, global, alt_env)
+    class(simulation_t), intent(out), target :: simulation
+    logical, intent(in) :: integrate, generate
+    type(rt_data_t), intent(inout), target :: local
+    type(rt_data_t), intent(inout), optional, target :: global
+    type(rt_data_t), dimension(:), intent(inout), optional, target :: alt_env
+    simulation%local => local
+    allocate (simulation%entry (1))
+    if (present (alt_env)) then
+       simulation%n_alt = size (alt_env)
+    end if
+  end subroutine simulation_init
+
+end module simulations
+
+
+program main_ut
+  use iso_varying_string, string_t => varying_string
+  use parser, only: parse_tree_t
+  use rt_data
+  use simulations
+  implicit none
+  call simulations_10 (6)
+
+contains
+
+  subroutine simulations_10 (u)
+    integer, intent(in) :: u
+    type(rt_data_t), target :: global
+    type(rt_data_t), dimension(1), target :: alt_env
+    type(parse_tree_t) :: pt_weight
+    type(simulation_t), target :: simulation
+
+    call global%global_init ()
+    call alt_env(1)%local_init (global)
+    call alt_env(1)%activate ()
+
+    !!!! This causes the pointer hiccup
+    alt_env(1)%pn%weight_expr => pt_weight%get_root_ptr ()
+    call simulation%init (.true., .true., global, alt_env=alt_env)
+
+  end subroutine simulations_10
+  
+end program main_ut