From 6a25af7e804b49c5c3a8b64cd020f483b9607bce Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Thu, 22 Dec 2016 06:54:22 +0100 Subject: Add testcase for issue #38 --- .../gna/issue38/bugreport_aliasprotected.vhdl | 172 +++++++++++++++++++++ testsuite/gna/issue38/testsuite.sh | 25 +++ 2 files changed, 197 insertions(+) create mode 100644 testsuite/gna/issue38/bugreport_aliasprotected.vhdl create mode 100755 testsuite/gna/issue38/testsuite.sh (limited to 'testsuite') diff --git a/testsuite/gna/issue38/bugreport_aliasprotected.vhdl b/testsuite/gna/issue38/bugreport_aliasprotected.vhdl new file mode 100644 index 000000000..1483d55c8 --- /dev/null +++ b/testsuite/gna/issue38/bugreport_aliasprotected.vhdl @@ -0,0 +1,172 @@ +-- EMACS settings: -*- tab-width: 2; indent-tabs-mode: t -*- +-- vim: tabstop=2:shiftwidth=2:noexpandtab +-- kate: tab-width 2; replace-tabs off; indent-width 2; +-- ============================================================================= +-- Authors: Patrick Lehmann +-- Reproducer: Using aliases to protected type methods cause an exception. +-- +-- License: +-- ============================================================================= +-- Copyright 2007-2016 Technische Universitaet Dresden - Germany +-- Chair for VLSI-Design, Diagnostics and Architecture +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +-- ============================================================================= +-- +-- Issue 1: +-- When analyzed in VHDL-93 mode an error is reported: +-- .\bugreport_aliasprotected.vhdl:4:26: protected type not allowed in vhdl87/93 +-- .\bugreport_aliasprotected.vhdl:9:12: 'protected' is expected instead of 'protected' +-- Line 1 is perfectly clear, but what is the intension of line 2? +-- Is this follow up error necessary or should it have another message text? +-- +-- Issue 2: +-- Calling an aliases to a shared variable's method causes an exception in GHDL: +-- ******************** GHDL Bug occured **************************** +-- Please report this bug on https://github.com/tgingold/ghdl/issues +-- GHDL release: GHDL 0.34dev (commit: 2016-01-27; git branch: paebbels/master'; hash: d424eb8) [Dunoon edition] +-- Compiled with GNAT Version: GPL 2015 (20150428-49) +-- In directory: H:\Austausch\PoC\temp\ghdl\ +-- Command line: +-- C:\Tools\GHDL.new\bin\ghdl.exe -r --std=08 test +-- Exception TYPES.INTERNAL_ERROR raised +-- Exception information: +-- Exception name: TYPES.INTERNAL_ERROR +-- Message: trans.adb:487 +-- ****************************************************************** +-- The alias definition by itself is not causing any errors. In my big example, I +-- could at least use an alias to a procedure without parameters. This short example +-- throws exceptions on all 4 variants (with/without parameter; with/without return value). +-- +-- You can comment/uncomment the alias/wrapping function/procedure to cause the error. +-- +-- GHDL calls: +-- PS> ghdl.exe -a --std=08 .\bugreport_aliasprotected.vhdl +-- PS> ghdl.exe -r --std=08 test +-- +-- Expected output: +-- .\bugreport_aliasprotected.vhdl:163:16:@0ms:(report note): wrapGet: 7 expected: 7 +-- .\bugreport_aliasprotected.vhdl:165:16:@0ms:(report note): wrapGet: 5 expected: 5 +-- .\bugreport_aliasprotected.vhdl:166:16:@0ms:(report note): wrapExcahnge: 5 expected: 5 +-- .\bugreport_aliasprotected.vhdl:167:16:@0ms:(report note): wrapGet: 3 expected: 3 +-- .\bugreport_aliasprotected.vhdl:169:16:@0ms:(report note): wrapGet: 0 expected: 0 +-- +-- ============================================================================= +-- Protected type package +-- ============================================================================= +package pkg is + type T_INTEGER is protected + procedure Clear; + procedure Set(Value : INTEGER); + impure function Get return INTEGER; + impure function Exchange(Value : INTEGER) return INTEGER; + end protected; +end package; + +package body pkg is + type T_INTEGER is protected body + variable LocalVariable : INTEGER := 7; + + procedure Clear is + begin + LocalVariable := 0; + end procedure; + + procedure Set(Value : INTEGER) is + begin + LocalVariable := Value; + end procedure; + + impure function Get return INTEGER is + begin + return LocalVariable; + end function; + + impure function Exchange(Value : INTEGER) return INTEGER is + variable Result : INTEGER; + begin + Result := LocalVariable; + LocalVariable := Value; + return Result; + end function; + end protected body; +end package body; + +-- ============================================================================= +-- Wrapper package +-- ============================================================================= +use work.pkg.all; + +package wrapper is + shared variable MyBoolean : T_INTEGER; + + -- alias wrapClear is MyBoolean.Clear[]; -- if this alias is used, GHDL crashes + alias wrapperClear is MyBoolean.Clear[]; -- unused alias => no crash + procedure wrapClear; -- wrapped by a call chain => no crash + + -- alias wrapSet is MyBoolean.Set[INTEGER]; + procedure wrapSet(Value : INTEGER); + + -- alias wrapGet is MyBoolean.Get[return INTEGER]; + impure function wrapGet return INTEGER; + + -- alias wrapExchange is MyBoolean.Exchange[INTEGER return INTEGER]; + impure function wrapExchange(Value : INTEGER) return INTEGER; + +end package; + +package body wrapper is + procedure wrapClear is + begin + MyBoolean.Clear; + end procedure; + + procedure wrapSet(Value : INTEGER) is + begin + MyBoolean.Set(Value); + end procedure; + + impure function wrapGet return INTEGER is + begin + return MyBoolean.Get; + end function; + + impure function wrapExchange(Value : INTEGER) return INTEGER is + begin + return MyBoolean.Exchange(Value); + end function; +end package body; + +-- ============================================================================= +-- Testbench +-- ============================================================================= +use work.wrapper.all; + +entity test is +end entity; + + +architecture tb of test is +begin + process + begin + report "wrapGet: " & INTEGER'image(wrapGet) & " expected: 7" severity NOTE; + wrapSet(5); + report "wrapGet: " & INTEGER'image(wrapGet) & " expected: 5" severity NOTE; + report "wrapExcahnge: " & INTEGER'image(wrapExchange(3)) & " expected: 5" severity NOTE; + report "wrapGet: " & INTEGER'image(wrapGet) & " expected: 3" severity NOTE; + wrapperClear; + report "wrapGet: " & INTEGER'image(wrapGet) & " expected: 0" severity NOTE; + wait; + end process; +end architecture; diff --git a/testsuite/gna/issue38/testsuite.sh b/testsuite/gna/issue38/testsuite.sh new file mode 100755 index 000000000..3e5d71365 --- /dev/null +++ b/testsuite/gna/issue38/testsuite.sh @@ -0,0 +1,25 @@ +#! /bin/sh + +. ../../testenv.sh + +analyze_failure bugreport_aliasprotected.vhdl 2>log.txt + +if grep -q "'protected' is expected instead of 'protected'" log.txt; then + echo "Incorrect error message" + exit 1 +fi +rm log.txt + +clean test + +# TODO +if false; then +GHDL_STD_FLAGS=--std=08 + +analyze bugreport_aliasprotected.vhdl +simulate test + +clean test +fi + +echo "Test successful" -- cgit v1.2.3