[flang] Continue semantics checks after expression error

Change statement semantics to continue with checks after an error
in expression analysis. This allows the compiler to report more
compilation errors. It requires that statement semantics not assume
that every parser::Expr has a valid evaluate::Expr.

For example, the test cases in coarrays02.f90 can now be moved to
coarrays01.f90. Previously the errors like "Must be a scalar value"
from ExprChecker prevented other errors from being detected by
CoarrayChecker.

Change to a stable sort of messages so that they come out in a
deterministic order. Otherwise when there are two errors at the
same location (e.g. line 71 of coarrays01.f90) the test can fail
randomly.

Original-commit: flang-compiler/f18@f420d21909
Reviewed-on: https://github.com/flang-compiler/f18/pull/422
Tree-same-pre-rewrite: false

flang/lib/parser/message.cc

@@ -284,7 +284,7 @@ void Messages::Emit(
   for (const auto &msg : messages_) {
     sorted.push_back(&msg);
   }
-  std::sort(sorted.begin(), sorted.end(),
+  std::stable_sort(sorted.begin(), sorted.end(),
       [](const Message *x, const Message *y) { return x->SortBefore(*y); });
   for (const Message *msg : sorted) {
     msg->Emit(o, cooked, echoSourceLines);

flang/lib/semantics/semantics.cc

@@ -83,6 +83,12 @@ using StatementSemanticsPass2 = SemanticsVisitor<ArithmeticIfStmtChecker,
     AssignmentChecker, CoarrayChecker, DeallocateChecker, DoConcurrentChecker,
     IfStmtChecker, NullifyChecker, ReturnStmtChecker, StopChecker>;
 
+static bool PerformStatementSemantics(
+    SemanticsContext &context, const parser::Program &program) {
+  StatementSemanticsPass1{context}.Walk(program);
+  return StatementSemanticsPass2{context}.Walk(program);
+}
+
 SemanticsContext::SemanticsContext(
     const common::IntrinsicTypeDefaultKinds &defaultKinds,
     const parser::LanguageFeatureControl &languageFeatures)
@@ -135,8 +141,7 @@ bool Semantics::Perform() {
       parser::CanonicalizeDo(program_) &&  // force line break
       ResolveNames(context_, program_) &&
       RewriteParseTree(context_, program_) &&
-      StatementSemanticsPass1{context_}.Walk(program_) &&
-      StatementSemanticsPass2{context_}.Walk(program_) &&
+      PerformStatementSemantics(context_, program_) &&
       ModFileWriter{context_}.WriteAll();
 }
 

flang/test/semantics/CMakeLists.txt

@@ -98,7 +98,6 @@ set(ERROR_TESTS
   deallocate04.f90
   deallocate05.f90
   coarrays01.f90
-  coarrays02.f90
   altreturn01.f90
 # Issue 407
 #  altreturn02.f90

flang/test/semantics/coarrays01.f90

@@ -50,9 +50,11 @@ subroutine s3
   type :: team_type
   end type
   type :: foo
+    real :: a
   end type
   type(team_type) :: t1
   type(foo) :: t2
+  type(team_type) :: t3(3)
   real :: y[10,*]
   ! C1114
   !ERROR: Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV
@@ -62,7 +64,35 @@ subroutine s3
   change team(t2, x[10,*] => y)
   end team
   !ERROR: Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV
+  change team(t2%a, x[10,*] => y)
+  end team
+  !ERROR: Must be a scalar value, but is a rank-1 array
+  !ERROR: Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV
+  change team(t3, x[10,*] => y)
+  end team
+  !ERROR: Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV
   form team(1, t1)
   !ERROR: Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV
   form team(2, t2)
+  !ERROR: Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV
+  form team(2, t2%a)
+  !ERROR: Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV
+  form team(3, t3(2))
+  !ERROR: Must be a scalar value, but is a rank-1 array
+  !ERROR: Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV
+  form team(3, t3)
+end
+
+subroutine s4
+  use iso_fortran_env, only: team_type
+  complex :: z
+  integer :: i, j(10)
+  type(team_type) :: t, t2(2)
+  form team(i, t)
+  !ERROR: Must be a scalar value, but is a rank-1 array
+  form team(1, t2)
+  !ERROR: Must have INTEGER type, but is COMPLEX(4)
+  form team(z, t)
+  !ERROR: Must be a scalar value, but is a rank-1 array
+  form team(j, t)
 end

flang/test/semantics/coarrays02.f90

@@ -1,35 +0,0 @@
-! 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.
-
-! Test team-variable in FORM TEAM statement
-
-! Temporary, until we have real iso_fortran_env
-module iso_fortran_env
-  type :: team_type
-  end type
-end
-
-subroutine s1
-  use iso_fortran_env, only: team_type
-  complex :: z
-  integer :: i, j(10)
-  type(team_type) :: t, t2(2)
-  form team(i, t)
-  !ERROR: Must be a scalar value, but is a rank-1 array
-  form team(1, t2)
-  !ERROR: Must have INTEGER type, but is COMPLEX(4)
-  form team(z, t)
-  !ERROR: Must be a scalar value, but is a rank-1 array
-  form team(j, t)
-end