aboutsummaryrefslogtreecommitdiffstats
path: root/testsuite/gna/issue38/bugreport_aliasprotected.vhdl
blob: f9091f5f35805a4b7e4e8801b529fe69f9cd46c3 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
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 occurred ****************************
--		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;