2 files changed, 134 insertions, 0 deletions
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 8b2afd2..b7c568e 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6244,6 +6244,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		      || gfc_expr_attr (e).allocatable)
 		    set_dtype_for_unallocated (&parmse, e);
 		  else if (e->expr_type == EXPR_VARIABLE
+			   && e->ref
+			   && e->ref->u.ar.type == AR_FULL
 			   && e->symtree->n.sym->attr.dummy
 			   && e->symtree->n.sym->as
 			   && e->symtree->n.sym->as->type == AS_ASSUMED_SIZE)
diff --git a/gcc/testsuite/gfortran.dg/PR94022.f90 b/gcc/testsuite/gfortran.dg/PR94022.f90
new file mode 100644
index 0000000..63b7d90
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR94022.f90
@@ -0,0 +1,132 @@
+! { dg-do run }
+!
+! Test the fix for PR94022
+!
+
+function isasa_f(a) result(s)
+  implicit none
+
+  integer, intent(in) :: a(..)
+  
+  logical :: s
+  
+  select rank(a)
+  rank(*)
+    s = .true.
+  rank default
+    s = .false.
+  end select
+  return
+end function isasa_f
+
+function isasa_c(a) result(s) bind(c)
+  use, intrinsic :: iso_c_binding, only: c_int, c_bool
+
+  implicit none
+
+  integer(kind=c_int), intent(in) :: a(..)
+  
+  logical(kind=c_bool) :: s
+  
+  select rank(a)
+  rank(*)
+    s = .true.
+  rank default
+    s = .false.
+  end select
+  return
+end function isasa_c
+
+program isasa_p
+
+  implicit none
+
+  interface
+    function isasa_f(a) result(s)
+      implicit none
+      integer, intent(in) :: a(..)
+      logical             :: s
+    end function isasa_f
+    function isasa_c(a) result(s) bind(c)
+      use, intrinsic :: iso_c_binding, only: c_int, c_bool
+      implicit none
+      integer(kind=c_int), intent(in) :: a(..)
+      logical(kind=c_bool)            :: s
+    end function isasa_c
+  end interface
+
+  integer, parameter :: sz = 7
+  integer, parameter :: lb = 3
+  integer, parameter :: ub = 9
+  integer, parameter :: ex = ub-lb+1
+
+  integer :: arr(sz,lb:ub)
+
+  arr = 1
+  if (asaf_a(arr, lb+1, ub-1)) stop 1
+  if (asaf_p(arr, lb+1, ub-1)) stop 2
+  if (asaf_a(arr, 2, ex-1))    stop 3
+  if (asaf_p(arr, 2, ex-1))    stop 4
+  if (asac_a(arr, lb+1, ub-1)) stop 5
+  if (asac_p(arr, lb+1, ub-1)) stop 6
+  if (asac_a(arr, 2, ex-1))    stop 7
+  if (asac_p(arr, 2, ex-1))    stop 8
+  
+  stop
+
+contains
+
+  function asaf_a(a, lb, ub) result(s)
+    integer, intent(in) :: lb
+    integer, target, intent(in) :: a(sz,lb:*)
+    integer, intent(in) :: ub
+
+    logical :: s
+
+    s = isasa_f(a(:,lb:ub))
+    return
+  end function asaf_a
+
+  function asaf_p(a, lb, ub) result(s)
+    integer,         intent(in) :: lb
+    integer, target, intent(in) :: a(sz,lb:*)
+    integer,         intent(in) :: ub
+
+    logical :: s
+
+    integer, pointer :: p(:,:)
+
+    p => a(:,lb:ub)
+    s = isasa_f(p)
+    return
+  end function asaf_p
+
+  function asac_a(a, lb, ub) result(s)
+    integer, intent(in) :: lb
+    integer, target, intent(in) :: a(sz,lb:*)
+    integer, intent(in) :: ub
+
+    logical :: s
+
+    s = logical(isasa_c(a(:,lb:ub)))
+    return
+  end function asac_a
+
+  function asac_p(a, lb, ub) result(s)
+    integer,         intent(in) :: lb
+    integer, target, intent(in) :: a(sz,lb:*)
+    integer,         intent(in) :: ub
+
+    logical :: s
+
+    integer, pointer :: p(:,:)
+
+    p => a(:,lb:ub)
+    s = logical(isasa_c(p))
+    return
+  end function asac_p
+
+end program isasa_p
+
+
+