============================================
Program
============================================

PROGRAM TEST
END PROGRAM

PROGRAM TEST
END PROGRAM TEST

----

(translation_unit
  (program
    (program_statement (name))
    (end_program_statement))
  (program
    (program_statement (name))
    (end_program_statement (name))))

============================================
Interface (explicit)
============================================

module unit_test_module
  private

  use iso_c_binding

  interface assert_equals
    module procedure assert_equals_int
    module procedure assert_equals_real8
  end interface

  real(8), save :: eps = epsilon(1.0d0)/epsilon(1.0)
  logical,save :: all_pass, passing
  character(5) :: nc = achar(27)//'[00m' ! reset color
  character(7) :: gr = achar(27)//'[0;32m' ! green
  character(7) :: rd = achar(27)//'[1;31m' ! red

  public :: assert_equals
  public :: all_pass

  contains

  function assert_equals_real8(val1, val2) result(passed)
    real(8) :: val1, val2
  end function

  function assert_equals_logi(val1, val2) result(passed)
    logical :: val1, val2
  end function
end module

----

(translation_unit
  (module (module_statement (name))
    (private_statement)
    (use_statement (module_name))
    (interface
      (interface_statement (name))
      (procedure_statement (method_name))
      (procedure_statement (method_name))
      (end_interface_statement))
    (variable_declaration
      (intrinsic_type)
      (size (argument_list (number_literal)))
      (type_qualifier)
      (assignment_statement
        (identifier)
        (math_expression
          (call_expression (identifier)
            (argument_list (number_literal)))
          (call_expression (identifier)
            (argument_list (number_literal))))))
    (variable_declaration (intrinsic_type) (type_qualifier) (identifier) (identifier))
    (variable_declaration
      (intrinsic_type)
      (size (argument_list (number_literal)))
      (assignment_statement (identifier)
        (concatenation_expression
          (call_expression (identifier) (argument_list (number_literal)))
          (string_literal))))
    (comment)
    (variable_declaration
      (intrinsic_type) (size (argument_list (number_literal)))
      (assignment_statement (identifier)
        (concatenation_expression
          (call_expression (identifier) (argument_list (number_literal)))
          (string_literal))))
    (comment)
    (variable_declaration
      (intrinsic_type) (size (argument_list (number_literal)))
      (assignment_statement
        (identifier)
        (concatenation_expression
          (call_expression (identifier) (argument_list (number_literal)))
          (string_literal))))
    (comment)
    (public_statement (identifier))
    (public_statement (identifier))
    (internal_procedures
      (contains_statement)
      (function
        (function_statement (name) (parameters (identifier) (identifier)) (function_result (identifier)))
        (variable_declaration
          (intrinsic_type)
          (size (argument_list  (number_literal)))
          (identifier)
          (identifier))
      (end_function_statement))
      (function
        (function_statement (name) (parameters (identifier) (identifier)) (function_result (identifier)))
        (variable_declaration (intrinsic_type) (identifier) (identifier))
      (end_function_statement)))
  (end_module_statement)))


============================================
Interface (explicit)
============================================

interface
  subroutine ex(a,b,c)
    implicit none
    real :: a,b(10,2)
    integer :: c
  end subroutine ex
  function why(t,f)
    implicit none
    logical,intent(in) :: t,f
    logical :: why
  end function why
end interface

----

(translation_unit
    (interface
      (interface_statement)
      (subroutine
        (subroutine_statement (name) (parameters (identifier) (identifier) (identifier)))
        (implicit_statement (none))
        (variable_declaration
          (intrinsic_type)
          (identifier)
          (call_expression
            (identifier)
            (argument_list (number_literal) (number_literal))))
        (variable_declaration (intrinsic_type) (identifier))
      (end_subroutine_statement (name)))
      (function
        (function_statement (name) (parameters (identifier) (identifier)))
        (implicit_statement (none))
        (variable_declaration (intrinsic_type) (type_qualifier) (identifier) (identifier))
        (variable_declaration (intrinsic_type) (identifier))
      (end_function_statement (name)))
    (end_interface_statement)))

============================================
Interface (generic)
============================================

interface swap
  module procedure complex_swap
  module procedure logical_swap
end interface

----
(translation_unit
    (interface
      (interface_statement (name))
      (procedure_statement (method_name))
      (procedure_statement (method_name))
      (end_interface_statement)))

============================================
Interface (operator)
============================================

interface operator (+)
  module procedure char_plus_int
  module procedure int_plus_char
end interface operator (+)

interface operator (.not.)
  module procedure int_not
  function real_not(a)
    real :: real_not
    real,intent(in) :: a
  end function
end interface operator (.not.)

----

(translation_unit
  (interface
    (interface_statement (operator))
    (procedure_statement (method_name))
    (procedure_statement (method_name))
  (end_interface_statement (operator)))
  (interface
    (interface_statement (operator))
    (procedure_statement (method_name))
    (function
      (function_statement (name) (parameters (identifier)))
      (variable_declaration (intrinsic_type) (identifier))
      (variable_declaration (intrinsic_type) (type_qualifier) (identifier))
    (end_function_statement))
  (end_interface_statement (operator))))

============================================
Interface (assignment)
============================================

interface assignment (=)
  module procedure int_equals_char
end interface assignment (=)

----

(translation_unit
  (interface
    (interface_statement (assignment))
    (procedure_statement (method_name))
  (end_interface_statement (assignment))))

============================================
Subroutine
============================================

pure recursive subroutine static_method(arg)
   integer, intent(in) :: arg
   REAL(8), SAVE :: counter
   counter = counter + arg
end subroutine static_method

subroutine parens_but_no_args()
end subroutine

subroutine exported_fun(arg1, arg2) bind(c)
end subroutine

subroutine exported_fun2() bind(c, name="f90_func")
end subroutine

SUBROUTINE WITH_INTERNAL_PROC
  integer :: cmd_stat

  CALL CHECK_RETURN_VAL("ls *", cmd_stat)

  CONTAINS
    SUBROUTINE CHECK_RETURN_VAL(cmd, istat)
      integer, intent(out) :: istat
      character(*), intent(in) :: cmd
      istat = SYSTEM(cmd)
      RETURN
    END SUBROUTINE
END SUBROUTINE

----

(translation_unit
  (subroutine
    (subroutine_statement
      (procedure_qualifier)
      (procedure_qualifier)
      (name)
      (parameters (identifier)))
    (variable_declaration (intrinsic_type) (type_qualifier) (identifier))
    (variable_declaration
      (intrinsic_type) (size (argument_list (number_literal))) (type_qualifier) (identifier))
    (assignment_statement
      (identifier) (math_expression (identifier) (identifier)))
    (end_subroutine_statement (name)))
  (subroutine
    (subroutine_statement (name))
    (end_subroutine_statement))
  (subroutine
    (subroutine_statement (name)
      (parameters (identifier) (identifier))
      (language_binding (identifier)))
    (end_subroutine_statement))
  (subroutine
    (subroutine_statement (name)
      (language_binding
        (identifier)
        (keyword_argument (identifier) (string_literal))))
    (end_subroutine_statement))
  (subroutine (subroutine_statement (name))
    (variable_declaration (intrinsic_type) (identifier))
    (subroutine_call (name) (argument_list (string_literal) (identifier)))
    (internal_procedures
      (contains_statement)
      (subroutine
        (subroutine_statement (name) (parameters (identifier) (identifier)))
        (variable_declaration (intrinsic_type) (type_qualifier) (identifier))
        (variable_declaration
          (intrinsic_type) (size (argument_list (assumed_size)))
          (type_qualifier)
          (identifier))
        (assignment_statement (identifier)
          (call_expression (identifier) (argument_list (identifier))))
        (keyword_statement)
    (end_subroutine_statement)))
  (end_subroutine_statement)))

============================================
Functions (simple)
============================================

real(8) function current_time()
  ! returns the wall clock time in seconds.
  use mpi
  current_time = mpi_wtime()
end function

type(object) function new_object
  ! returns the current date string
  TYPE(object) :: obj
  obj%counter = 0
  new_object = obj
end function

integer(8) function exported_fun(arg1, arg2) bind(c)
end function

complex(8) function exported_fun2() bind(c, name="f90_func")
end function

----

(translation_unit
  (function
    (function_statement
      (intrinsic_type) (size (argument_list (number_literal)))
      (name))
    (comment)
    (use_statement (module_name))
    (assignment_statement (identifier) (call_expression (identifier) (argument_list)))
  (end_function_statement))
  (function
    (function_statement (derived_type (type_name))
      (name))
    (comment)
    (variable_declaration (derived_type (type_name)) (identifier))
    (assignment_statement
      (derived_type_member_expression (identifier) (type_member))
      (number_literal))
    (assignment_statement (identifier) (identifier))
  (end_function_statement))
  (function
    (function_statement
      (intrinsic_type) (size (argument_list (number_literal)))
      (name)
      (parameters (identifier) (identifier))
       (language_binding (identifier)))
    (end_function_statement))
  (function
    (function_statement
      (intrinsic_type) (size (argument_list (number_literal)))
      (name)
      (language_binding
        (identifier)
        (keyword_argument (identifier) (string_literal))))
    (end_function_statement)))

============================================
Functions (complex)
============================================

pure elemental logical function test(x, y) result(value)
  REAL(8) :: x, y
  logical :: value = (x == y)

contains

  real function internal_proc result(x)
    real(8) x = 1.0
  end function

  subroutine increment(i)
    integer :: i
    i = i + 1
  end subroutine

end function test

----

(translation_unit
  (function
    (function_statement
      (procedure_qualifier)
      (procedure_qualifier)
      (intrinsic_type)
      (name)
      (parameters (identifier) (identifier))
      (function_result (identifier)))
    (variable_declaration
      (intrinsic_type) (size (argument_list  (number_literal)))
      (identifier)
      (identifier))
    (variable_declaration
      (intrinsic_type)
      (assignment_statement
        (identifier)
        (parenthesized_expression  (relational_expression (identifier) (identifier)))))
    (internal_procedures
      (contains_statement)
      (function
        (function_statement
          (intrinsic_type)
          (name)
          (function_result (identifier)))
        (variable_declaration
          (intrinsic_type) (size (argument_list (number_literal)))
          (assignment_statement (identifier) (number_literal)))
        (end_function_statement))
        (subroutine
          (subroutine_statement (name) (parameters (identifier)))
          (variable_declaration (intrinsic_type) (identifier))
          (assignment_statement
            (identifier)
            (math_expression (identifier) (number_literal)))
        (end_subroutine_statement)))
      (end_function_statement (name))))

============================================
Derived Type Variable Declarations
============================================

program test
  type, public :: custom_type
    sequence
    real(8) :: x,y,z
    integer :: w,h,l
    real(eb), allocatable, dimension(:, :, :) :: vals
    contains
       procedure, nopass, non_overridable :: static_method ! static method
       procedure instance_method ! instance method
       generic, pass :: binding_name => method_name, method_name2
  end type custom_type
end program

----

(translation_unit
  (program
    (program_statement (name))
    (derived_type_definition (derived_type_statement (type_qualifier) (type_name))
      (sequence_statement)
      (variable_declaration (intrinsic_type) (size (argument_list (number_literal)))
        (identifier)
        (identifier)
        (identifier))
      (variable_declaration (intrinsic_type)
        (identifier)
        (identifier)
        (identifier))
      (variable_declaration
        (intrinsic_type) (size (argument_list (identifier)))
        (type_qualifier)
        (type_qualifier
          (argument_list (extent_specifier) (extent_specifier) (extent_specifier)))
        (identifier))
        (derived_type_procedures
          (contains_statement)
          (procedure_statement (procedure_attribute) (procedure_attribute) (method_name))
          (comment)
          (procedure_statement (method_name))
          (comment)
          (procedure_statement (procedure_attribute) (binding_name) (method_name) (method_name)))
      (end_type_statement (name)))
  (end_program_statement)))
