From ebcfd01ae37e240380911fd184946cabfa520464 Mon Sep 17 00:00:00 2001 From: Tim Keith Date: Tue, 26 Feb 2019 14:52:39 -0800 Subject: [PATCH] [flang] Fix bug with host-association in module procedure interface body A module procedure interface body can access entities in its host without an IMPORT statement. So the `ImportKind` of the scope created for such an interface body should be `Default`, not `None` as it is for other interface bodies. Original-commit: flang-compiler/f18@24bb2668fdb626a4df76719345b02e533d015d79 Reviewed-on: https://github.com/flang-compiler/f18/pull/305 Tree-same-pre-rewrite: false --- flang/lib/semantics/scope.cc | 4 ++-- flang/test/semantics/symbol02.f90 | 11 ++++++++++- 2 files changed, 12 insertions(+), 3 deletions(-) diff --git a/flang/lib/semantics/scope.cc b/flang/lib/semantics/scope.cc index fa80c4b..9be1c55 100644 --- a/flang/lib/semantics/scope.cc +++ b/flang/lib/semantics/scope.cc @@ -145,10 +145,10 @@ Scope::ImportKind Scope::GetImportKind() const { if (importKind_) { return *importKind_; } - if (symbol_) { + if (symbol_ && !symbol_->attrs().test(Attr::MODULE)) { if (auto *details{symbol_->detailsIf()}) { if (details->isInterface()) { - return ImportKind::None; // default for interface body + return ImportKind::None; // default for non-mod-proc interface body } } } diff --git a/flang/test/semantics/symbol02.f90 b/flang/test/semantics/symbol02.f90 index 92cff5a..abeb969 100644 --- a/flang/test/semantics/symbol02.f90 +++ b/flang/test/semantics/symbol02.f90 @@ -1,4 +1,4 @@ -! Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved. +! Copyright (c) 2018-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. @@ -22,6 +22,15 @@ module m !REF: /m/t !DEF: /m/x PUBLIC ObjectEntity TYPE(t) type(t) :: x + interface + !DEF: /m/s3 MODULE, PUBLIC Subprogram + !DEF: /m/s3/y ObjectEntity TYPE(t) + module subroutine s3(y) + !REF: /m/t + !REF: /m/s3/y + type(t) :: y + end subroutine + end interface contains !DEF: /m/s PUBLIC Subprogram subroutine s -- 2.7.4