maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[flang] Add static declaration checker; get call01.f90 to pass 

Original-commit: flang-compiler/f18@7cc5bc7617
Reviewed-on: https://github.com/flang-compiler/f18/pull/732
Tree-same-pre-rewrite: false
This commit is contained in:
peter klausler 2019-09-10 15:51:46 -07:00
parent 2ae26b8501
commit 9db810f5e3
6 changed files with 86 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
flang/lib/semantics/CMakeLists.txt
View File

@ -21,6 +21,7 @@ add_library(FortranSemantics
check-arithmeticif.cc
check-coarray.cc
check-deallocate.cc
check-declarations.cc
check-do.cc
check-if-stmt.cc
check-io.cc

65
flang/lib/semantics/check-declarations.cc Normal file
View File

@ -0,0 +1,65 @@
// 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.
// Static declaration checking
#include "semantics.h"
#include "tools.h"
namespace Fortran::semantics {
static void CheckSymbol(SemanticsContext &context, const Symbol &symbol) {
if (context.HasError(symbol)) {
return;
}
context.set_location(symbol.name());
if (IsAssumedLengthCharacterFunction(symbol)) { // C723
if (symbol.attrs().test(Attr::RECURSIVE)) {
context.Say(
"An assumed-length CHARACTER(*) function cannot be RECURSIVE."_err_en_US);
}
if (symbol.Rank() > 0) {
context.Say(
"An assumed-length CHARACTER(*) function cannot return an array."_err_en_US);
}
if (symbol.attrs().test(Attr::PURE)) {
context.Say(
"An assumed-length CHARACTER(*) function cannot be PURE."_err_en_US);
}
if (symbol.attrs().test(Attr::ELEMENTAL)) {
context.Say(
"An assumed-length CHARACTER(*) function cannot be ELEMENTAL."_err_en_US);
}
if (const Symbol * result{FindFunctionResult(symbol)}) {
if (result->attrs().test(Attr::POINTER)) {
context.Say(
"An assumed-length CHARACTER(*) function cannot return a POINTER."_err_en_US);
}
}
}
}
static void CheckScope(SemanticsContext &context, const Scope &scope) {
for (const auto &pair : scope) {
CheckSymbol(context, *pair.second);
}
for (const Scope &child : scope.children()) {
CheckScope(context, child);
}
}
void CheckDeclarations(SemanticsContext &context) {
CheckScope(context, context.globalScope());
}
}

4
flang/lib/semantics/expression.cc
View File

@ -1452,7 +1452,7 @@ auto ExpressionAnalyzer::Procedure(const parser::ProcedureDesignator &pd,
if (symbol.attrs().test(
semantics::Attr::NON_RECURSIVE)) { // 15.6.2.1(3)
if (auto *msg{Say(
"NON_RECURSIVE procedure '%s' cannot call itself"_err_en_US,
"NON_RECURSIVE procedure '%s' cannot call itself."_err_en_US,
n.source)}) {
msg->Attach(
symbol.name(), "definition of '%s'"_en_US, n.source);
@ -1460,7 +1460,7 @@ auto ExpressionAnalyzer::Procedure(const parser::ProcedureDesignator &pd,
} else if (IsAssumedLengthCharacterFunction(
symbol)) { // 15.6.2.1(3)
if (auto *msg{Say(
"assumed-length CHARACTER(*) function '%s' cannot call itself"_err_en_US,
"Assumed-length CHARACTER(*) function '%s' cannot call itself."_err_en_US,
n.source)}) {
msg->Attach(
symbol.name(), "definition of '%s'"_en_US, n.source);

1
flang/lib/semantics/semantics.cc
View File

@ -108,6 +108,7 @@ static bool PerformStatementSemantics(
SemanticsContext &context, parser::Program &program) {
ResolveNames(context, program);
RewriteParseTree(context, program);
CheckDeclarations(context);
StatementSemanticsPass1{context}.Walk(program);
return StatementSemanticsPass2{context}.Walk(program);
}

3
flang/lib/semantics/semantics.h
View File

@ -193,5 +193,8 @@ struct BaseChecker {
template<typename N> void Enter(const N &) {}
template<typename N> void Leave(const N &) {}
};
// Static declaration checks
void CheckDeclarations(SemanticsContext &);
}
#endif

28
flang/test/semantics/call01.f90
View File

@ -20,7 +20,7 @@ non_recursive function f01(n) result(res)
if (n <= 0) then
res = n
else
!ERROR: NON_RECURSIVE procedure 'f01' cannot call itself
!ERROR: NON_RECURSIVE procedure 'f01' cannot call itself.
res = n * f01(n-1) ! 15.6.2.1(3)
end if
end function
@ -35,69 +35,69 @@ non_recursive function f02(n) result(res)
end if
contains
integer function nested
!ERROR: NON_RECURSIVE procedure 'f02' cannot call itself
!ERROR: NON_RECURSIVE procedure 'f02' cannot call itself.
nested = n * f02(n-1) ! 15.6.2.1(3)
end function nested
end function
!ERROR: assumed-length character function cannot be RECURSIVE
!ERROR: An assumed-length CHARACTER(*) function cannot be RECURSIVE.
recursive character(*) function f03(n) ! C723
integer, value :: n
f03 = ''
end function
!ERROR: An assumed-length CHARACTER(*) function cannot be RECURSIVE.
recursive function f04(n) result(res) ! C723
integer, value :: n
!ERROR: assumed-length character function cannot be RECURSIVE
character(*) :: res
res = ''
end function
!ERROR: An assumed-length CHARACTER(*) function cannot return an array.
character(*) function f05()
!ERROR: assumed-length character function cannot return an array
dimension :: f05(1) ! C723
f05(1) = ''
end function
!ERROR: An assumed-length CHARACTER(*) function cannot return an array.
function f06()
!ERROR: assumed-length character function cannot return an array
character(*) :: f06(1) ! C723
f06(1) = ''
end function
!ERROR: An assumed-length CHARACTER(*) function cannot return a POINTER.
character(*) function f07()
!ERROR: assumed-length character function cannot return a POINTER
pointer :: f07 ! C723
character, target :: a = ' '
f07 => a
end function
!ERROR: An assumed-length CHARACTER(*) function cannot return a POINTER.
function f08()
!ERROR: assumed-length character function cannot return a POINTER
character(*), pointer :: f08 ! C723
character, target :: a = ' '
f08 => a
end function
!ERROR: assumed-length character function cannot be declared PURE
!ERROR: An assumed-length CHARACTER(*) function cannot be PURE.
pure character(*) function f09() ! C723
f09 = ''
end function
!ERROR: An assumed-length CHARACTER(*) function cannot be PURE.
pure function f10()
!ERROR: assumed-length character function cannot be declared PURE
character(*) :: f10 ! C723
f10 = ''
end function
!ERROR: assumed-length character function cannot be declared ELEMENTAL
!ERROR: An assumed-length CHARACTER(*) function cannot be ELEMENTAL.
elemental character(*) function f11(n) ! C723
integer, value :: n
f11 = ''
end function
!ERROR: An assumed-length CHARACTER(*) function cannot be ELEMENTAL.
elemental function f12(n)
!ERROR: assumed-length character function cannot be declared ELEMENTAL
character(*) :: f12 ! C723
integer, value :: n
f12 = ''
@ -109,7 +109,7 @@ function f13(n) result(res)
if (n <= 0) then
res = ''
else
!ERROR: assumed-length CHARACTER(*) function 'f13' cannot call itself
!ERROR: Assumed-length CHARACTER(*) function 'f13' cannot call itself.
res = f13(n-1) ! 15.6.2.1(3)
end if
end function
@ -124,7 +124,7 @@ function f14(n) result(res)
end if
contains
character(1) function nested
!ERROR: assumed-length CHARACTER(*) function 'f14' cannot call itself
!ERROR: Assumed-length CHARACTER(*) function 'f14' cannot call itself.
nested = f14(n-1) ! 15.6.2.1(3)
end function nested
end function