gdb/testsuite/gdb.fortran/nested-funcs.f90

   1 ! Copyright 2016-2020 Free Software Foundation, Inc.\r
   2 !\r
   3 ! This program is free software; you can redistribute it and/or modify\r
   4 ! it under the terms of the GNU General Public License as published by\r
   5 ! the Free Software Foundation; either version 3 of the License, or\r
   6 ! (at your option) any later version.\r
   7 !\r
   8 ! This program is distributed in the hope that it will be useful,\r
   9 ! but WITHOUT ANY WARRANTY; without even the implied warranty of\r
  10 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\r
  11 ! GNU General Public License for more details.\r
  12 !\r
  13 ! You should have received a copy of the GNU General Public License\r
  14 ! along with this program.  If not, see <http://www.gnu.org/licenses/>.\r
  15 \r
  16 module mod1\r
  17   integer :: var_i = 1\r
  18   integer :: var_const\r
  19   parameter (var_const = 20)\r
  20 \r
  21 CONTAINS\r
  22 \r
  23   SUBROUTINE sub_nested_outer\r
  24     integer :: local_int\r
  25     character (len=20) :: name\r
  26 \r
  27     name = 'sub_nested_outer_mod1'\r
  28     local_int = 11\r
  29 \r
  30   END SUBROUTINE sub_nested_outer\r
  31 end module mod1\r
  32 \r
  33 ! Public sub_nested_outer\r
  34 SUBROUTINE sub_nested_outer\r
  35   integer :: local_int\r
  36   character (len=16) :: name\r
  37 \r
  38   name = 'sub_nested_outer external'\r
  39   local_int = 11\r
  40 END SUBROUTINE sub_nested_outer\r
  41 \r
  42 ! Needed indirection to call public sub_nested_outer from main\r
  43 SUBROUTINE sub_nested_outer_ind\r
  44   character (len=20) :: name\r
  45 \r
  46   name = 'sub_nested_outer_ind'\r
  47   CALL sub_nested_outer\r
  48 END SUBROUTINE sub_nested_outer_ind\r
  49 \r
  50 ! public routine with internal subroutine\r
  51 SUBROUTINE sub_with_sub_nested_outer()\r
  52   integer :: local_int\r
  53   character (len=16) :: name\r
  54 \r
  55   name = 'subroutine_with_int_sub'\r
  56   local_int = 1\r
  57 \r
  58   CALL sub_nested_outer  ! Should call the internal fct\r
  59 \r
  60 CONTAINS\r
  61 \r
  62   SUBROUTINE sub_nested_outer\r
  63     integer :: local_int\r
  64     local_int = 11\r
  65   END SUBROUTINE sub_nested_outer\r
  66 \r
  67 END SUBROUTINE sub_with_sub_nested_outer\r
  68 \r
  69 ! Main\r
  70 program TestNestedFuncs\r
  71   USE mod1, sub_nested_outer_use_mod1 => sub_nested_outer\r
  72   IMPLICIT NONE\r
  73 \r
  74   TYPE :: t_State\r
  75     integer :: code\r
  76   END TYPE t_State\r
  77 \r
  78   TYPE (t_State) :: v_state\r
  79   integer index, local_int\r
  80 \r
  81   index = 13\r
  82   CALL sub_nested_outer            ! Call internal sub_nested_outer\r
  83   CALL sub_nested_outer_ind        ! Call external sub_nested_outer via sub_nested_outer_ind\r
  84   CALL sub_with_sub_nested_outer   ! Call external routine with nested sub_nested_outer\r
  85   CALL sub_nested_outer_use_mod1   ! Call sub_nested_outer imported via module\r
  86   index = 11              ! BP_main\r
  87   v_state%code = 27\r
  88 \r
  89 CONTAINS\r
  90 \r
  91   SUBROUTINE sub_nested_outer\r
  92     integer local_int\r
  93     local_int = 19\r
  94     v_state%code = index + local_int   ! BP_outer\r
  95     call sub_nested_inner\r
  96     local_int = 22                     ! BP_outer_2\r
  97     RETURN\r
  98   END SUBROUTINE sub_nested_outer\r
  99 \r
 100   SUBROUTINE sub_nested_inner\r
 101     integer local_int\r
 102     local_int = 17\r
 103     v_state%code = index + local_int   ! BP_inner\r
 104     RETURN\r
 105   END SUBROUTINE sub_nested_inner\r
 106 \r
 107 end program TestNestedFuncs\r