File: finalize_43.f90

package info (click to toggle)
gcc-arm-none-eabi 15%3A14.2.rel1-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 1,099,328 kB
  • sloc: cpp: 3,627,108; ansic: 2,571,498; ada: 834,230; f90: 235,082; makefile: 79,231; asm: 74,984; xml: 51,692; exp: 39,736; sh: 33,298; objc: 15,629; python: 15,069; fortran: 14,429; pascal: 7,003; awk: 5,070; perl: 3,106; ml: 285; lisp: 253; lex: 204; haskell: 135
file content (41 lines) | stat: -rw-r--r-- 1,117 bytes parent folder | download 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
 
! { dg-do run }
!
! Test the fix for PR80524, where gfortran on issued one final call
! For 'u' going out of scope. Two further call should be emitted; one
! for the lhs of the assignment in 's' and the other for the function
! result, which occurs after assignment.
!
! Contributed by Andrew Wood  <andrew@fluidgravity.co.uk>
!
MODULE m1
   IMPLICIT NONE
   integer :: counter = 0
   integer :: fval = 0
   TYPE t
      INTEGER :: i
      CONTAINS
         FINAL :: t_final
   END TYPE t
   CONTAINS
      SUBROUTINE t_final(this)
         TYPE(t) :: this
         counter = counter + 1
      END SUBROUTINE
      FUNCTION new_t()
         TYPE(t) :: new_t
         new_t%i = 1
         fval = new_t%i
         if (counter /= 0) stop 1   ! Finalization of 'var' after evaluation of 'expr'
      END FUNCTION new_t
      SUBROUTINE s
         TYPE(t) :: u
         u = new_t()
         if (counter /= 2) stop 2   ! Finalization of 'var' and 'expr'
      END SUBROUTINE s
END MODULE m1
PROGRAM prog
   USE m1
   IMPLICIT NONE
   CALL s
   if (counter /= 3) stop 3         ! Finalization of 'u' in 's'
END PROGRAM prog