gcc/testsuite/gfortran.dg/auto_save_2.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fno-automatic -finit-local-zero -fdump-tree-original" }
   3 !
   4 ! PR fortran/62309
   5 !
   6 ! Make sure variables are saved with -fno-automatic except in
   7 ! functions marked RECURSIVE, and that they are still initialized with
   8 ! -finit-local-zero.
   9 !
  10
  11 function f (x)
  12 implicit none
  13   integer f, x
  14   integer a ! should be SAVEd
  15   a = a + x ! should increment by y every time
  16   f = a
  17   return
  18 endfunction
  19
  20 function f2 (x)
  21 implicit none
  22   integer f2, x
  23   block
  24    named: block
  25     block
  26     integer a ! should be SAVEd
  27     a = a + x ! should increment by y every time
  28     f2 = a
  29     end block
  30    end block named
  31   end block
  32   return
  33 endfunction
  34
  35 recursive function g (x)
  36 implicit none
  37   integer g, x
  38   integer b ! should be automatic
  39   b = b + x ! should be set to y every time
  40   g = b
  41   return
  42 endfunction
  43
  44 recursive function g2 (x)
  45 implicit none
  46   integer g2, x
  47   block
  48    named: block
  49     block
  50     integer b ! should be automatic
  51     b = b + x ! should be set to y every time
  52     g2 = b
  53     end block
  54    end block named
  55   end block
  56   return
  57 endfunction
  58
  59 implicit none
  60 integer f, f2, g, g2
  61
  62 ! Should return static value of a; accumulates y
  63 if ( f(3) .ne. 3 ) call abort ()
  64 if ( f(4) .ne. 7 ) call abort ()
  65 if ( f(2) .ne. 9 ) call abort ()
  66
  67 if ( f2(3) .ne. 3 ) call abort ()
  68 if ( f2(4) .ne. 7 ) call abort ()
  69 if ( f2(2) .ne. 9 ) call abort ()
  70
  71 ! Should return automatic value of a; equal to y each time
  72 if ( g(3) .ne. 3 ) call abort ()
  73 if ( g(4) .ne. 4 ) call abort ()
  74 if ( g(2) .ne. 2 ) call abort ()
  75
  76 if ( g2(3) .ne. 3 ) call abort ()
  77 if ( g2(4) .ne. 4 ) call abort ()
  78 if ( g2(2) .ne. 2 ) call abort ()
  79
  80 end
  81
  82 ! { dg-final { scan-tree-dump-times "  static integer\\\(kind=4\\\) a = 0;" 2 "original" } }
  83 ! { dg-final { scan-tree-dump-times "  b = 0;" 2 "original" } }