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;
|
