From 1a14b848cdb5bff43cee71a9dc53e589b608e899 Mon Sep 17 00:00:00 2001
From: Peter Hill <peter.hill@york.ac.uk>
Date: Tue, 4 Apr 2023 15:26:41 +0100
Subject: [PATCH] Avoid any potential out-of-bounds indexing in neasyf_type

Allocate a local variable with the same type as the input, but with
exactly one element. This way we can be sure we can index it correctly
to call the scalar version.

This shouldn't be a problem now that we explicitly disallow zero-sized
dimensions, but it's nice to be safe in case the user created the
dimensions some other way.
---
 src/neasyf.f90         | 28 +++++++++++++++++++++-------
 src/neasyf.type.in.f90 |  4 +++-
 2 files changed, 24 insertions(+), 8 deletions(-)

diff --git a/src/neasyf.f90 b/src/neasyf.f90
index f6c1051..dc5d40c 100644
--- a/src/neasyf.f90
+++ b/src/neasyf.f90
@@ -280,43 +280,57 @@ end function neasyf_type_scalar
   function neasyf_type_rank1(variable) result(nf_type)
     integer(nf_kind) :: nf_type
     class(*), dimension(:), intent(in) :: variable
-    nf_type = neasyf_type(variable(1))
+    class(*), dimension(:), allocatable :: local
+    allocate(local(1), mold=variable)
+    nf_type = neasyf_type(local(1))
   end function neasyf_type_rank1
 
   function neasyf_type_rank2(variable) result(nf_type)
     integer(nf_kind) :: nf_type
     class(*), dimension(:, :), intent(in) :: variable
-    nf_type = neasyf_type(variable(1, 1))
+    class(*), dimension(:, :), allocatable :: local
+    allocate(local(1, 1), mold=variable)
+    nf_type = neasyf_type(local(1, 1))
   end function neasyf_type_rank2
 
   function neasyf_type_rank3(variable) result(nf_type)
     integer(nf_kind) :: nf_type
     class(*), dimension(:, :, :), intent(in) :: variable
-    nf_type = neasyf_type(variable(1, 1, 1))
+    class(*), dimension(:, :, :), allocatable :: local
+    allocate(local(1, 1, 1), mold=variable)
+    nf_type = neasyf_type(local(1, 1, 1))
   end function neasyf_type_rank3
 
   function neasyf_type_rank4(variable) result(nf_type)
     integer(nf_kind) :: nf_type
     class(*), dimension(:, :, :, :), intent(in) :: variable
-    nf_type = neasyf_type(variable(1, 1, 1, 1))
+    class(*), dimension(:, :, :, :), allocatable :: local
+    allocate(local(1, 1, 1, 1), mold=variable)
+    nf_type = neasyf_type(local(1, 1, 1, 1))
   end function neasyf_type_rank4
 
   function neasyf_type_rank5(variable) result(nf_type)
     integer(nf_kind) :: nf_type
     class(*), dimension(:, :, :, :, :), intent(in) :: variable
-    nf_type = neasyf_type(variable(1, 1, 1, 1, 1))
+    class(*), dimension(:, :, :, :, :), allocatable :: local
+    allocate(local(1, 1, 1, 1, 1), mold=variable)
+    nf_type = neasyf_type(local(1, 1, 1, 1, 1))
   end function neasyf_type_rank5
 
   function neasyf_type_rank6(variable) result(nf_type)
     integer(nf_kind) :: nf_type
     class(*), dimension(:, :, :, :, :, :), intent(in) :: variable
-    nf_type = neasyf_type(variable(1, 1, 1, 1, 1, 1))
+    class(*), dimension(:, :, :, :, :, :), allocatable :: local
+    allocate(local(1, 1, 1, 1, 1, 1), mold=variable)
+    nf_type = neasyf_type(local(1, 1, 1, 1, 1, 1))
   end function neasyf_type_rank6
 
   function neasyf_type_rank7(variable) result(nf_type)
     integer(nf_kind) :: nf_type
     class(*), dimension(:, :, :, :, :, :, :), intent(in) :: variable
-    nf_type = neasyf_type(variable(1, 1, 1, 1, 1, 1, 1))
+    class(*), dimension(:, :, :, :, :, :, :), allocatable :: local
+    allocate(local(1, 1, 1, 1, 1, 1, 1), mold=variable)
+    nf_type = neasyf_type(local(1, 1, 1, 1, 1, 1, 1))
   end function neasyf_type_rank7
 
 
diff --git a/src/neasyf.type.in.f90 b/src/neasyf.type.in.f90
index b1acaca..8b87d02 100644
--- a/src/neasyf.type.in.f90
+++ b/src/neasyf.type.in.f90
@@ -1,5 +1,7 @@
   function neasyf_type_rank{n}(variable) result(nf_type)
     integer(nf_kind) :: nf_type
     class(*), dimension({array(n)}), intent(in) :: variable
-    nf_type = neasyf_type(variable({slice(n)}))
+    class(*), dimension({array(n)}), allocatable :: local
+    allocate(local({slice(n)}), mold=variable)
+    nf_type = neasyf_type(local({slice(n)}))
   end function neasyf_type_rank{n}