Merge pull request #1564 from jakub-gonet/jgonet/is-record

Add `erlang:is_record/2`

These changes are made under both the "Apache 2.0" and the "GNU Lesser General
Public License 2.1 or later" license terms (dual license).

SPDX-License-Identifier: Apache-2.0 OR LGPL-2.1-or-later

Author: bettio

CHANGELOG.md

@@ -15,6 +15,7 @@ with nodejs and emscripten)
 - Added documentation and function specs for uart driver
 - Added `uart:read/2` with a timeout parameter.
 - Missing `erlang:is_function/2` BIF
+- Added `erlang:is_record/2`
 
 ### Fixed
 

libs/estdlib/src/erlang.erl

@@ -37,6 +37,7 @@
     md5/1,
     is_map/1,
     is_map_key/2,
+    is_record/2,
     map_size/1,
     map_get/2,
     monotonic_time/1,
@@ -396,6 +397,17 @@ apply(Function, Args) ->
 is_map(_Map) ->
     erlang:nif_error(undefined).
 
+%%-----------------------------------------------------------------------------
+%% @param   Term
+%% @param   RecordTag    atom representing tuple tag
+%%
+%% @doc     Returns true if Term is a tuple and its first element is RecordTag, false otherwise.
+%% @end
+%%-----------------------------------------------------------------------------
+-spec is_record(Term :: term(), RecordTag :: atom()) -> boolean().
+is_record(_Term, _RecordTag) ->
+    erlang:nif_error(undefined).
+
 %%-----------------------------------------------------------------------------
 %% @param   Map the map
 %% @returns the size of the map

src/libAtomVM/bif.c

@@ -241,6 +241,18 @@ term bif_erlang_is_tuple_1(Context *ctx, uint32_t fail_label, term arg1)
     return term_is_tuple(arg1) ? TRUE_ATOM : FALSE_ATOM;
 }
 
+term bif_erlang_is_record_2(Context *ctx, uint32_t fail_label, term arg1, term arg2)
+{
+    UNUSED(ctx);
+    VALIDATE_VALUE_BIF(fail_label, arg2, term_is_atom);
+    if (!term_is_tuple(arg1) || term_get_tuple_arity(arg1) == 0) {
+        return FALSE_ATOM;
+    }
+
+    term tag = term_get_tuple_element(arg1, 0);
+    return tag == arg2 ? TRUE_ATOM : FALSE_ATOM;
+}
+
 term bif_erlang_is_map_1(Context *ctx, uint32_t fail_label, term arg1)
 {
     UNUSED(ctx);

src/libAtomVM/bif.h

@@ -58,6 +58,7 @@ term bif_erlang_is_number_1(Context *ctx, uint32_t fail_label, term arg1);
 term bif_erlang_is_pid_1(Context *ctx, uint32_t fail_label, term arg1);
 term bif_erlang_is_reference_1(Context *ctx, uint32_t fail_label, term arg1);
 term bif_erlang_is_tuple_1(Context *ctx, uint32_t fail_label, term arg1);
+term bif_erlang_is_record_2(Context *ctx, uint32_t fail_label, term arg1, term record_tag);
 term bif_erlang_is_map_1(Context *ctx, uint32_t fail_label, term arg1);
 term bif_erlang_is_map_key_2(Context *ctx, uint32_t fail_label, term arg1, term arg2);
 

src/libAtomVM/bifs.gperf

@@ -53,6 +53,7 @@ erlang:is_number/1, {.bif.base.type = BIFFunctionType, .bif.bif1_ptr = bif_erlan
 erlang:is_pid/1, {.bif.base.type = BIFFunctionType, .bif.bif1_ptr = bif_erlang_is_pid_1}
 erlang:is_reference/1, {.bif.base.type = BIFFunctionType, .bif.bif1_ptr = bif_erlang_is_reference_1}
 erlang:is_tuple/1, {.bif.base.type = BIFFunctionType, .bif.bif1_ptr = bif_erlang_is_tuple_1}
+erlang:is_record/2,{.bif.base.type = BIFFunctionType, .bif.bif2_ptr = bif_erlang_is_record_2}
 erlang:is_map/1, {.bif.base.type = BIFFunctionType, .bif.bif1_ptr = bif_erlang_is_map_1}
 erlang:is_map_key/2, {.bif.base.type = BIFFunctionType, .bif.bif2_ptr = bif_erlang_is_map_key_2}
 erlang:not/1, {.bif.base.type = BIFFunctionType, .bif.bif1_ptr = bif_erlang_not_1}

tests/erlang_tests/CMakeLists.txt

@@ -114,6 +114,7 @@ compile_erlang(negatives2)
 compile_erlang(datetime)
 compile_erlang(test_system_time)
 compile_erlang(is_type)
+compile_erlang(is_record)
 compile_erlang(test_bitshift)
 compile_erlang(test_bitwise)
 compile_erlang(test_bitwise2)
@@ -903,6 +904,7 @@ add_custom_target(erlang_test_modules DEPENDS
 
     is_fun_2_with_frozen.beam
     is_fun_2_with_frozen2.beam
+    is_record.beam
 
     function_reference_decode.beam
     makefunref.beam

tests/erlang_tests/is_record.erl

@@ -0,0 +1,63 @@
+%
+% This file is part of AtomVM.
+%
+% Copyright 2024 Tomasz Sobkiewicz <tomasz.sobkiewt>
+%
+% 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.
+%
+% SPDX-License-Identifier: Apache-2.0 OR LGPL-2.1-or-later
+%
+
+-module(is_record).
+
+-record(person, {id, name, age}).
+
+-export([start/0, id/1, is_person/1, fail_with_badarg/1]).
+
+-define(ID(Arg), ?MODULE:id(Arg)).
+
+start() ->
+    Mike = #person{
+        id = 1,
+        name = "Mike",
+        age = 32
+    },
+    IsRecord = ?ID(fun erlang:is_record/2),
+    true = IsRecord(?ID({person, 1, 2, 3}), ?ID(person)),
+    true = erlang:is_record(?ID({person, 1, 2, 3}), ?ID(person)),
+    true = erlang:is_record(?ID({person}), ?ID(person)),
+    true = erlang:is_record(?ID(Mike), ?ID(person)),
+    true = ?MODULE:is_person(?ID(Mike)),
+
+    false = ?MODULE:is_person(?ID({tuple, 1, 2})),
+    false = erlang:is_record(?ID(Mike), ?ID(foo)),
+    false = erlang:is_record(?ID({person, 1, 2, 3}), ?ID(foo)),
+    false = erlang:is_record(?ID({}), ?ID(person)),
+    false = erlang:is_record(?ID([]), ?ID(person)),
+    ok = fail_with_badarg(fun() -> erlang:is_record(?ID(Mike), ?ID(1)) end),
+    ok = fail_with_badarg(fun() -> erlang:is_record(?ID({}), ?ID(1)) end),
+    0.
+
+id(T) ->
+    T.
+
+is_person(T) when is_record(T, person) -> true;
+is_person(_X) -> false.
+
+fail_with_badarg(Fun) ->
+    try Fun() of
+        Ret -> {unexpected, Ret}
+    catch
+        error:badarg -> ok;
+        C:E -> {unexpected, C, E}
+    end.

tests/test.c

@@ -438,6 +438,7 @@ struct Test tests[] = {
     TEST_CASE_EXPECTED(boxed_is_not_float, 16),
     TEST_CASE_EXPECTED(float_is_float, 32),
     TEST_CASE_EXPECTED(float_is_number, 32),
+    TEST_CASE(is_record),
     TEST_CASE(fconv_fail_invalid),
 
     TEST_CASE_EXPECTED(float2bin, 31),