diff options
| -rw-r--r-- | testsuite/gna/issue290/TbNames.vhd | 46 | ||||
| -rw-r--r-- | testsuite/gna/issue290/TbNamesPkg.vhd | 89 | ||||
| -rwxr-xr-x | testsuite/gna/issue290/testsuite.sh | 11 |
3 files changed, 146 insertions, 0 deletions
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" |