[flang-commits] [flang] 644b2aa - [flang] Support *length character length specifiers

[peter klausler via flang-commits]

Author: peter klausler
Date: 2019-07-08T14:07:56-07:00
New Revision: 644b2aabd0c85188d7d9e1a3688db636a49540bb

URL: https://github.com/llvm/llvm-project/commit/644b2aabd0c85188d7d9e1a3688db636a49540bb
DIFF: https://github.com/llvm/llvm-project/commit/644b2aabd0c85188d7d9e1a3688db636a49540bb.diff

LOG: [flang] Support *length character length specifiers

Original-commit: flang-compiler/f18 at 874b13b7d85837ddf9b76568ee3cd41cf28eb19b
Reviewed-on: https://github.com/flang-compiler/f18/pull/553
Tree-same-pre-rewrite: false

Added: 
    flang/test/semantics/symbol13.f90

Modified: 
    flang/lib/semantics/resolve-names.cc
    flang/test/semantics/CMakeLists.txt

Removed: 
    


################################################################################
diff  --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc
index 8b5707cab41f..6310bbd30fad 100644
--- a/flang/lib/semantics/resolve-names.cc
+++ b/flang/lib/semantics/resolve-names.cc
@@ -3832,6 +3832,20 @@ void DeclarationVisitor::SetType(
     const parser::Name &name, const DeclTypeSpec &type) {
   CHECK(name.symbol);
   auto &symbol{*name.symbol};
+  if (charInfo_.length.has_value()) {  // Declaration has "*length" (R723)
+    auto length{std::move(*charInfo_.length)};
+    charInfo_.length.reset();
+    if (type.category() == DeclTypeSpec::Character) {
+      auto kind{type.characterTypeSpec().kind()};
+      // Recurse with correct type.
+      SetType(name,
+          currScope().MakeCharacterType(std::move(length), std::move(kind)));
+      return;
+    } else {
+      Say(name,
+          "A length specifier cannot be used to declare the non-character entity '%s'"_err_en_US);
+    }
+  }
   auto *prevType{symbol.GetType()};
   if (!prevType) {
     symbol.SetType(type);

diff  --git a/flang/test/semantics/CMakeLists.txt b/flang/test/semantics/CMakeLists.txt
index d3683c9e2bbd..c6794e766e5f 100644
--- a/flang/test/semantics/CMakeLists.txt
+++ b/flang/test/semantics/CMakeLists.txt
@@ -156,6 +156,7 @@ set(SYMBOL_TESTS
   symbol10.f90
   symbol11.f90
   symbol12.f90
+  symbol13.f90
   kinds01.f90
   kinds03.f90
   procinterface01.f90

diff  --git a/flang/test/semantics/symbol13.f90 b/flang/test/semantics/symbol13.f90
new file mode 100644
index 000000000000..c6a136cb89fb
--- /dev/null
+++ b/flang/test/semantics/symbol13.f90
@@ -0,0 +1,36 @@
+! Copyright (c) 2019, NVIDIA CORPORATION.  All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+!     http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+
+! Old-style "*length" specifiers (R723)
+
+!DEF: /f1 Subprogram CHARACTER(1_8,1)
+!DEF: /f1/x1 INTENT(IN) ObjectEntity CHARACTER(2_4,1)
+!DEF: /f1/x2 INTENT(IN) ObjectEntity CHARACTER(3_8,1)
+character*1 function f1(x1, x2)
+ !DEF: /f1/n PARAMETER ObjectEntity INTEGER(4)
+ integer, parameter :: n = 2
+ !REF: /f1/n
+ !REF: /f1/x1
+ !REF: /f1/x2
+ !DEF: /len EXTERNAL (implicit) ProcEntity INTEGER(4)
+ character*(n), intent(in) :: x1, x2*(len(x1)+1)
+ !DEF: /f1/t DerivedType
+ type :: t
+  !REF: /len
+  !REF: /f1/x2
+  !DEF: /f1/t/c1 ObjectEntity CHARACTER(4_8,1)
+  !DEF: /f1/t/c2 ObjectEntity CHARACTER(6_8,1)
+  character*(len(x2)+1) :: c1, c2*6
+ end type t
+end function f1