[flang-commits] [flang] ddb3553 - [flang] Add missing source location to a semantic error message

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-10-06T13:50:36-07:00
New Revision: ddb35533e63a5cecd98e82247d1c0124beb37c6e

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

LOG: [flang] Add missing source location to a semantic error message

Ensure that the semantic error "An allocatable or pointer component
reference must be applied to a scalar base" is emitted with a source
code location.

Differential Revision: https://reviews.llvm.org/D135215

Added: 
    

Modified: 
    flang/lib/Semantics/expression.cpp
    flang/test/Semantics/expr-errors04.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 40e6bd29b824..fcf3664b0c69 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -1145,6 +1145,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::StructureComponent &sc) {
       return std::nullopt;
     } else if (std::optional<DataRef> dataRef{
                    ExtractDataRef(std::move(*dtExpr))}) {
+      auto restorer{GetContextualMessages().SetLocation(name)};
       if (auto component{
               CreateComponent(std::move(*dataRef), *sym, *dtSpec->scope())}) {
         return Designate(DataRef{std::move(*component)});

diff  --git a/flang/test/Semantics/expr-errors04.f90 b/flang/test/Semantics/expr-errors04.f90
index e627d3197923..b8e0f221215b 100644
--- a/flang/test/Semantics/expr-errors04.f90
+++ b/flang/test/Semantics/expr-errors04.f90
@@ -14,6 +14,8 @@ subroutine real_generic()
     complex :: c, c2(2)
     integer :: x, x2(2)
     character(10) :: s, s2(2)
+    real, pointer :: p
+    real, allocatable :: a
    contains
     procedure, nopass :: info1 => real_info1
     procedure, nopass :: info2 => real_info2
@@ -108,4 +110,17 @@ subroutine real_generic()
   !ERROR: Reference to rank-2 object 't1' has 1 subscripts
   call t%t3%t2%t1(1:)%g1
 
+  !ERROR: An allocatable or pointer component reference must be applied to a scalar base
+  print *, t(1)%t3(1)%t2(1)%t1%p
+  !ERROR: An allocatable or pointer component reference must be applied to a scalar base
+  print *, t%t3(1)%t2(1)%t1(1,1)%p
+  !ERROR: An allocatable or pointer component reference must be applied to a scalar base
+  print *, t(1)%t3(1)%t2(1)%t1%a
+  !ERROR: An allocatable or pointer component reference must be applied to a scalar base
+  print *, t%t3(1)%t2(1)%t1(1,1)%a
+  !ERROR: An allocatable or pointer component reference must be applied to a scalar base
+  t(1)%t3(1)%t2(1)%t1%p => null()
+  !ERROR: An allocatable or pointer component reference must be applied to a scalar base
+  t%t3(1)%t2(1)%t1(1,1)%p => null()
+
 end