Updates CHANGELOG and adds Fortran sample code

Author: gnikit

CHANGELOG.md

@@ -7,6 +7,12 @@ and this project adheres to [Semantic Versioning](http://semver.org/).
 
 ## [Unreleased]
 
+### Changed
+
+- Fixes syntax highlighting for nested case-select constructs
+  ([#181](https://github.com/krvajal/vscode-fortran-support/issues/181)) via
+  ([#218](https://github.com/krvajal/vscode-fortran-support/pull/218))
+
 ## [2.2.1] - 2020-04-11
 
 ### Fixed

test/resources/class.f90

@@ -0,0 +1,41 @@
+module main
+
+   use iso_fortran_env, only: real64
+   implicit none
+   private
+
+  type, public :: test_t
+      real(real64) :: a, b
+  contains
+      procedure, private :: init_sub
+      generic :: init => init_sub
+  end type test_t
+
+   type :: node
+      private
+      type(node), pointer :: next => null()
+      class(*), allocatable :: item
+
+      contains
+         final :: node_finalizer
+
+   end type node
+
+  contains
+
+   subroutine init_sub(this, a, b)
+
+      class( test_t ) :: this
+      real(real64),intent(in) :: a, b
+
+      this%a = a
+      this%b = b
+
+   end subroutine init_sub
+
+   subroutine node_finalizer(a)
+      type(node) :: a
+
+   end subroutine node_finalizer
+
+end module main

test/resources/select_case.f90

@@ -0,0 +1,38 @@
+
+! ------------------------------------------------------------------------------
+!
+!  Tests the syntax highlighting of nested case select constructs is correct
+!-------------------------------------------------------------------------------
+
+program select_case_test
+   implicit none
+
+   integer :: i, j, k
+
+
+   select case(i)
+   case(1)
+      select case(j)
+      case(1)
+         print*, i, j
+      case(2)
+         print*, i, j
+      case default
+         print*, i, j
+      end select
+
+   case(2)
+      select case(k)
+      case(1)
+         print*, i, j
+      case(2)
+         print*, i, j
+      case default
+         print*, i, j
+      end select
+
+   case default
+      print*, i, j
+   end select
+
+end program select_case_test

test/resources/select_rank.f90

@@ -0,0 +1,85 @@
+
+
+! ------------------------------------------------------------------------------
+!
+!  Tests the syntax highlighting of nested rank select constructs is correct
+!  @note requires GCC 10.0+ to compile or ifort 2019.1+
+!-------------------------------------------------------------------------------
+
+program select_rank_test
+   implicit none
+
+   real, dimension(2, 2) :: a, b
+
+   a = -666.0; b = -666.0
+   call initialize(a)
+   call nested_initialise(a, b)
+
+   print*, a
+   print*, b
+
+   contains
+
+   subroutine initialize (arg)
+      real :: arg(..)
+      select rank (arg)
+        rank (0)   ! scalar
+          arg = 0.0
+        rank (1)
+          arg(:) = 0.0
+        rank (2)
+          arg(:, :) = 0.0
+        rank default
+          print *, "Subroutine initialize called with unexpected rank argument"
+      end select
+      return
+   end subroutine
+
+   subroutine nested_initialise(arg1, arg2)
+      !< @note this is meant to test the syntax highlighting, nothing else!
+      real :: arg1(..), arg2(..)
+      select rank (arg1)
+      rank (0)   ! scalar
+         arg1 = 0.0
+         select rank (arg2)
+         rank (0)   ! scalar
+            arg2 = 0.0
+         rank (1)
+            arg2(:) = 0.0
+         rank (2)
+            arg2(:, :) = 0.0
+         rank default
+            print *, "Subroutine initialize called with unexpected rank argument"
+         end select
+      rank (1)
+         arg1(:) = 0.0
+         select rank (arg2)
+         rank (0)   ! scalar
+            arg2 = 0.0
+         rank (1)
+            arg2(:) = 0.0
+         rank (2)
+            arg2(:, :) = 0.0
+         rank default
+            print *, "Subroutine initialize called with unexpected rank argument"
+         end select
+      rank (2)
+         arg1(:, :) = 0.0
+         select rank (arg2)
+         rank (0)   ! scalar
+            arg2 = 0.0
+         rank (1)
+            arg2(:) = 0.0
+         rank (2)
+            arg2(:, :) = 0.0
+         rank default
+            print *, "Subroutine initialize called with unexpected rank argument"
+         end select
+      rank default
+          print *, "Subroutine initialize called with unexpected rank argument"
+      end select
+      return
+
+   end subroutine nested_initialise
+
+end program select_rank_test

test/resources/select_type.f90

@@ -0,0 +1,63 @@
+
+! ------------------------------------------------------------------------------
+!
+!  Tests the syntax highlighting of nested type select constructs is correct
+!-------------------------------------------------------------------------------
+
+program select_type_test
+   implicit none
+
+
+   type :: point
+      real :: x, y
+   end type point
+
+   type, extends(point) :: point_3d
+      real :: z
+   end type point_3d
+
+   type, extends(point) :: color_point
+      integer :: color
+   end type color_point
+
+   type(point_3d), target :: p3
+   type(color_point), target :: c
+   class(point), pointer :: p_or_c
+   class(point), pointer :: p
+
+   p_or_c => c
+   p => p3
+   select type ( a => p_or_c )
+   class is ( point )
+      ! "class ( point ) :: a" implied here
+      print *, a%x, a%y ! this block executes
+      select type(a)
+      type is (point_3d)
+         print*, "type(point_3d)"
+      type is (color_point)
+         print*, "type(color_point)"
+      class default
+         print*, "no matching type"
+      end select
+
+   class is (color_point)  ! does not execute
+      select type(p)
+      class is (point_3d)
+         print*, "class(point_3d)"
+      class is (color_point)
+         print*, "class(color_point)"
+      class is (point)
+         print*, "class(point)"
+      class default
+         print*, "no matching class"
+      end select
+
+   type is ( point_3d ) ! does not execute
+      ! "type ( point_3d ) :: a" implied here
+      print *, a%x, a%y, a%z
+   class default
+      print*, "no matching class"
+   end select
+
+
+end program select_type_test