From e39f608869b722fc49700e9ddca7812074753d7e Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Thu, 23 Feb 2017 20:44:10 +0100
Subject: Add testcase for #290

---
 testsuite/gna/issue290/TbNamesPkg.vhd | 89 +++++++++++++++++++++++++++++++++++
 1 file changed, 89 insertions(+)
 create mode 100644 testsuite/gna/issue290/TbNamesPkg.vhd

(limited to 'testsuite/gna/issue290/TbNamesPkg.vhd')

diff --git a/testsuite/gna/issue290/TbNamesPkg.vhd b/testsuite/gna/issue290/TbNamesPkg.vhd
new file mode 100644
index 000000000..8d5b00504
--- /dev/null
+++ b/testsuite/gna/issue290/TbNamesPkg.vhd
@@ -0,0 +1,89 @@
+--
+--  File Increment:         TbNamesPkg.vhd
+--  Design Unit Increment:  TbNamesPkg
+--  Revision:          STANDARD VERSION
+--
+--  Maintainer:        Jim Lewis      email:  jim@synthworks.com
+--  Contributor(s):
+--     Jim Lewis          SynthWorks
+--
+--
+--  Package Defines
+--      Data structure for Increment. 
+--
+--  Developed for:
+--        SynthWorks Design Inc.
+--        VHDL Training Classes
+--        11898 SW 128th Ave.  Tigard, Or  97223
+--        http://www.SynthWorks.com
+--
+--
+--  Revision History:
+--    Date      Version    Description
+--    05/2015   2015.06    Added input to Get to return when not initialized
+--
+--
+--  Copyright (c) 2010 - 2016 by SynthWorks Design Inc.  All rights reserved.
+--
+
+package TbNamesPkg is
+  type IncrementPType is protected
+    procedure Inc ;
+    impure function Get return integer ;
+  end protected IncrementPType ;
+  
+  procedure PrintNames ;
+  procedure CallPrintNames ; 
+end package TbNamesPkg ;
+
+--- ///////////////////////////////////////////////////////////////////////////
+--- ///////////////////////////////////////////////////////////////////////////
+--- ///////////////////////////////////////////////////////////////////////////
+
+package body TbNamesPkg is
+  type IncrementPType is protected body
+    variable IncrementVar : integer := 0 ;
+    
+    impure function PrintNamesFun(S : string) return integer is
+    begin 
+      report "IncrementVar'INSTANCE_NAME as a parameter: " & S ;
+      report "IncrementVar: INSTANCE_NAME  " & IncrementVar'INSTANCE_NAME  ;
+      report "IncrementVar: PATH_NAME      " & IncrementVar'PATH_NAME  ;
+      report "function PrintNamesFun: INSTANCE_NAME  " & PrintNamesFun'INSTANCE_NAME  ;
+      report "function PrintNamesFun: PATH_NAME      " & PrintNamesFun'PATH_NAME  ;
+      return 0 ; 
+    end function PrintNamesFun ; 
+   
+    variable Temp : integer := PrintNamesFun(IncrementVar'INSTANCE_NAME) ;
+
+    ------------------------------------------------------------
+    procedure Inc is
+    ------------------------------------------------------------
+    begin
+      IncrementVar := IncrementVar + 1 ;
+    end procedure Inc ;
+
+    ------------------------------------------------------------
+    impure function Get return integer is
+    ------------------------------------------------------------
+    begin
+      report "IncrementVar: INSTANCE_NAME  " & IncrementVar'INSTANCE_NAME  ;
+      report "IncrementVar: PATH_NAME      " & IncrementVar'PATH_NAME  ;
+      report "Method Get: INSTANCE_NAME  " & Get'INSTANCE_NAME  ;
+      report "Method Get: PATH_NAME      " & Get'PATH_NAME  ;
+      return IncrementVar ; 
+    end function Get ;
+  end protected body IncrementPType ;
+
+  
+  procedure PrintNames is
+  begin 
+    report "procedure PrintNames: INSTANCE_NAME  " & PrintNames'INSTANCE_NAME  ;
+    report "procedure PrintNames: PATH_NAME      " & PrintNames'PATH_NAME  ;
+  end procedure PrintNames ; 
+  
+  procedure CallPrintNames is 
+  begin
+    PrintNames ;
+  end procedure CallPrintNames ;
+end package body TbNamesPkg ;
-- 
cgit v1.2.3