diff --git a/lib/stdlib/src/erl_compile.erl b/lib/stdlib/src/erl_compile.erl index a11e9a3fee09..61f1b588f008 100644 --- a/lib/stdlib/src/erl_compile.erl +++ b/lib/stdlib/src/erl_compile.erl @@ -26,6 +26,7 @@ -include("file.hrl"). -export([compile_cmdline/0, compile/2]). +-export([compiler/1, extensions/0]). %% Mapping from extension to {M,F} to run the correct compiler. @@ -45,6 +46,23 @@ compiler(".asn") -> {asn1ct, compile_asn}; compiler(".py") -> {asn1ct, compile_py}; compiler(_) -> no. +extensions() -> + [{".erl" , obj_ext()}, + {".abstr" , obj_ext()}, + {".core" , obj_ext()}, + {".mib" , ".bin"}, + {".bin" , ".hrl"}, + {".xrl" , ".erl"}, + {".yrl" , ".erl"}, + {".script", ".boot"}, + {".rel" , ".script"}, + {".asn1" , ".erl"}, + {".asn" , ".erl"}, + {".py" , ".erl"} + ]. + +obj_ext() -> code:objfile_extension(). + %% Run a compilation based on the command line arguments and then halt. %% Intended for one-off compilation by erlc. -spec compile_cmdline() -> no_return(). diff --git a/lib/tools/src/make.erl b/lib/tools/src/make.erl index 7d27fa237ef3..68cd865270c5 100644 --- a/lib/tools/src/make.erl +++ b/lib/tools/src/make.erl @@ -73,11 +73,11 @@ all other files in the current directory should be compiled with only the -include_lib("kernel/include/file.hrl"). --define(MakeOpts,[noexec,load,netload,noload,emake]). +-define(MakeOpts,[noexec,load,netload,autoload,noload,emake]). -doc false. all_or_nothing() -> - case all() of + case all([autoload]) of up_to_date -> up_to_date; error -> @@ -94,9 +94,12 @@ all() -> This function determines the set of modules to compile and the compile options to use, by first looking for the `emake` make option, if not present reads the configuration from a file named `Emakefile` (see below). If no such file is -found, the set of modules to compile defaults to all modules in the current +found, the set of modules to compile defaults to all `.erl` modules in the current working directory. +If no file extension is given, `.erl` is assumed. Most of the source file types +supported by `erlc` are accepted, but then the extension must be specified. + Traversing the set of modules, it then recompiles every module for which at least one of the following conditions apply: @@ -118,21 +121,30 @@ is returned. Load mode. Loads all recompiled modules. - `netload` Net load mode. Loads all recompiled modules on all known nodes. +- `autoload` + Auto-load mode. If a line in the configuration specifies `load` or `netload`, + use that for the specific line. This can be used e.g. to load parse-transform + modules for later steps even when using `erl -make` (where this is the default). - `{emake, Emake}` Rather than reading the `Emakefile` specify configuration explicitly. -All items in `Options` that are not make options are assumed to be compiler -options and are passed as-is to `compile:file/2`. +All items in `Options` that are not make options or `{erlc,Args}` are assumed to be +compiler options and are passed as-is to `compile:file/2`. + +For source files compiled using `erlc`, the option `{erlc, Args}` is expected, +where `Args` is a string with arguments as they would have been given to `erlc` +(e.g. `"-W -I include -o ebin"`). """. -spec all(Options) -> 'up_to_date' | 'error' when Options :: [Option], Option :: 'noexec' | 'load' | 'netload' + | 'autoload' | {'emake', Emake} | compile:option(), Emake :: [EmakeElement], - EmakeElement :: Modules | {Modules, [compile:option()]}, + EmakeElement :: Modules | {Modules, [{erlc, string()} | compile:option()]}, Modules :: atom() | [atom()]. all(Options) -> @@ -161,11 +173,13 @@ options for each module. If a given module does not exist in `Emakefile` or if Option :: 'noexec' | 'load' | 'netload' + | 'autoload' + | {'erlc', string()} | compile:option(). files(Fs0, Options) -> - Fs = [filename:rootname(F,".erl") || F <- Fs0], - run_emake(Fs, Options). + %% Fs = [filename:rootname(F,".erl") || F <- Fs0], + run_emake(Fs0, Options). run_emake(Mods, Options) -> {MakeOpts,CompileOpts} = sort_options(Options,[],[]), @@ -212,7 +226,7 @@ normalize_emake(EmakeRaw, Mods, Opts) -> transform(Emake,Opts,[],[]); {ok, Emake} when is_list(Mods) -> ModsOpts = transform(Emake,Opts,[],[]), - ModStrings = [coerce_2_list(M) || M <- Mods], + ModStrings = [coerce_2_list(M) || M <- expand(Mods, [])], get_opts_from_emakefile(ModsOpts,ModStrings,Opts,[]); {error,enoent} when Mods =:= undefined -> %% No Emakefile found - return all modules in current @@ -256,23 +270,47 @@ expand(Mod,Already) when is_atom(Mod) -> expand(Mods,Already) when is_list(Mods), not is_integer(hd(Mods)) -> lists:concat([expand(Mod,Already) || Mod <- Mods]); expand(Mod,Already) -> - case lists:member($*,Mod) of - true -> - Fun = fun(F,Acc) -> - M = filename:rootname(F), - case lists:member(M,Already) of - true -> Acc; - false -> [M|Acc] - end - end, - lists:foldl(Fun, [], filelib:wildcard(Mod++".erl")); - false -> - Mod2 = filename:rootname(Mod, ".erl"), - case lists:member(Mod2,Already) of - true -> []; - false -> [Mod2] - end - end. + Mods = case {contains_wildcard(Mod), filename:extension(Mod)} of + {true, []} -> + filelib:wildcard(Mod ++ ".erl"); + {true, _} -> + filelib:wildcard(Mod); + {false, []} -> + [Mod ++ ".erl"]; + {false, _} -> + [Mod] + end, + Fun = fun(F,Acc) -> + case lists:member(F,Already) of + true -> Acc; + false -> [F|Acc] + end + end, + lists:foldl(Fun, [], Mods). + +contains_wildcard(Str) -> + contains_wildcard_(unicode:characters_to_list(Str)). + +contains_wildcard_("\\" ++ [_|T]) -> + contains_wildcard_(T); +contains_wildcard_([H|T]) -> + case is_wildcard(H) of + true -> + true; + false -> + contains_wildcard_(T) + end; +contains_wildcard_([]) -> + false. + +is_wildcard($*) -> true; +is_wildcard($?) -> true; +is_wildcard($[) -> true; +is_wildcard($]) -> true; +is_wildcard(${) -> true; +is_wildcard($}) -> true; +is_wildcard($+) -> true; +is_wildcard(_) -> false. %%% Reads the given Emake to see if there are any specific compile %%% options given for the modules. @@ -314,7 +352,12 @@ load_opt(Opts) -> true -> load; _ -> - noload + case lists:member(autoload, Opts) of + true -> + autoload; + false -> + noload + end end end. @@ -331,42 +374,79 @@ process([{[H|T],Opts}|Rest], NoExec, Load) -> process([], _NoExec, _Load) -> up_to_date. -recompilep(File, NoExec, Load, Opts) -> - ObjName = lists:append(filename:basename(File), - code:objfile_extension()), - ObjFile = case lists:keysearch(outdir,1,Opts) of - {value,{outdir,OutDir}} -> - filename:join(coerce_2_list(OutDir),ObjName); - false -> - ObjName - end, - case exists(ObjFile) of - true -> - recompilep1(File, NoExec, Load, Opts, ObjFile); - false -> - recompile(File, NoExec, Load, Opts) +recompilep(File0, NoExec, Load, Opts) -> + case check_extensions(File0) of + {File, OutExt} -> + RootF = filename:rootname(File), + ObjName = lists:append(filename:basename(RootF), OutExt), + OutDir = outdir(Opts), + ObjFile = filename:join(coerce_2_list(OutDir),ObjName), + case exists(ObjFile) of + true -> + recompilep1(File, NoExec, Load, Opts, ObjFile); + false -> + recompile(File, ObjFile, NoExec, Load, Opts) + end; + error -> + error + end. + +outdir(Opts) -> + case lists:keyfind(erlc, 1, Opts) of + {_, Args} -> + case lists:dropwhile(fun(X) -> X =/= "-o" end, + split_erlc_args(Args)) of + ["-o", Out|_] -> + Out; + [] -> + "." + end; + false -> + proplists:get_value(outdir, Opts, ".") + end. + +check_extensions(F) -> + case filename:extension(F) of + [] -> + {F ++ ".erl", code:objfile_extension()}; + ".erl" -> + {F, code:objfile_extension()}; + Ext -> + case lists:keyfind(Ext, 1, erl_compile:extensions()) of + false -> + error; + {_, OutExt} -> + {F, OutExt} + end end. - + +%% File now has the right extension. recompilep1(File, NoExec, Load, Opts, ObjFile) -> - {ok, Erl} = file:read_file_info(lists:append(File, ".erl")), - {ok, Obj} = file:read_file_info(ObjFile), - recompilep1(Erl, Obj, File, NoExec, Load, Opts). + {ok, InInfo} = file:read_file_info(File), + {ok, ObjInfo} = file:read_file_info(ObjFile), + recompilep1(InInfo, ObjInfo, File, ObjFile, NoExec, Load, Opts). recompilep1(#file_info{mtime=Te}, - #file_info{mtime=To}, File, NoExec, Load, Opts) when Te>To -> - recompile(File, NoExec, Load, Opts); -recompilep1(_Erl, #file_info{mtime=To}, File, NoExec, Load, Opts) -> - recompile2(To, File, NoExec, Load, Opts). + #file_info{mtime=To}, File, ObjFile, NoExec, Load, Opts) when Te>To -> + recompile(File, ObjFile, NoExec, Load, Opts); +recompilep1(_InInfo, #file_info{mtime=To}, File, ObjFile, NoExec, Load, Opts) -> + recompile2(To, File, ObjFile, NoExec, Load, Opts). %% recompile2(ObjMTime, File, NoExec, Load, Opts) %% Check if file is of a later date than include files. -recompile2(ObjMTime, File, NoExec, Load, Opts) -> - IncludePath = include_opt(Opts), - case check_includes(lists:append(File, ".erl"), IncludePath, ObjMTime) of - true -> - recompile(File, NoExec, Load, Opts); - false -> - false +recompile2(ObjMTime, File, ObjFile, NoExec, Load, Opts) -> + case filename:extension(File) of + ".erl" -> + %% Only check includes for .erl files + IncludePath = include_opt(Opts), + case check_includes(File, IncludePath, ObjMTime) of + true -> + recompile(File, ObjFile, NoExec, Load, Opts); + false -> + false + end; + _ -> + false end. include_opt([{i,Path}|Rest]) -> @@ -378,21 +458,88 @@ include_opt([]) -> %% recompile(File, NoExec, Load, Opts) %% Actually recompile and load the file, depending on the flags. -%% Where load can be netload | load | noload +%% Where load can be netload | load | autoload | noload -recompile(File, true, _Load, _Opts) -> +recompile(File, _ObjFile, true, _Load, _Opts) -> io:format("Out of date: ~ts\n",[File]); -recompile(File, false, Load, Opts) -> +recompile(File, ObjFile, false, Load, Opts) -> io:format("Recompile: ~ts\n",[File]), - case compile:file(File, [report_errors, report_warnings |Opts]) of + recompile_(filename:extension(File), File, ObjFile, Load, Opts). + +recompile_(".erl", File, _ObjFile, Load, Opts) -> + case compile:file(File, [report_errors, report_warnings | Opts]) of Ok when is_tuple(Ok), element(1,Ok)==ok -> maybe_load(element(2,Ok), Load, Opts); _Error -> error + end; +recompile_(Ext, File, ObjFile, Load, Opts) -> + case erl_compile:compiler(Ext) of + no -> + error; + {_, _} -> + Args = erlc_args(Opts, File), + {ok, Cwd} = file:get_cwd(), + case erl_compile:compile(Args, Cwd) of + ok -> + case can_load(Ext) of + false -> + ok; + true -> + Mod = get_module(ObjFile), + maybe_load(Mod, Load, Opts) + end; + _ -> + error + end + end. + +get_module(ObjFile) -> + case filename:extension(ObjFile) of + ".beam" -> + case beam_lib:chunks(ObjFile, [compile_info]) of + {ok, {Mod, _}} -> + Mod; + _ -> + undefined + end; + _ -> + undefined + end. + +erlc_args(Opts, File) -> + case lists:keyfind(erlc, 1, Opts) of + false -> + [File]; + {_, Args} -> + List = split_erlc_args(Args), + List ++ [File] + end. + +split_erlc_args(Args) -> + string:lexemes(Args, " "). + +can_load(".erl") -> true; +can_load(Ext) -> + ObjExt = code:objfile_extension(), + case lists:keyfind(Ext, 1, erl_compile:extensions()) of + {_, OutExt} -> + OutExt =:= ObjExt; + false -> + false end. maybe_load(_Mod, noload, _Opts) -> ok; +maybe_load(undefined, _, _) -> + ok; +maybe_load(Mod, autoload, Opts) -> + case [O || O <- [netload, load], lists:member(O, Opts)] of + [Load|_] -> + maybe_load(Mod, Load, Opts); + [] -> + ok + end; maybe_load(Mod, Load, Opts) -> %% We have compiled File with options Opts. Find out where the %% output file went to, and load it. diff --git a/lib/tools/test/make_SUITE.erl b/lib/tools/test/make_SUITE.erl index c2945182f682..63f2930bb508 100644 --- a/lib/tools/test/make_SUITE.erl +++ b/lib/tools/test/make_SUITE.erl @@ -38,12 +38,13 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [make_all, make_files, load, netload, recompile_on_changed_include, - emake_opts, {group, otp_6057}]. + [make_all, make_files, load, netload, autoload, recompile_on_changed_include, + emake_opts, {group, otp_6057}, {group, non_erl}]. groups() -> [{otp_6057,[],[otp_6057_a, otp_6057_b, - otp_6057_c]}]. + otp_6057_c]}, + {non_erl, [], [erlc_parsetools]}]. init_per_suite(Config) -> Config. @@ -51,8 +52,10 @@ init_per_suite(Config) -> end_per_suite(_Config) -> ok. +init_per_group(otp_6057, Config) -> + otp_6057_init(Config); init_per_group(_GroupName, Config) -> - otp_6057_init(Config). + Config. end_per_group(_GroupName, Config) -> otp_6057_end(Config). @@ -67,9 +70,21 @@ test_files() -> ["test1", "test2", "test3", "test4"]. make_all(Config) when is_list(Config) -> Current = prepare_data_dir(Config), + up_to_date = make:all(), + ok = ensure_exists(test_files()), ok = ensure_exists(["test5"],".S"), % Emakefile: [{test5,['S']} + + %% Ensure that other sources aren't built, since extensions + %% were not specified in Emakefile. + NonErl = [_|_] = filelib:wildcard("./*.[xy]rl"), + ct:log("NonErl = ~p", [NonErl]), + NonErlOut = [filename:rootname(F) ++ ".erl" || F <- NonErl], + ct:log("NonErlOut = ~p", [NonErlOut]), + [] = [F || F <- NonErlOut, filelib:is_regular(F)], + + %% Restore CWD file:set_cwd(Current), ensure_no_messages(), ok. @@ -116,6 +131,38 @@ netload(Config) -> ensure_no_messages(), ok. +autoload(Config) -> + Current = prepare_data_dir(Config), + code:purge(test1), + code:delete(test1), + code:purge(test2), + code:delete(test2), + code:purge(testc), + code:delete(testc), + false = code:is_loaded(test1), + false = code:is_loaded(test2), + false = code:is_loaded(testc), + + {value, {data_dir, Dir}} = lists:keysearch(data_dir, 1, Config), + + AutoLoad = filename:join(Dir, "autoload"), + ok = file:set_cwd(AutoLoad), + up_to_date = make:all([autoload]), + {file,_} = code:is_loaded(test1), + false = code:is_loaded(test2), + + %% Make sure autoload also works when going via erlc + Core = filename:join(Dir, "core"), + ok = file:set_cwd(Core), + up_to_date = make:all([autoload]), + {file,_} = code:is_loaded(testc), + + %% Clean up + code:purge(testc), + code:delete(testc), + file:set_cwd(Current), + ok. + recompile_on_changed_include(Config) -> Current = prepare_data_dir(Config), @@ -172,8 +219,16 @@ prepare_data_dir(Config) -> {ok, Current} = file:get_cwd(), {value, {data_dir, Dir}} = lists:keysearch(data_dir, 1, Config), file:set_cwd(Dir), + ObjExt = code:objfile_extension(), {ok, Files} = file:list_dir("."), - delete_obj(Files, code:objfile_extension()), + delete_obj(Files, ObjExt), + filelib:ensure_dir("./non_erl/out/dummy"), + NonErl = filelib:wildcard("./non_erl/out/*"), + delete_obj(NonErl, ".erl"), + AutoLoad = filelib:wildcard("./autoload/*" ++ ObjExt), + delete_obj(AutoLoad, ObjExt), + Core = filelib:wildcard("./core/*" ++ ObjExt), + delete_obj(Core, ObjExt), ensure_no_messages(), Current. @@ -360,6 +415,40 @@ otp_6057_c(Config) when is_list(Config) -> otp_6057_end(Config) when is_list(Config) -> Config. +erlc_parsetools(Config) when is_list(Config) -> + Current = prepare_data_dir(Config), + {value, {data_dir, Dir}} = lists:keysearch(data_dir, 1, Config), + + NonErl = filename:join(Dir, "non_erl"), + Scanner = filename:join(Dir, "calx_lexer.xrl"), + Parser = filename:join(Dir, "calx_parser.yrl"), + [] = [F || F <- [Scanner, Parser], not filelib:is_regular(F)], + [] = filelib:wildcard(NonErl ++ "/out/*"), + + file:set_cwd(NonErl), + up_to_date = make:all(), + OutFiles = ["out/calx_lexer.erl", "out/calx_parser.erl"], + [] = [F || F <- OutFiles, not filelib:is_regular(F)], + MTimes = [mtime(F) || F <- OutFiles], + + %% Ensure that they are not compiled again + timer:sleep(2000), + up_to_date = make:all(), + MTimes = [mtime(F) || F <- OutFiles], + + %% Remove the output files + ok = ensure_removed(OutFiles), + + %% Return to original dir + ok = file:set_cwd(Current), + + ensure_no_messages(), + ok. + +mtime(F) -> + {ok, FInfo} = file:read_file_info(F), + FInfo#file_info.mtime. + ensure_removed([File|Files]) -> file:delete(File), ensure_removed(Files); diff --git a/lib/tools/test/make_SUITE_data/autoload/Emakefile b/lib/tools/test/make_SUITE_data/autoload/Emakefile new file mode 100644 index 000000000000..6b7b9b4c5a56 --- /dev/null +++ b/lib/tools/test/make_SUITE_data/autoload/Emakefile @@ -0,0 +1,22 @@ +%% %CopyrightBegin% +%% +%% SPDX-License-Identifier: Apache-2.0 +%% +%% Copyright Ericsson AB 2025. All Rights Reserved. +%% +%% 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. +%% +%% %CopyrightEnd% + +{'../test1',[load]}. +'../test2'. diff --git a/lib/tools/test/make_SUITE_data/calx_lexer.xrl b/lib/tools/test/make_SUITE_data/calx_lexer.xrl new file mode 100644 index 000000000000..d7b78ef21e9b --- /dev/null +++ b/lib/tools/test/make_SUITE_data/calx_lexer.xrl @@ -0,0 +1,40 @@ +%% %CopyrightBegin% +%% +%% SPDX-License-Identifier: Apache-2.0 +%% +%% Copyright Ericsson AB 2025. All Rights Reserved. +%% +%% 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. +%% +%% %CopyrightEnd% + +%% Original from: https://github.com/knutin/calx + +Definitions. + +Operator = [+\-] +Number = [0-9]+ +Whitespace = [\000-\s] +LeftParen = \( +RightParen = \) + +Rules. + +{Whitespace} : skip_token. +{Operator} : {token, {operator, TokenLine, TokenChars}}. +{LeftParen} : {token, {'(', TokenLine, TokenChars}}. +{RightParen} : {token, {')', TokenLine, TokenChars}}. +{Number} : {token, {digit, TokenLine, TokenChars}}. + + +Erlang code. diff --git a/lib/tools/test/make_SUITE_data/calx_parser.yrl b/lib/tools/test/make_SUITE_data/calx_parser.yrl new file mode 100644 index 000000000000..9b6b2020d62e --- /dev/null +++ b/lib/tools/test/make_SUITE_data/calx_parser.yrl @@ -0,0 +1,48 @@ +%% %CopyrightBegin% +%% +%% SPDX-License-Identifier: Apache-2.0 +%% +%% Copyright Ericsson AB 2025. All Rights Reserved. +%% +%% 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. +%% +%% %CopyrightEnd% + +%% Original from: https://github.com/knutin/calx + +Nonterminals +expr +arg_list +. + + +Terminals +operator +digit +'(' +')' +. + +Rootsymbol expr. + +expr -> '(' operator arg_list ')' : {expr, value_of('$2'), '$3'}. + +arg_list -> expr : ['$1']. +arg_list -> digit : [{digit, ?l2i(value_of('$1'))}]. +arg_list -> digit arg_list : [{digit, ?l2i(value_of('$1'))}] ++ '$2'. + + +Erlang code. + +-define(l2i(L), list_to_integer(L)). +value_of({_,_,V}) -> V. diff --git a/lib/tools/test/make_SUITE_data/core/Emakefile b/lib/tools/test/make_SUITE_data/core/Emakefile new file mode 100644 index 000000000000..13699507e7c7 --- /dev/null +++ b/lib/tools/test/make_SUITE_data/core/Emakefile @@ -0,0 +1,21 @@ +%% %CopyrightBegin% +%% +%% SPDX-License-Identifier: Apache-2.0 +%% +%% Copyright Ericsson AB 2025. All Rights Reserved. +%% +%% 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. +%% +%% %CopyrightEnd% + +{"testc.core", [{erlc, "-W"}, load]}. diff --git a/lib/tools/test/make_SUITE_data/core/testc.core b/lib/tools/test/make_SUITE_data/core/testc.core new file mode 100644 index 000000000000..963d21179f7f --- /dev/null +++ b/lib/tools/test/make_SUITE_data/core/testc.core @@ -0,0 +1,26 @@ +%% %CopyrightBegin% +%% +%% SPDX-License-Identifier: Apache-2.0 +%% +%% Copyright Ericsson AB 2025. All Rights Reserved. +%% +%% 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. +%% +%% %CopyrightEnd% + +module 'testc' ['f'/0] + attributes [] +'f'/0 = + fun () -> + 'ok' +end \ No newline at end of file diff --git a/lib/tools/test/make_SUITE_data/non_erl/Emakefile b/lib/tools/test/make_SUITE_data/non_erl/Emakefile new file mode 100644 index 000000000000..c6c25bc108e1 --- /dev/null +++ b/lib/tools/test/make_SUITE_data/non_erl/Emakefile @@ -0,0 +1,21 @@ +%% %CopyrightBegin% +%% +%% SPDX-License-Identifier: Apache-2.0 +%% +%% Copyright Ericsson AB 2025. All Rights Reserved. +%% +%% 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. +%% +%% %CopyrightEnd% + +{"../calx_{lexer,parser}.?rl", [{erlc, "-o out"}]}.