added parsing for structure components

12 files changed, 111 insertions, 16 deletions

diff --git a/include/flang/AST/Expr.h b/include/flang/AST/Expr.h
index 8df5e15d0e..5bab348dc5 100644
--- a/include/flang/AST/Expr.h
+++ b/include/flang/AST/Expr.h
@@ -366,6 +366,27 @@ public:
 };
 
 //===----------------------------------------------------------------------===//
+/// MemberExpr - structure component.
+class MemberExpr : public DesignatorExpr {
+  const FieldDecl *Field;
+  MemberExpr(ASTContext &C, SourceLocation Loc, Expr *E,
+             const FieldDecl *F, QualType T);
+public:
+  static MemberExpr *Create(ASTContext &C, SourceLocation Loc,
+                            Expr *Target, const FieldDecl *Field,
+                            QualType T);
+
+  const FieldDecl *getField() const {
+    return Field;
+  }
+
+  static bool classof(const Expr *E) {
+    return E->getExprClass() == Expr::MemberExprClass;
+  }
+  static bool classof(const MemberExpr *) { return true; }
+};
+
+//===----------------------------------------------------------------------===//
 /// SubstringExpr - Returns a substring.
 class SubstringExpr : public DesignatorExpr {
 private:
diff --git a/include/flang/Basic/DiagnosticParseKinds.td b/include/flang/Basic/DiagnosticParseKinds.td
index 2c267cccc3..c30394f44b 100644
--- a/include/flang/Basic/DiagnosticParseKinds.td
+++ b/include/flang/Basic/DiagnosticParseKinds.td
@@ -21,6 +21,7 @@ def err_duplicate_declspec : Error<"duplicate '%0' declaration specifier">;
 def err_duplicate_len_selector : Error<
   "duplicate character length declaration specifier">;
 def err_unexpected_lparen : Error<"unexpected '('">;
+def err_unexpected_percent : Error<"unexpected '%'">;
 
 def err_expected_expression : Error<"expected an expression">;
 def err_expected_expression_after : Error<
diff --git a/include/flang/Basic/DiagnosticSemaKinds.td b/include/flang/Basic/DiagnosticSemaKinds.td
index 511e790e81..47e6303b70 100644
--- a/include/flang/Basic/DiagnosticSemaKinds.td
+++ b/include/flang/Basic/DiagnosticSemaKinds.td
@@ -341,6 +341,8 @@ def err_use_of_not_typename : Error<
   "invalid type name %0">;
 def err_record_member_not_sequence : Error<
   "member %0 requires a type with a 'sequence' attribute (%1 invalid)">;
+def err_no_member : Error<
+  "no member named %0 in %1">;
 
 }
 
diff --git a/include/flang/Basic/ExprNodes.td b/include/flang/Basic/ExprNodes.td
index e7e7abc9c9..c8f3d24427 100644
--- a/include/flang/Basic/ExprNodes.td
+++ b/include/flang/Basic/ExprNodes.td
@@ -29,6 +29,7 @@ def BinaryExpr : Expr;
 def DefinedBinaryOperatorExpr : DExpr<BinaryExpr>;
 
 def DesignatorExpr : Expr<1>;
+def MemberExpr : DExpr<DesignatorExpr>;
 def SubstringExpr : DExpr<DesignatorExpr>;
 def ArrayElementExpr : DExpr<DesignatorExpr>;
 def ArraySectionExpr : DExpr<DesignatorExpr>;
diff --git a/include/flang/Parse/Parser.h b/include/flang/Parse/Parser.h
index d2607116fa..32713f1043 100644
--- a/include/flang/Parse/Parser.h
+++ b/include/flang/Parse/Parser.h
@@ -419,7 +419,7 @@ private:
   ExprResult ParseArraySection();
   ExprResult ParseCoindexedNamedObject();
   ExprResult ParseComplexPartDesignator();
-  ExprResult ParseStructureComponent();
+  ExprResult ParseStructureComponent(ExprResult Target);
   ExprResult ParseSubstring(ExprResult Target);
   ExprResult ParseArraySubscript(ExprResult Target);
   ExprResult ParseArraySection(const char *PunctuationTok);
diff --git a/include/flang/Sema/Sema.h b/include/flang/Sema/Sema.h
index b73e335007..47b48e15c4 100644
--- a/include/flang/Sema/Sema.h
+++ b/include/flang/Sema/Sema.h
@@ -539,6 +539,11 @@ public:
                                       ArrayRef<Expr*> Arguments);
 
 
+  ExprResult ActOnStructureComponentExpr(ASTContext &C, SourceLocation Loc,
+                                         SourceLocation IDLoc,
+                                         const IdentifierInfo *IDInfo, Expr *Target);
+
+
   // Format
   StmtResult ActOnFORMAT(ASTContext &C, SourceLocation Loc,
                          FormatItemResult Items,
diff --git a/lib/AST/ASTDumper.cpp b/lib/AST/ASTDumper.cpp
index fc06cc4061..68879ba930 100644
--- a/lib/AST/ASTDumper.cpp
+++ b/lib/AST/ASTDumper.cpp
@@ -117,6 +117,7 @@ public:
   void VisitImplicitCastExpr(const ImplicitCastExpr *E);
   void VisitBinaryExpr(const BinaryExpr *E);
   void VisitDefinedBinaryOperatorExpr(const DefinedBinaryOperatorExpr *E);
+  void VisitMemberExpr(const MemberExpr *E);
   void VisitSubstringExpr(const SubstringExpr *E);
   void VisitArrayElementExpr(const ArrayElementExpr *E);
   void VisitArraySectionExpr(const ArraySectionExpr *E);
@@ -791,6 +792,11 @@ void ASTDumper::VisitDefinedBinaryOperatorExpr(const DefinedBinaryOperatorExpr *
   OS << ')';
 }
 
+void ASTDumper::VisitMemberExpr(const MemberExpr *E) {
+  dumpExpr(E->getTarget());
+  OS << " % " << E->getField()->getName();
+}
+
 void ASTDumper::VisitSubstringExpr(const SubstringExpr *E) {
   dumpExpr(E->getTarget());
   OS << '(';
diff --git a/lib/AST/Expr.cpp b/lib/AST/Expr.cpp
index c57992f8b2..61e881f408 100644
--- a/lib/AST/Expr.cpp
+++ b/lib/AST/Expr.cpp
@@ -181,6 +181,17 @@ SourceLocation DesignatorExpr::getLocStart() const {
   return Target->getLocStart();
 }
 
+MemberExpr::MemberExpr(ASTContext &C, SourceLocation Loc, Expr *E,
+                       const FieldDecl *F, QualType T)
+  : DesignatorExpr(MemberExprClass, T, Loc, E), Field(F) {
+}
+
+MemberExpr *MemberExpr::Create(ASTContext &C, SourceLocation Loc,
+                               Expr *Target, const FieldDecl *Field,
+                               QualType T) {
+  return new(C) MemberExpr(C, Loc, Target, Field, T);
+}
+
 SubstringExpr::SubstringExpr(ASTContext &C, SourceLocation Loc, Expr *E,
                              Expr *Start, Expr *End)
   : DesignatorExpr(SubstringExprClass, C.CharacterTy, Loc, E),
diff --git a/lib/Parse/ParseExpr.cpp b/lib/Parse/ParseExpr.cpp
index a95f55a042..ea626c5604 100644
--- a/lib/Parse/ParseExpr.cpp
+++ b/lib/Parse/ParseExpr.cpp
@@ -592,17 +592,26 @@ ExprResult Parser::ParseDesignator(bool IsLvalue) {
   while(true) {
     if(!E.isUsable())
       break;
-    if(!IsPresent(tok::l_paren))
-      break;
-    auto EType = E.get()->getType();
-    if(EType->isArrayType())
-      E = ParseArraySubscript(E);
-    else if(EType->isCharacterType())
-      E = ParseSubstring(E);
-    else {
-      Diag.Report(Tok.getLocation(), diag::err_unexpected_lparen);
-      return ExprError();
+    if(IsPresent(tok::l_paren)) {
+      auto EType = E.get()->getType();
+      if(EType->isArrayType())
+        E = ParseArraySubscript(E);
+      else if(EType->isCharacterType())
+        E = ParseSubstring(E);
+      else {
+        Diag.Report(Tok.getLocation(), diag::err_unexpected_lparen);
+        return ExprError();
+      }
+    } else if(IsPresent(tok::percent)) {
+      auto EType = E.get()->getType();
+      if(EType->isRecordType())
+        E = ParseStructureComponent(E);
+      else {
+        Diag.Report(Tok.getLocation(), diag::err_unexpected_percent);
+        return ExprError();
+      }
     }
+    else break;
   }
 
   return E;
@@ -776,10 +785,15 @@ ExprResult Parser::ParseComplexPartDesignator() {
 ///
 ///   R613:
 ///     structure-component :=
-///         data-ref
-ExprResult Parser::ParseStructureComponent() {
-  ExprResult E;
-  return E;
+///        designator % data-ref
+ExprResult Parser::ParseStructureComponent(ExprResult Target) {
+  auto Loc = ConsumeToken();
+  auto ID = Tok.getIdentifierInfo();
+  auto IDLoc = Tok.getLocation();
+  if(!ExpectAndConsume(tok::identifier))
+    return ExprError();
+  return Actions.ActOnStructureComponentExpr(Context, Loc, IDLoc, ID,
+                                             Target.get());
 }
 
 /// ParseSubstring - Parse a substring.
diff --git a/lib/Sema/Sema.cpp b/lib/Sema/Sema.cpp
index d2fb7f194d..8562ab6b11 100644
--- a/lib/Sema/Sema.cpp
+++ b/lib/Sema/Sema.cpp
@@ -1137,7 +1137,8 @@ StmtResult Sema::ActOnAssignmentStmt(ASTContext &C, SourceLocation Loc,
                                      ExprResult RHS, Expr *StmtLabel) {
   if(!isa<VarExpr>(LHS.get()) && !isa<ArrayElementExpr>(LHS.get()) &&
      !isa<ArraySectionExpr>(LHS.get()) &&
-     !isa<SubstringExpr>(LHS.get())) {
+     !isa<SubstringExpr>(LHS.get()) &&
+     !isa<MemberExpr>(LHS.get())) {
     Diags.Report(Loc,diag::err_expr_not_assignable) << LHS.get()->getSourceRange();
     return StmtError();
   }
diff --git a/lib/Sema/SemaExpr.cpp b/lib/Sema/SemaExpr.cpp
index 8e0a0eb315..7d39f81ed4 100644
--- a/lib/Sema/SemaExpr.cpp
+++ b/lib/Sema/SemaExpr.cpp
@@ -850,4 +850,23 @@ ExprResult Sema::ActOnTypeConstructorExpr(ASTContext &C, SourceLocation Loc,
   return TypeConstructorExpr::Create(C, Loc, Record, Args);
 }
 
+ExprResult Sema::ActOnStructureComponentExpr(ASTContext &C, SourceLocation Loc,
+                                             SourceLocation IDLoc,
+                                             const IdentifierInfo *IDInfo,
+                                             Expr *Target) {
+  auto RecordTy = Target->getType().getSelfOrArrayElementType()->asRecordType();
+  auto Record = RecordTy->getElement(0)->getParent();
+  auto PrevContext = CurContext;
+  CurContext = Record;
+  auto Field = dyn_cast_or_null<FieldDecl>(LookupIdentifier(IDInfo));
+  CurContext = PrevContext;
+  if(!Field) {
+    Diags.Report(IDLoc, diag::err_no_member)
+      << IDInfo << Target->getType().getSelfOrArrayElementType()
+      << Target->getSourceRange();
+    return ExprError();
+  }
+  return MemberExpr::Create(C, Loc, Target, Field, Field->getType());
+}
+
 } // namespace flang
diff --git a/test/Sema/type.f95 b/test/Sema/type.f95
index de2160ab3a..d140df399a 100644
--- a/test/Sema/type.f95
+++ b/test/Sema/type.f95
@@ -1,4 +1,6 @@
 ! RUN: %flang -verify -fsyntax-only < %s
+! RUN: %flang -fsyntax-only -verify -ast-print %s 2>&1 | %file_check %s
+
 PROGRAM typetest
 
   INTEGER Bar ! expected-note {{previous definition is here}}
@@ -32,11 +34,13 @@ PROGRAM typetest
   type(Point) p
   type(Triangle) tri
   integer i
+  character c
 
   type(zzzzz) zvar ! expected-error {{use of undeclared identifier 'zzzzz'}}
   type(Bar) barvar ! expected-error {{invalid type name 'bar'}}
 
   p = Point(1.0, 2.0)
+  p = Point(0,1) ! CHECK: point(real(0), real(1))
 
   p = i ! expected-error {{assigning to 'type point' from incompatible type 'integer'}}
   i = p ! expected-error {{assigning to 'integer' from incompatible type 'type point'}}
@@ -48,4 +52,14 @@ PROGRAM typetest
   p = Point(0.0, 1.0, 2.0) ! expected-error {{too many arguments to type constructor, expected 2, have 3}}
   p = Point() ! expected-error {{too few arguments to type constructor, expected 2, have 0}}
 
+  i = p%x + p%y
+  p%x = 1.0
+  p%y = p%x
+  tri%vertices(1) = p
+  p = tri%vertices(1)
+  tri%vertices = Point(0,0)
+
+  i = p%z ! expected-error {{no member named 'z' in 'type point'}}
+  c = p%x ! expected-error {{assigning to 'character' from incompatible type 'real'}}
+
 END PROGRAM typetest