From 3de1cba69a6be500d4679967394498173434b8d0 Mon Sep 17 00:00:00 2001
From: zhangruinan <zhangruinan@huawei.com>
Date: Tue, 21 Jun 2022 09:51:25 +0800
Subject: [PATCH] [flang2] Fix bug in implied DO expression in a used module

The variables in a common block from a module will be copied into
current scope when a USE exists. However, the dinit feature of those
copied variables was removed when lowering symbols in flang1. This
patch suppresses the transformation of those copied variables to the
corresponding constant initialized in the common block, since we cannot
get their initialization info anyway.
---
 .../inc/test-implied-do-in-module.mk          | 23 +++++++++++++++++++
 .../lit/test-implied-do-in-module.sh          |  9 ++++++++
 .../src/test-implied-do-in-module.f90         | 21 +++++++++++++++++
 tools/flang2/flang2exe/dinit.cpp              | 12 ++++++++--
 4 files changed, 63 insertions(+), 2 deletions(-)
 create mode 100644 test/f90_correct/inc/test-implied-do-in-module.mk
 create mode 100644 test/f90_correct/lit/test-implied-do-in-module.sh
 create mode 100644 test/f90_correct/src/test-implied-do-in-module.f90

diff --git a/test/f90_correct/inc/test-implied-do-in-module.mk b/test/f90_correct/inc/test-implied-do-in-module.mk
new file mode 100644
index 00000000000..1f3026fbfb5
--- /dev/null
+++ b/test/f90_correct/inc/test-implied-do-in-module.mk
@@ -0,0 +1,23 @@
+#
+# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+# See https://llvm.org/LICENSE.txt for license information.
+# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+#
+
+$(TEST): run
+
+
+build:  $(SRC)/$(TEST).f90
+	-$(RM) $(TEST).$(EXESUFFIX) core *.d *.mod FOR*.DAT FTN* ftn* fort.*
+	@echo ------------------------------------ building test $@
+	-$(CC) -c $(CFLAGS) $(SRC)/check.c -o check.$(OBJX)
+	-$(FC) -c $(FFLAGS) $(LDFLAGS) $(SRC)/$(TEST).f90 -o $(TEST).$(OBJX)
+	-$(FC) $(FFLAGS) $(LDFLAGS) $(TEST).$(OBJX) check.$(OBJX) $(LIBS) -o $(TEST).$(EXESUFFIX)
+
+
+run:
+	@echo ------------------------------------ executing test $(TEST)
+	$(TEST).$(EXESUFFIX)
+
+verify: ;
+
diff --git a/test/f90_correct/lit/test-implied-do-in-module.sh b/test/f90_correct/lit/test-implied-do-in-module.sh
new file mode 100644
index 00000000000..3880a96ea63
--- /dev/null
+++ b/test/f90_correct/lit/test-implied-do-in-module.sh
@@ -0,0 +1,9 @@
+#
+# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+# See https://llvm.org/LICENSE.txt for license information.
+# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+
+# Shared lit script for each tests. Run bash commands that run tests with make.
+
+# RUN: KEEP_FILES=%keep FLAGS=%flags TEST_SRC=%s MAKE_FILE_DIR=%S/.. bash %S/runmake | tee %t
+# RUN: cat %t | FileCheck %S/runmake
diff --git a/test/f90_correct/src/test-implied-do-in-module.f90 b/test/f90_correct/src/test-implied-do-in-module.f90
new file mode 100644
index 00000000000..952a56ceda9
--- /dev/null
+++ b/test/f90_correct/src/test-implied-do-in-module.f90
@@ -0,0 +1,21 @@
+! Part of the LLVM Project, under the Apache License v2.0 with LLVM
+! Exceptions.
+! See https://llvm.org/LICENSE.txt for license information.
+! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+!
+! Test the implied DO expression in module.
+!
+
+module mod_impliedDo
+  integer :: i
+  character(*), parameter :: a = "Hello world!"
+  character(*), parameter :: b1(2) = [(a(i:i+4),i=1,7,6)]
+end module
+
+program p
+  use mod_impliedDo
+  character(5) :: c(2)
+  c(1) = b1(1)
+  c(2) = b1(2)
+  call check(c, "Helloworld", 1)
+end program
diff --git a/tools/flang2/flang2exe/dinit.cpp b/tools/flang2/flang2exe/dinit.cpp
index f87fc57456c..987e3bd980a 100644
--- a/tools/flang2/flang2exe/dinit.cpp
+++ b/tools/flang2/flang2exe/dinit.cpp
@@ -5824,8 +5824,7 @@ eval_init_expr_item(CONST *cur_e)
     }
     if (PARAMG(cur_e->sptr) || (DOVARG(cur_e->sptr) && DINITG(cur_e->sptr)) ||
         (CCSYMG(cur_e->sptr) && DINITG(cur_e->sptr))) {
-      if (!PARAMVALG(cur_e->sptr) && DTY(DTYPEG(cur_e->sptr)) == TY_CHAR
-          && SCG(cur_e->sptr) == SC_STATIC) {
+      if (!PARAMVALG(cur_e->sptr) && DTY(DTYPEG(cur_e->sptr)) == TY_CHAR) {
         new_e = get_static_str(cur_e->sptr);
         break;
       }
@@ -5834,6 +5833,15 @@ eval_init_expr_item(CONST *cur_e)
       if (cur_e->mbr) {
         new_e->sptr = cur_e->mbr;
       }
+      break;
+    }
+    if (SCG(cur_e->sptr) == SC_CMBLK &&
+        FROMMODG(MIDNUMG(cur_e->sptr)) && MODCMNG(MIDNUMG(cur_e->sptr))) {
+      /* The dinit flag will be removed when lowering if the variable is from an
+       * external module. The branch deals with those variables from module
+       * commons to directly return the original variable.
+       */
+      new_e = clone_init_const(cur_e, true);
     }
     break;
   case AC_CONST: