OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [alloc_comp_assign_12.f03] - Blame information for rev 749

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
! PR48351 - automatic (re)allocation of allocatable components of class objects
3
!
4
! Contributed by Nasser M. Abbasi on comp.lang.fortran
5
!
6
module foo
7
  implicit none
8
  type :: foo_t
9
    private
10
    real, allocatable :: u(:)
11
  contains
12
    procedure :: make
13
    procedure :: disp
14
  end type foo_t
15
contains
16
  subroutine make(this,u)
17
    implicit none
18
    class(foo_t) :: this
19
    real, intent(in) :: u(:)
20
    this%u = u(int (u))       ! The failure to allocate occurred here.
21
    if (.not.allocated (this%u)) call abort
22
  end subroutine make
23
  function disp(this)
24
    implicit none
25
    class(foo_t) :: this
26
    real, allocatable :: disp (:)
27
    if (allocated (this%u)) disp = this%u
28
  end function
29
end module foo
30
 
31
program main2
32
  use foo
33
  implicit none
34
  type(foo_t) :: o
35
  real, allocatable :: u(:)
36
  u=real ([3,2,1,4])
37
  call o%make(u)
38
  if (any (int (o%disp()) .ne. [1,2,3,4])) call abort
39
  u=real ([2,1])
40
  call o%make(u)
41
  if (any (int (o%disp()) .ne. [1,2])) call abort
42
end program main2
43
! { dg-final { cleanup-modules "foo" } }
44
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.