diff --git a/src/vcode.c b/src/vcode.c index 556bf8c9c..36569285a 100644 --- a/src/vcode.c +++ b/src/vcode.c @@ -379,6 +379,7 @@ void vcode_heap_allocate(vcode_reg_t reg) case VCODE_OP_ADDRESS_OF: case VCODE_OP_LINK_VAR: case VCODE_OP_LINK_PACKAGE: + case VCODE_OP_CONTEXT_UPREF: break; case VCODE_OP_ALLOC: @@ -445,7 +446,13 @@ void vcode_heap_allocate(vcode_reg_t reg) break; case VCODE_OP_FCALL: - // Must have been safety checked by definition + for (int i = 0; i < defn->args.count; i++) { + const vtype_kind_t rkind = vcode_reg_kind(reg); + if (rkind == VCODE_TYPE_POINTER || rkind == VCODE_TYPE_UARRAY) { + // Function may return a pointer to its argument + vcode_heap_allocate(defn->args.items[i]); + } + } break; case VCODE_OP_RECORD_REF: diff --git a/test/regress/func25.vhd b/test/regress/func25.vhd new file mode 100644 index 000000000..8724117bd --- /dev/null +++ b/test/regress/func25.vhd @@ -0,0 +1,37 @@ +entity func25 is +end entity; + +architecture test of func25 is + + function change_bounds (s : string; l, r : positive) return string is + alias ss : string(l to r) is s; + begin + return ss; + end function; + + impure function get_string (c : character) return string is + variable s : string(1 to 15); + begin + s := "hello, world! " & c; + return change_bounds(s, 101, 115); -- Returns a pointer to S + end function; + + function get_left (s : string) return positive is + begin + return s'left; + end function; + + signal c : character := 'x'; + +begin + + p1: process is + begin + wait for 1 ns; + report get_string(c); + assert get_string(c) = "hello, world! x"; + assert get_left(get_string(c)) = 101; + wait; + end process; + +end architecture; diff --git a/test/regress/testlist.txt b/test/regress/testlist.txt index 3e02a15fd..bf6837d1b 100644 --- a/test/regress/testlist.txt +++ b/test/regress/testlist.txt @@ -851,3 +851,4 @@ driver18 normal,2008 vhpi9 normal,vhpi issue730 normal,2008 driver19 normal,2008 +func25 normal