diff --git a/CHANGELOG.md b/CHANGELOG.md index 60dd6dd367..af5d26f3e7 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/libs/estdlib/src/erlang.erl b/libs/estdlib/src/erlang.erl index b5f727b784..1f42c74a07 100644 --- a/libs/estdlib/src/erlang.erl +++ b/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 diff --git a/src/libAtomVM/bif.c b/src/libAtomVM/bif.c index 23999f2f6e..6d56387c8c 100644 --- a/src/libAtomVM/bif.c +++ b/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); diff --git a/src/libAtomVM/bif.h b/src/libAtomVM/bif.h index 9dfe1e35ae..056396481b 100644 --- a/src/libAtomVM/bif.h +++ b/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); diff --git a/src/libAtomVM/bifs.gperf b/src/libAtomVM/bifs.gperf index 8ad581ad06..593cb25e78 100644 --- a/src/libAtomVM/bifs.gperf +++ b/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} diff --git a/tests/erlang_tests/CMakeLists.txt b/tests/erlang_tests/CMakeLists.txt index 85bd3cff35..9712e43afe 100644 --- a/tests/erlang_tests/CMakeLists.txt +++ b/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 diff --git a/tests/erlang_tests/is_record.erl b/tests/erlang_tests/is_record.erl new file mode 100644 index 0000000000..e11e15cc07 --- /dev/null +++ b/tests/erlang_tests/is_record.erl @@ -0,0 +1,63 @@ +% +% This file is part of AtomVM. +% +% Copyright 2024 Tomasz Sobkiewicz +% +% 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. diff --git a/tests/test.c b/tests/test.c index b437775620..587dd4759a 100644 --- a/tests/test.c +++ b/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),