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/TbNames.vhd    | 46 ++++++++++++++++++
 testsuite/gna/issue290/TbNamesPkg.vhd | 89 +++++++++++++++++++++++++++++++++++
 testsuite/gna/issue290/testsuite.sh   | 11 +++++
 3 files changed, 146 insertions(+)
 create mode 100644 testsuite/gna/issue290/TbNames.vhd
 create mode 100644 testsuite/gna/issue290/TbNamesPkg.vhd
 create mode 100755 testsuite/gna/issue290/testsuite.sh

(limited to 'testsuite')

diff --git a/testsuite/gna/issue290/TbNames.vhd b/testsuite/gna/issue290/TbNames.vhd
new file mode 100644
index 000000000..490033eda
--- /dev/null
+++ b/testsuite/gna/issue290/TbNames.vhd
@@ -0,0 +1,46 @@
+--
+--  File Increment:         TbNames.vhd
+--  Design Unit Increment:  TbNames
+--  Revision:          STANDARD VERSION
+--
+--  Maintainer:        Jim Lewis      email:  jim@synthworks.com
+--  Contributor(s):
+--     Jim Lewis          SynthWorks
+--
+--
+--  Purpose
+--      Test Names
+--
+--  Developed for:
+--        SynthWorks Design Inc.
+--        VHDL Training Classes
+--        11898 SW 128th Ave.  Tigard, Or  97223
+--        http://www.SynthWorks.com
+--
+--
+--  Revision History:
+--    Date      Version    Description
+--    
+--
+--
+--  Copyright (c) 2010 - 2016 by SynthWorks Design Inc.  All rights reserved.
+--
+
+use std.textio.all ;
+use work.TbNamesPkg.all ;
+
+entity TbNames is
+end entity TbNames ; 
+
+architecture T1 of TbNames is 
+  shared variable IncVar : IncrementPType ; 
+begin
+  main : process
+    variable ErrorCount : integer ; 
+  begin
+    PrintNames ; 
+    CallPrintNames ;
+    report "Get: INSTANCE_NAME " & IncVar.Get'Instance_Name;
+    wait;
+  end process main ; 
+end architecture T1 ; 
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 ;
diff --git a/testsuite/gna/issue290/testsuite.sh b/testsuite/gna/issue290/testsuite.sh
new file mode 100755
index 000000000..90d8a721e
--- /dev/null
+++ b/testsuite/gna/issue290/testsuite.sh
@@ -0,0 +1,11 @@
+#! /bin/sh
+
+. ../../testenv.sh
+
+export GHDL_STD_FLAGS=--std=08
+analyze TbNamesPkg.vhd TbNames.vhd
+elab_simulate TbNames
+
+clean
+
+echo "Test successful"
-- 
cgit v1.2.3