[DebugInfo] Debug support for array parameters with pointer/allocatab…

…le attribute

test/debug_info/allocatable_arr_param.f90

@@ -0,0 +1,41 @@
+!RUN: %flang -gdwarf-4 -S -emit-llvm %s -o - | FileCheck %s
+
+!CHECK-LABEL: define void @callee_
+!CHECK: call void @llvm.dbg.declare(metadata i64* %"array$p", metadata [[DLOC:![0-9]+]]
+!CHECK-NEXT: call void @llvm.dbg.declare(metadata i64* %"array$p", metadata [[ALLOCATED:![0-9]+]]
+!CHECK-NEXT: call void @llvm.dbg.declare(metadata i64* %"array$sd", metadata [[ARRAY:![0-9]+]], metadata !DIExpression())
+!CHECK: [[ARRAY]] = !DILocalVariable(name: "array", arg: 1,
+!CHECK-SAME: type: [[TYPE:![0-9]+]]
+!CHECK: [[TYPE]] = !DICompositeType(tag: DW_TAG_array_type,
+!CHECK-SAME: dataLocation: [[DLOC]], allocated: [[ALLOCATED]]
+
+subroutine callee (array)
+  integer, allocatable :: array(:, :)
+  integer :: local = 4
+
+  do i=LBOUND (array, 2), UBOUND (array, 2), 1
+     do j=LBOUND (array, 1), UBOUND (array, 1), 1
+        write(*, fmt="(i4)", advance="no") array (j, i)
+     end do
+     print *, ""
+  end do
+
+  local = local / 2
+  print *, "local = ", local
+end subroutine callee
+
+program caller
+
+  interface
+     subroutine callee (array)
+       integer, allocatable :: array(:, :)
+     end subroutine callee
+  end interface
+
+  integer, allocatable :: caller_arr(:, :)
+  allocate(caller_arr(10, 10))
+  caller_arr = 99
+  caller_arr(2,2) = 88
+  call callee (caller_arr)
+  print *, ""
+end program caller

test/debug_info/cray_ptr_param.f90

@@ -0,0 +1,24 @@
+!RUN: %flang -gdwarf-4 -S -emit-llvm %s -o - | FileCheck %s
+
+!CHECK-LABEL: define internal void @main_callee
+!CHECK: call void @llvm.dbg.declare(metadata i64* %callee_ptr, metadata [[CALLEE_PTR:![0-9]+]]
+!CHECK: [[CALLEE_PTR]] = !DILocalVariable(name: "callee_ptr", arg: 1
+
+program main
+  pointer (ptr, b)
+  integer :: a(10), b(10)
+  a = (/1,2,3,4,5,6,7,8,9,10/)
+  call callee(ptr)
+  print *, b 
+  print *, a
+  print *, ptr
+contains
+  subroutine callee(callee_ptr)
+    pointer(callee_ptr, callee_pte)
+    integer, allocatable :: callee_pte(:)
+    allocate (callee_pte(10))
+    callee_pte = (/5,4,5,4,5,4,5,4,5,4/)
+    print *,callee_ptr
+    print *,callee_pte
+  end subroutine
+end

test/debug_info/pointer_arr_param.f90

@@ -0,0 +1,44 @@
+!RUN: %flang -gdwarf-4 -S -emit-llvm %s -o - | FileCheck %s
+
+!CHECK-LABEL: define void @callee_
+!CHECK: call void @llvm.dbg.declare(metadata i64* %"array$p", metadata [[DLOC:![0-9]+]]
+!CHECK-NEXT: call void @llvm.dbg.declare(metadata i64* %"array$p", metadata [[ASSOCIATED:![0-9]+]]
+!CHECK-NEXT: call void @llvm.dbg.declare(metadata i64* %"array$sd", metadata [[ARRAY:![0-9]+]], metadata !DIExpression())
+!CHECK: [[ARRAY]] = !DILocalVariable(name: "array", arg: 1, 
+!CHECK-SAME: type: [[TYPE:![0-9]+]]
+!CHECK: [[TYPE]] = !DICompositeType(tag: DW_TAG_array_type,
+!CHECK-SAME: dataLocation: [[DLOC]], associated: [[ASSOCIATED]]
+
+subroutine callee (array)
+  integer, pointer :: array(:, :)
+  integer :: local = 4
+
+  do i=LBOUND (array, 2), UBOUND (array, 2), 1
+     do j=LBOUND (array, 1), UBOUND (array, 1), 1
+        write(*, fmt="(i4)", advance="no") array (j, i)
+     end do
+     print *, ""
+  end do
+
+  local = local / 2
+  print *, "local = ", local
+end subroutine callee
+
+program caller
+
+  interface
+     subroutine callee (array)
+       integer, pointer :: array(:, :)
+     end subroutine callee
+  end interface
+
+  integer, pointer :: caller_arr(:, :)
+  integer, target :: tgt_arr(10,10)
+  tgt_arr = 99
+  tgt_arr(2,2) = 88
+
+  caller_arr => tgt_arr
+  call callee (caller_arr)
+
+  print *, ""
+end program caller

tools/flang2/flang2exe/cgmain.cpp

@@ -12697,7 +12697,16 @@ INLINE static void
 formalsAddDebug(SPTR sptr, unsigned i, LL_Type *llType, bool mayHide)
 {
   if (formalsNeedDebugInfo(sptr)) {
-    LL_DebugInfo *db = cpu_llvm_module->debug_info;
+    bool is_ptr_alc_arr = false;
+    SPTR new_sptr = (SPTR)REVMIDLNKG(sptr);
+    if (CCSYMG(sptr) /* Otherwise it can be a cray pointer */ &&
+        (new_sptr && (STYPEG(new_sptr) == ST_ARRAY) &&
+         (POINTERG(new_sptr) || ALLOCATTRG(new_sptr))) &&
+        SDSCG(new_sptr)) {
+      is_ptr_alc_arr = true;
+      sptr = new_sptr;
+    }
+    LL_DebugInfo *db = current_module->debug_info;
     LL_MDRef param_md = lldbg_emit_param_variable(
         db, sptr, BIH_FINDEX(gbl.entbih), i, CCSYMG(sptr));
     if (!LL_MDREF_IS_NULL(param_md)) {
@@ -12706,10 +12715,11 @@ formalsAddDebug(SPTR sptr, unsigned i, LL_Type *llType, bool mayHide)
                               ? NULL
                               : cons_expression_metadata_operand(llTy);
       OperandFlag_t flag = (mayHide && CCSYMG(sptr)) ? OPF_HIDDEN : OPF_NONE;
-      // For assumed shape and assumed rank array, pass descriptor in place of
-      // base address.
+      // For pointer, allocatable, assumed shape and assumed rank arrays, pass
+      // descriptor in place of base address.
       if (ll_feature_debug_info_ver90(&cpu_llvm_module->ir) &&
-          (ASSUMRANKG(sptr) || ASSUMSHPG(sptr)) && SDSCG(sptr))
+          (is_ptr_alc_arr || ASSUMRANKG(sptr) || ASSUMSHPG(sptr)) &&
+          SDSCG(sptr))
         sptr = SDSCG(sptr);
       insert_llvm_dbg_declare(param_md, sptr, llTy, exprMDOp, flag);
     }

tools/flang2/flang2exe/lldebug.cpp

@@ -3009,10 +3009,9 @@ static LL_MDRef lldbg_emit_type(LL_DebugInfo *db, DTYPE dtype, SPTR sptr,
                 SPTR datasptr = MIDNUMG(sptr);
                 if (datasptr == NOSYM)
                   datasptr = SYMLKG(sptr);
-                if (SCG(datasptr) == SC_DUMMY) {
-                  // TODO: we want to generate local variable carrying
-                  // datalocation, but enclosing scope is not yet ready.
-                  // we shall solve it separately.
+                if ((SCG(datasptr) == SC_DUMMY) && !db->cur_subprogram_mdnode) {
+                  // If cur_subprogram_md is not yet ready, we are interested
+                  // only in type. datalocation is about value than type. So
                 } else {
                   LL_Type *dataloctype = LLTYPE(datasptr);
                   /* make_lltype_from_sptr() should have added a pointer to
@@ -3604,6 +3603,9 @@ lldbg_emit_param_variable(LL_DebugInfo *db, SPTR sptr, int findex, int parnum,
       (ASSUMRANKG(sptr) || ASSUMSHPG(sptr)) && SDSCG(sptr)) {
     type_mdnode = lldbg_emit_type(db, dtype, SDSCG(sptr), findex, is_reference,
                                   true, false, sptr);
+  } else if (ALLOCATTRG(sptr) || POINTERG(sptr)) {
+    type_mdnode = lldbg_emit_type(db, dtype, sptr, findex, is_reference, true,
+                                  false, MIDNUMG(sptr));
   } else {
     type_mdnode =
         lldbg_emit_type(db, dtype, sptr, findex, is_reference, true, false);