From 31ffbf3a5f9aa852a6652f01b11728c38b440950 Mon Sep 17 00:00:00 2001
From: Kostis Sagonas <kostis@it.uu.se>
Date: Wed, 11 Oct 2017 00:03:43 +0200
Subject: hipe: Extend the basic_SUITE with one more test

that checks the construction of exception information.  The test is
taken from the compiler SUITE but part of it (the one that constructs
exceptions which differ between BEAM and HiPE) is commented out.
Related to the discussion of #1596.
---
 .../test/basic_SUITE_data/basic_exceptions.erl     | 118 ++++++++++++++++++++-
 1 file changed, 117 insertions(+), 1 deletion(-)

(limited to 'lib/hipe')

diff --git a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl
index 229a0516dc..d71b924d22 100644
--- a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl
+++ b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl
@@ -6,12 +6,13 @@
 %%%-------------------------------------------------------------------
 -module(basic_exceptions).
 
--export([test/0, test_catches/0]).
+-export([test/0]).
 
 %% functions used as arguments to spawn/3
 -export([bad_guy/2]).
 
 test() ->
+  ok = test_catches(),
   ok = test_catch_exit(42),
   ok = test_catch_throw(42),
   ok = test_catch_element(),
@@ -22,6 +23,7 @@ test() ->
   ok = test_pending_errors(),
   ok = test_bad_fun_call(),
   ok = test_guard_bif(),
+  ok = test_eclectic(),
   ok.
 
 %%--------------------------------------------------------------------
@@ -463,3 +465,117 @@ guard_bif('node/0', X, Y) when node() == Y ->
   {'node/0', X, Y};
 guard_bif('node/1', X, Y) when node(X) == Y ->
   {'node/1', X, Y}.
+
+%%--------------------------------------------------------------------
+%% Taken from trycatch_SUITE.erl (compiler test suite).
+%%
+%% Cases that are commented out contain exception information that was
+%% added to Erlang/OTP in commit e8d45ae14c6c3bdfcbbc7964228b004ef4f11ea6
+%% (May 2017) only in the BEAM emulator.  Thus, part of this test fails
+%% when compiled in native code.
+%% The remaining cases are uncommented so that they are properly tested
+%% in native code too.
+%%--------------------------------------------------------------------
+
+test_eclectic() ->
+  V = {make_ref(),3.1415926535,[[]|{}]},
+  {{value,{value,V},V},V} =
+    eclectic_1({foo,{value,{value,V}}}, undefined, {value,V}),
+  {{'EXIT',{V,[{?MODULE,foo,1,_}|_]}},V} =
+    eclectic_1({catch_foo,{error,V}}, undefined, {value,V}),
+  {{error,{exit,V},{'EXIT',V}},V} =
+    eclectic_1({foo,{error,{exit,V}}}, error, {value,V}),
+  %% {{value,{value,V},V},
+  %%        {'EXIT',{badarith,[{erlang,'+',[0,a],_},{?MODULE,my_add,2,_}|_]}}} =
+  %%     eclectic_1({foo,{value,{value,V}}}, undefined, {'add',{0,a}}),
+  {{'EXIT',V},V} =
+    eclectic_1({catch_foo,{exit,V}}, undefined, {throw,V}),
+  %% {{error,{'div',{1,0}},{'EXIT',{badarith,[{erlang,'div',[1,0],_},{?MODULE,my_div,2,_}|_]}}},
+  %%        {'EXIT',V}} =
+  %%     eclectic_1({foo,{error,{'div',{1,0}}}}, error, {exit,V}),
+  {{{error,V},{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}},
+   {'EXIT',V}} =
+    eclectic_1({catch_foo,{throw,{error,V}}}, undefined, {exit,V}),
+  %%
+  {{value,{value,{value,V},V}},V} =
+    eclectic_2({value,{value,V}}, undefined, {value,V}),
+  {{value,{throw,{value,V},V}},V} =
+    eclectic_2({throw,{value,V}}, throw, {value,V}),
+  {{caught,{'EXIT',V}},undefined} =
+    eclectic_2({value,{value,V}}, undefined, {exit,V}),
+  {{caught,{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}},undefined} =
+    eclectic_2({error,{value,V}}, throw, {error,V}),
+  %% The following fails in native code
+  %% %% {{caught,{'EXIT',{badarg,[{erlang,abs,[V],_}|_]}}},V} =
+  %% %%     eclectic_2({value,{'abs',V}}, undefined, {value,V}),
+  %% {{caught,{'EXIT',{badarith,[{erlang,'+',[0,a],_},{?MODULE,my_add,2,_}|_]}}},V} =
+  %%     eclectic_2({exit,{'add',{0,a}}}, exit, {value,V}),
+  {{caught,{'EXIT',V}},undefined} =
+    eclectic_2({value,{error,V}}, undefined, {exit,V}),
+  {{caught,{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}},undefined} =
+    eclectic_2({throw,{'div',{1,0}}}, throw, {error,V}),
+  ok.
+
+eclectic_1(X, C, Y) ->
+  erase(eclectic),
+  Done = make_ref(),
+  Try =
+    try case X of
+          {catch_foo,V} -> catch {Done,foo(V)};
+          {foo,V} -> {Done,foo(V)}
+        end of
+        {Done,D} -> {value,D,catch foo(D)};
+        {'EXIT',_}=Exit -> Exit;
+        D -> {D,catch foo(D)}
+    catch
+      C:D -> {C,D,catch foo(D)}
+    after
+      put(eclectic, catch foo(Y))
+    end,
+  {Try,erase(eclectic)}.
+
+eclectic_2(X, C, Y) ->
+  Done = make_ref(),
+  erase(eclectic),
+  Catch =
+    case
+      catch
+        {Done,
+         try foo(X) of
+             V -> {value,V,foo(V)}
+         catch
+           C:D -> {C,D,foo(D)}
+         after
+           put(eclectic, foo(Y))
+         end} of
+        {Done,Z} -> {value,Z};
+        Z -> {caught,Z}
+      end,
+  {Catch,erase(eclectic)}.
+
+foo({value,Value}) -> Value;
+foo({'div',{A,B}}) ->
+  my_div(A, B);
+foo({'add',{A,B}}) ->
+  my_add(A, B);
+foo({'abs',X}) ->
+  my_abs(X);
+foo({error,Error}) ->
+  erlang:error(Error);
+foo({throw,Throw}) ->
+  erlang:throw(Throw);
+foo({exit,Exit}) ->
+  erlang:exit(Exit);
+foo({raise,{Class,Reason}}) ->
+  erlang:raise(Class, Reason);
+foo(Term) when not is_atom(Term) -> Term.
+%%foo(Atom) when is_atom(Atom) -> % must not be defined!
+
+my_div(A, B) ->
+  A div B.
+
+my_add(A, B) ->
+  A + B.
+
+my_abs(X) ->
+  abs(X).
-- 
cgit v1.2.3