From 33aaaebc780bfb94fe59f38ca55ae4270afd1e1f Mon Sep 17 00:00:00 2001
From: Nick Gasson <nick@nickg.me.uk>
Date: Sat, 8 Oct 2022 09:31:13 +0100
Subject: [PATCH] Allow protected objects in concurrent procedure calls. Issue
 #547

---
 src/parse.c                 | 41 ++++++++++++++++++++++++----------
 src/simp.c                  |  2 ++
 test/regress/protected8.vhd | 44 +++++++++++++++++++++++++++++++++++++
 test/regress/testlist.txt   |  1 +
 4 files changed, 76 insertions(+), 12 deletions(-)
 create mode 100644 test/regress/protected8.vhd

diff --git a/src/parse.c b/src/parse.c
index e2106c5c..2fd1d56d 100644
--- a/src/parse.c
+++ b/src/parse.c
@@ -9482,11 +9482,20 @@ static tree_t p_concurrent_procedure_call_statement(ident_t label, tree_t name)
 
    const bool postponed = name == NULL && optional(tPOSTPONED);
 
-   tree_t call = tree_new(T_PCALL);
-   if (name == NULL)
+   tree_t call = NULL;
+   if (name == NULL) {
+      call = tree_new(T_PCALL);
       tree_set_ident2(call, p_identifier());
-   else
+   }
+   else if (tree_kind(name) == T_PROT_REF) {
+      call = tree_new(T_PROT_PCALL);
+      tree_set_ident2(call, tree_ident(name));
+      tree_set_name(call, tree_value(name));
+   }
+   else {
+      call = tree_new(T_PCALL);
       tree_set_ident2(call, tree_ident(name));
+   }
 
    if (optional(tLPAREN)) {
       p_actual_parameter_part(call);
@@ -9705,18 +9714,26 @@ static tree_t p_concurrent_statement(void)
          tree_t name = p_name(N_SUBPROGRAM), conc;
          if (peek() == tLE)
             conc = p_concurrent_signal_assignment_statement(label, name);
-         else if (tree_kind(name) == T_REF) {
-            if (tree_has_ref(name) && tree_kind(tree_ref(name)) == T_COMPONENT)
-               return p_component_instantiation_statement(label, name);
-            else
-               conc = p_concurrent_procedure_call_statement(label, name);
-         }
          else if (scan(tGENERIC, tPORT))
             return p_component_instantiation_statement(label, name);
          else {
-            parse_error(CURRENT_LOC, "expected concurrent statement");
-            drop_tokens_until(tSEMI);
-            conc = tree_new(T_CONCURRENT);
+            switch (tree_kind(name)) {
+            case T_REF:
+               if (tree_has_ref(name)) {
+                  tree_t decl = tree_ref(name);
+                  if (tree_kind(decl) == T_COMPONENT)
+                     return p_component_instantiation_statement(label, name);
+               }
+               // Fall-through
+            case T_PROT_REF:
+               conc = p_concurrent_procedure_call_statement(label, name);
+               break;
+            default:
+               parse_error(CURRENT_LOC, "expected concurrent statement %s",
+                           tree_kind_str(tree_kind(name)));
+               drop_tokens_until(tSEMI);
+               conc = tree_new(T_CONCURRENT);
+            }
          }
 
          if (postponed)
diff --git a/src/simp.c b/src/simp.c
index 00e57f2d..ad1df1c1 100644
--- a/src/simp.c
+++ b/src/simp.c
@@ -975,6 +975,8 @@ static void simp_build_wait(tree_t wait, tree_t expr, bool all)
 
    case T_FCALL:
    case T_PCALL:
+   case T_PROT_FCALL:
+   case T_PROT_PCALL:
       {
          tree_t decl = tree_ref(expr);
          const int nparams = tree_params(expr);
diff --git a/test/regress/protected8.vhd b/test/regress/protected8.vhd
new file mode 100644
index 00000000..f8cc6b77
--- /dev/null
+++ b/test/regress/protected8.vhd
@@ -0,0 +1,44 @@
+entity protected8 is
+end entity;
+
+architecture test of protected8 is
+
+    type SharedCounter is protected
+        procedure increment (N: Integer := 1);
+        procedure decrement (N: Integer := 1);
+        impure function value return Integer;
+    end protected SharedCounter;
+
+    type SharedCounter is protected body
+        variable counter: Integer := 0;
+
+        procedure increment (N: Integer := 1) is
+        begin
+            counter := counter + N;
+        end procedure increment;
+
+        procedure decrement (N: Integer := 1) is
+        begin
+            counter := counter - N;
+        end procedure decrement;
+
+        impure function value return Integer is
+        begin
+            return counter;
+        end function value;
+    end protected body;
+
+    shared variable v : SharedCounter;
+
+begin
+
+    p1: v.increment(n => 5);
+
+    p2: process is
+    begin
+        wait for 1 ns;
+        assert v.value = 5;
+        wait;
+    end process;
+
+end architecture;
diff --git a/test/regress/testlist.txt b/test/regress/testlist.txt
index 464f16fb..0e1d5e3e 100644
--- a/test/regress/testlist.txt
+++ b/test/regress/testlist.txt
@@ -656,3 +656,4 @@ issue520        normal,2008
 issue542        normal
 issue540        normal,2008
 issue547        normal
+protected8      normal,2002
-- 
2.39.2