aboutsummaryrefslogtreecommitdiffstats
path: root/lib/asn1/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/asn1/src')
-rw-r--r--lib/asn1/src/Makefile10
-rw-r--r--lib/asn1/src/asn1_db.erl67
-rw-r--r--lib/asn1/src/asn1_records.hrl2
-rw-r--r--lib/asn1/src/asn1ct.erl573
-rw-r--r--lib/asn1/src/asn1ct_check.erl970
-rw-r--r--lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl83
-rw-r--r--lib/asn1/src/asn1ct_constructed_per.erl573
-rw-r--r--lib/asn1/src/asn1ct_func.erl21
-rw-r--r--lib/asn1/src/asn1ct_gen.erl179
-rw-r--r--lib/asn1/src/asn1ct_gen_ber_bin_v2.erl532
-rw-r--r--lib/asn1/src/asn1ct_gen_per.erl553
-rw-r--r--lib/asn1/src/asn1ct_gen_per_rt2ct.erl946
-rw-r--r--lib/asn1/src/asn1ct_imm.erl85
-rw-r--r--lib/asn1/src/asn1ct_name.erl152
-rw-r--r--lib/asn1/src/asn1ct_parser2.erl7
-rw-r--r--lib/asn1/src/asn1ct_value.erl4
-rw-r--r--lib/asn1/src/asn1rtt_ber.erl136
-rw-r--r--lib/asn1/src/asn1rtt_per.erl187
-rw-r--r--lib/asn1/src/asn1rtt_uper.erl178
19 files changed, 1601 insertions, 3657 deletions
diff --git a/lib/asn1/src/Makefile b/lib/asn1/src/Makefile
index 9607799401..33cd3cc4c3 100644
--- a/lib/asn1/src/Makefile
+++ b/lib/asn1/src/Makefile
@@ -134,10 +134,10 @@ $(EBIN)/asn1ct.$(EMULATOR):asn1ct.erl
$(V_ERLC) -b$(EMULATOR) -o$(EBIN) $(ERL_COMPILE_FLAGS) -Dvsn=\"$(VSN)\" $<
$(EBIN)/asn1ct_func.$(EMULATOR): asn1ct_func.erl
- $(ERLC) -o$(EBIN) $(ERL_COMPILE_FLAGS) -I../rt_templates $<
+ $(V_ERLC) -o$(EBIN) $(ERL_COMPILE_FLAGS) -I../rt_templates $<
asn1ct_eval_%.erl: asn1ct_eval_%.funcs
- erl -pa $(EBIN) -noshell -noinput \
+ $(gen_verbose)erl -pa $(EBIN) -noshell -noinput \
-run prepare_templates gen_asn1ct_eval $< >$@
$(APP_TARGET): $(APP_SRC) ../vsn.mk
@@ -182,14 +182,14 @@ RT_TEMPLATES_ERL = $(RT_TEMPLATES:%=%.erl)
RT_TEMPLATES_TARGET = $(RT_TEMPLATES:%=%.$(EMULATOR))
asn1ct_rtt.erl: prepare_templates.$(EMULATOR) $(RT_TEMPLATES_TARGET)
- erl -noshell -noinput -run prepare_templates gen_asn1ct_rtt \
+ $(gen_verbose)erl -noshell -noinput -run prepare_templates gen_asn1ct_rtt \
$(RT_TEMPLATES_TARGET) >asn1ct_rtt.erl
prepare_templates.$(EMULATOR): prepare_templates.erl
- erlc prepare_templates.erl
+ $(V_ERLC) prepare_templates.erl
asn1rtt_%.$(EMULATOR): asn1rtt_%.erl
- erlc +debug_info $<
+ $(V_ERLC) +debug_info $<
$(EVAL_CT_MODULES:%=%.erl): prepare_templates.$(EMULATOR) \
$(EBIN)/asn1ct_rtt.$(EMULATOR)
diff --git a/lib/asn1/src/asn1_db.erl b/lib/asn1/src/asn1_db.erl
index 843fc66c9c..e96ca9ae25 100644
--- a/lib/asn1/src/asn1_db.erl
+++ b/lib/asn1/src/asn1_db.erl
@@ -19,31 +19,22 @@
%%
-module(asn1_db).
--export([dbstart/1,dbnew/1,dbsave/2,dbload/1,dbput/3,dbget/2,dbget_all/1]).
--export([dbget_all_mod/1,dbclear/0,dberase_module/1,dbstop/0]).
+-export([dbstart/1,dbnew/1,dbsave/2,dbput/3,dbget/2]).
+-export([dbstop/0]).
-record(state, {parent, monitor, includes, table}).
%% Interface
dbstart(Includes) ->
Parent = self(),
- case get(?MODULE) of
- undefined ->
- put(?MODULE, spawn_link(fun() -> init(Parent, Includes) end)),
- true;
- _Pid ->
- req({new_includes, Includes})
- end.
+ undefined = get(?MODULE), %Assertion.
+ put(?MODULE, spawn_link(fun() -> init(Parent, Includes) end)),
+ ok.
dbnew(Module) -> req({new, Module}).
-dbsave(OutFile, Module) -> req({save, OutFile, Module}).
-dbload(Module) -> req({load, Module}).
-dbput(Module, K, V) -> req({set, Module, K, V}).
+dbsave(OutFile, Module) -> cast({save, OutFile, Module}).
+dbput(Module, K, V) -> cast({set, Module, K, V}).
dbget(Module, K) -> req({get, Module, K}).
-dbget_all(K) -> req({get_all, K}).
-dbget_all_mod(Mod) -> req({all_mod, Mod}).
-dbclear() -> req(clear).
-dberase_module({module,M}) -> req({delete_mod, M}).
dbstop() -> Resp = req(stop), erase(?MODULE), Resp.
%% Internal functions
@@ -59,8 +50,13 @@ req(Request) ->
exit({db_error,Info})
end.
+cast(Request) ->
+ get(?MODULE) ! Request,
+ ok.
+
reply({Ref,From}, Response) ->
- From ! {{Ref,?MODULE}, Response}.
+ From ! {{Ref,?MODULE}, Response},
+ ok.
init(Parent, Includes) ->
MRef = erlang:monitor(process, Parent),
@@ -70,10 +66,9 @@ init(Parent, Includes) ->
loop(#state{parent = Parent, monitor = MRef, table = Table,
includes = Includes} = State) ->
receive
- {From, {set, Mod, K2, V}} ->
+ {set, Mod, K2, V} ->
[{_, Modtab}] = ets:lookup(Table, Mod),
ets:insert(Modtab, {K2, V}),
- reply(From, ok),
loop(State);
{From, {get, Mod, K2}} ->
Result = case ets:lookup(Table, Mod) of
@@ -85,44 +80,16 @@ loop(#state{parent = Parent, monitor = MRef, table = Table,
_Error -> reply(From, undefined)
end,
loop(State);
- {From, {all_mod, Mod}} ->
- [{_, Modtab}] = ets:lookup(Table, Mod),
- reply(From, ets:tab2list(Modtab)),
- loop(State);
- {From, {delete_mod, Mod}} ->
- [{_, Modtab}] = ets:lookup(Table, Mod),
- ets:delete(Modtab),
- ets:delete(Table, Mod),
- reply(From, ok),
- loop(State);
- {From, {save, OutFile, Mod}} ->
+ {save, OutFile, Mod} ->
[{_,Mtab}] = ets:lookup(Table, Mod),
- reply(From, ets:tab2file(Mtab, OutFile)),
- loop(State);
- {From, {load, Mod}} ->
- Result = case ets:lookup(Table, Mod) of
- [] -> opentab(Table, Mod, Includes);
- [{_, Modtab}] -> {ok, Modtab}
- end,
- reply(From, Result),
+ ok = ets:tab2file(Mtab, OutFile),
loop(State);
{From, {new, Mod}} ->
- case ets:lookup(Table, Mod) of
- [{_, Modtab}] -> ets:delete(Modtab);
- _ -> true
- end,
+ [] = ets:lookup(Table, Mod), %Assertion.
ModTableId = ets:new(list_to_atom(lists:concat(["asn1_",Mod])), []),
ets:insert(Table, {Mod, ModTableId}),
reply(From, ok),
loop(State);
- {From, clear} ->
- [ets:delete(Mt) || {_, Mt} <- ets:tab2list(Table)],
- ets:delete(Table),
- reply(From, cleared),
- loop(State#state{table = ets:new(asn1, [set])});
- {From, {new_includes, NewIncludes}} ->
- reply(From, true),
- loop(State#state{includes = NewIncludes});
{From, stop} ->
reply(From, stopped); %% Nothing to store
{'DOWN', MRef, process, Parent, Reason} ->
diff --git a/lib/asn1/src/asn1_records.hrl b/lib/asn1/src/asn1_records.hrl
index 16d14c2e7b..396ba0fcfa 100644
--- a/lib/asn1/src/asn1_records.hrl
+++ b/lib/asn1/src/asn1_records.hrl
@@ -45,9 +45,7 @@
-record(pobjectdef,{checked=false,pos,name,args,class,def}).
-record(pobjectsetdef,{checked=false,pos,name,args,class,def}).
--record(typereference,{pos,val}).
-record(identifier,{pos,val}).
--record(constraint,{c,e}).
-record('Constraint',{'SingleValue'=no,'SizeConstraint'=no,'ValueRange'=no,'PermittedAlphabet'=no,
'ContainedSubtype'=no, 'TypeConstraint'=no,'InnerSubtyping'=no,e=no,'Other'=no}).
-record(simpletableattributes,{objectsetname,c_name,c_index,usedclassfield,
diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl
index 770b92cbc3..8e71a5697c 100644
--- a/lib/asn1/src/asn1ct.erl
+++ b/lib/asn1/src/asn1ct.erl
@@ -25,21 +25,20 @@
%%-compile(export_all).
%% Public exports
-export([compile/1, compile/2]).
--export([start/0, start/1]).
-export([encode/2, encode/3, decode/3]).
-export([test/1, test/2, test/3, value/2, value/3]).
%% Application internal exports
-export([compile_asn/3,compile_asn1/3,compile_py/3,compile/3,
vsn/0,
get_name_of_def/1,get_pos_of_def/1]).
--export([read_config_data/1,get_gen_state_field/1,get_gen_state/0,
- partial_inc_dec_toptype/1,save_gen_state/1,update_gen_state/2,
+-export([read_config_data/1,get_gen_state_field/1,
+ partial_inc_dec_toptype/1,update_gen_state/2,
get_tobe_refed_func/1,reset_gen_state/0,is_function_generated/1,
- generated_refed_func/1,next_refed_func/0,pop_namelist/0,
- next_namelist_el/0,update_namelist/1,step_in_constructed/0,
+ generated_refed_func/1,next_refed_func/0,
+ update_namelist/1,step_in_constructed/0,
add_tobe_refed_func/1,add_generated_refed_func/1,
- maybe_rename_function/3,latest_sindex/0,current_sindex/0,
- set_current_sindex/1,next_sindex/0,maybe_saved_sindex/2,
+ maybe_rename_function/3,current_sindex/0,
+ set_current_sindex/1,maybe_saved_sindex/2,
parse_and_save/2,verbose/3,warning/3,warning/4,error/3]).
-export([get_bit_string_format/0]).
@@ -82,7 +81,6 @@
%%
%%
-
compile(File) ->
compile(File,[]).
@@ -96,14 +94,30 @@ compile(File, Options0) when is_list(Options0) ->
Error
end.
+-record(st,
+ {file=[],
+ files=[],
+ inputmodules=[],
+ code,
+ opts=[],
+ outfile,
+ dbfile,
+ includes=[],
+ erule,
+ error=none,
+ run
+ }).
+
compile_proc(File, Includes, Options) ->
+ Erule = get_rule(Options),
+ St = #st{opts=Options,includes=Includes,erule=Erule},
case input_file_type(File, Includes) of
{single_file, SuffixedFile} -> %% "e.g. "/tmp/File.asn"
- compile1(SuffixedFile, Options);
+ compile1(SuffixedFile, St);
{multiple_files_file, SetBase, FileName} ->
case get_file_list(FileName, Includes) of
FileList when is_list(FileList) ->
- compile_set(SetBase, FileList, Options);
+ compile_set(SetBase, FileList, St);
Err ->
Err
end;
@@ -111,22 +125,222 @@ compile_proc(File, Includes, Options) ->
{error, Err}
end.
-compile1(File,Options) when is_list(Options) ->
- verbose("Erlang ASN.1 version ~p compiling ~p ~n",[?vsn,File],Options),
- verbose("Compiler Options: ~p~n",[Options],Options),
- Ext = filename:extension(File),
- Base = filename:basename(File,Ext),
- OutFile = outfile(Base,"",Options),
- DbFile = outfile(Base,"asn1db",Options),
- Includes = [I || {i,I} <- Options],
- EncodingRule = get_rule(Options),
- Continue1 = scan(File,Options),
- Continue2 = parse(Continue1,File,Options),
- Continue3 = check(Continue2,File,OutFile,Includes,EncodingRule,
- DbFile,Options,[]),
- Continue4 = generate(Continue3,OutFile,EncodingRule,Options),
- compile_erl(Continue4, OutFile, Options).
+set_passes() ->
+ [{pass,scan_parse,fun set_scan_parse_pass/1},
+ {pass,merge,fun merge_pass/1}|common_passes()].
+
+single_passes() ->
+ [{pass,scan,fun scan_pass/1},
+ {pass,parse,fun parse_pass/1}|common_passes()].
+
+parse_and_save_passes() ->
+ [{pass,scan,fun scan_pass/1},
+ {pass,parse,fun parse_pass/1},
+ {pass,save,fun save_pass/1}].
+
+common_passes() ->
+ [{pass,check,fun check_pass/1},
+ {iff,abs,{pass,abs_listing,fun abs_listing/1}},
+ {pass,generate,fun generate_pass/1},
+ {unless,noobj,{pass,compile,fun compile_pass/1}}].
+
+scan_pass(#st{file=File}=St) ->
+ case asn1ct_tok:file(File) of
+ {error,Reason} ->
+ {error,St#st{error=Reason}};
+ Tokens when is_list(Tokens) ->
+ {ok,St#st{code=Tokens}}
+ end.
+
+set_scan_parse_pass(#st{files=Files}=St) ->
+ try
+ L = set_scan_parse_pass_1(Files, St),
+ {ok,St#st{code=L}}
+ catch
+ throw:Error ->
+ {error,St#st{error=Error}}
+ end.
+
+set_scan_parse_pass_1([F|Fs], St) ->
+ case asn1ct_tok:file(F) of
+ {error,Error} ->
+ throw(Error);
+ Tokens when is_list(Tokens) ->
+ case catch asn1ct_parser2:parse(Tokens) of
+ {ok,M} ->
+ [M|set_scan_parse_pass_1(Fs, St)];
+ {error,ErrorTerm} ->
+ throw(handle_parse_error(ErrorTerm, St))
+ end
+ end;
+set_scan_parse_pass_1([], _) -> [].
+
+parse_pass(#st{code=Tokens}=St) ->
+ case catch asn1ct_parser2:parse(Tokens) of
+ {ok,M} ->
+ {ok,St#st{code=M}};
+ {error,ErrorTerm} ->
+ {error,St#st{error=handle_parse_error(ErrorTerm, St)}}
+ end.
+
+handle_parse_error(ErrorTerm, #st{file=File,opts=Opts}) ->
+ case ErrorTerm of
+ {{Line,_Mod,Message},_TokTup} ->
+ if
+ is_integer(Line) ->
+ BaseName = filename:basename(File),
+ error("syntax error at line ~p in module ~s:~n",
+ [Line,BaseName], Opts);
+ true ->
+ error("syntax error in module ~p:~n",
+ [File], Opts)
+ end,
+ print_error_message(Message),
+ Message;
+ {Line,_Mod,[Message,Token]} ->
+ error("syntax error: ~p ~p at line ~p~n",
+ [Message,Token,Line], Opts),
+ {Line,[Message,Token]}
+ end.
+
+merge_pass(#st{file=Base,code=Code}=St) ->
+ M = merge_modules(Code, Base),
+ {ok,St#st{code=M}}.
+
+check_pass(#st{code=M,file=File,includes=Includes,
+ erule=Erule,dbfile=DbFile,opts=Opts,
+ inputmodules=InputModules}=St) ->
+ start(Includes),
+ case asn1ct_check:storeindb(#state{erule=Erule}, M) of
+ ok ->
+ Module = asn1_db:dbget(M#module.name, 'MODULE'),
+ State = #state{mname=Module#module.name,
+ module=Module#module{typeorval=[]},
+ erule=Erule,
+ inputmodules=InputModules,
+ options=Opts,
+ sourcedir=filename:dirname(File)},
+ case asn1ct_check:check(State, Module#module.typeorval) of
+ {error,Reason} ->
+ {error,St#st{error=Reason}};
+ {ok,NewTypeOrVal,GenTypeOrVal} ->
+ NewM = Module#module{typeorval=NewTypeOrVal},
+ asn1_db:dbput(NewM#module.name, 'MODULE', NewM),
+ asn1_db:dbsave(DbFile, M#module.name),
+ verbose("--~p--~n", [{generated,DbFile}], Opts),
+ {ok,St#st{code={M,GenTypeOrVal}}}
+ end;
+ {error,Reason} ->
+ {error,St#st{error=Reason}}
+ end.
+
+save_pass(#st{code=M,erule=Erule,dbfile=DbFile}=St) ->
+ ok = asn1ct_check:storeindb(#state{erule=Erule}, M),
+ asn1_db:dbsave(DbFile,M#module.name),
+ {ok,St}.
+
+abs_listing(#st{code={M,_},outfile=OutFile}) ->
+ pretty2(M#module.name, OutFile++".abs"),
+ done.
+generate_pass(#st{code=Code,outfile=OutFile,erule=Erule,opts=Opts}=St0) ->
+ St = St0#st{code=undefined}, %Reclaim heap space
+ case generate(Code, OutFile, Erule, Opts) of
+ {error,Reason} ->
+ {error,St#st{error=Reason}};
+ ok ->
+ {ok,St}
+ end.
+
+compile_pass(#st{outfile=OutFile,opts=Opts0}=St) ->
+ asn1_db:dbstop(), %Reclaim memory.
+ asn1ct_table:delete([renamed_defs,original_imports,automatic_tags]),
+ Opts = remove_asn_flags(Opts0),
+ case c:c(OutFile, Opts) of
+ {ok,_Module} ->
+ {ok,St};
+ _ ->
+ {error,St}
+ end.
+
+run_passes(Passes, #st{opts=Opts}=St) ->
+ Run = case lists:member(time, Opts) of
+ false ->
+ fun(_, Pass, S) -> Pass(S) end;
+ true ->
+ fun run_tc/3
+ end,
+ run_passes_1(Passes, St#st{run=Run}).
+
+run_tc(Name, Fun, St) ->
+ Before0 = statistics(runtime),
+ Val = (catch Fun(St)),
+ After0 = statistics(runtime),
+ {Before_c, _} = Before0,
+ {After_c, _} = After0,
+ io:format("~-31s: ~10.2f s\n",
+ [Name,(After_c-Before_c) / 1000]),
+ Val.
+
+run_passes_1([{unless,Opt,Pass}|Passes], #st{opts=Opts}=St) ->
+ case proplists:get_bool(Opt, Opts) of
+ false ->
+ run_passes_1([Pass|Passes], St);
+ true ->
+ run_passes_1(Passes, St)
+ end;
+run_passes_1([{iff,Opt,Pass}|Passes], #st{opts=Opts}=St) ->
+ case proplists:get_bool(Opt, Opts) of
+ true ->
+ run_passes_1([Pass|Passes], St);
+ false ->
+ run_passes_1(Passes, St)
+ end;
+run_passes_1([{pass,Name,Pass}|Passes], #st{run=Run}=St0)
+ when is_function(Pass, 1) ->
+ try Run(Name, Pass, St0) of
+ {ok,St} ->
+ run_passes_1(Passes, St);
+ {error,#st{error=Errors}} ->
+ {Structured,AllErrors} = clean_errors(Errors),
+ print_structured_errors(Structured),
+ {error,AllErrors};
+ done ->
+ ok
+ catch
+ Class:Error ->
+ Stk = erlang:get_stacktrace(),
+ io:format("Internal error: ~p:~p\n~p\n",
+ [Class,Error,Stk]),
+ {error,{internal_error,{Class,Error}}}
+ end;
+run_passes_1([], _St) ->
+ ok.
+
+clean_errors(Errors) when is_list(Errors) ->
+ F = fun({structured_error,_,_,_}) -> true;
+ (_) -> false
+ end,
+ {Structured0,AdHoc} = lists:partition(F, Errors),
+ Structured = lists:sort(Structured0),
+ {Structured,Structured ++ AdHoc};
+clean_errors(AdHoc) -> {[],AdHoc}.
+
+print_structured_errors([_|_]=Errors) ->
+ _ = [io:format("~ts:~w: ~ts\n", [F,L,M:format_error(E)]) ||
+ {structured_error,{F,L},M,E} <- Errors],
+ ok;
+print_structured_errors(_) -> ok.
+
+compile1(File, #st{opts=Opts}=St0) ->
+ verbose("Erlang ASN.1 version ~p, compiling ~p~n", [?vsn,File], Opts),
+ verbose("Compiler Options: ~p~n", [Opts], Opts),
+ Passes = single_passes(),
+ Base = filename:rootname(filename:basename(File)),
+ OutFile = outfile(Base, "", Opts),
+ DbFile = outfile(Base, "asn1db", Opts),
+ St1 = St0#st{file=File,outfile=OutFile,dbfile=DbFile},
+ run_passes(Passes, St1).
%%****************************************************************************%%
%% functions dealing with compiling of several input files to one output file %%
@@ -134,53 +348,20 @@ compile1(File,Options) when is_list(Options) ->
%% compile_set/3 merges and compiles a number of asn1 modules
%% specified in a .set.asn file to one .erl file.
-compile_set(SetBase,Files,Options)
- when is_list(hd(Files)),is_list(Options) ->
- %% case when there are several input files in a list
- verbose("Erlang ASN.1 version ~p compiling ~p ~n",[?vsn,Files],Options),
- verbose("Compiler Options: ~p~n",[Options],Options),
- OutFile = outfile(SetBase,"",Options),
- DbFile = outfile(SetBase,"asn1db",Options),
- Includes = [I || {i,I} <- Options],
- EncodingRule = get_rule(Options),
- ScanRes = scan_set(Files,Options),
- ParseRes = parse_set(ScanRes,Options),
- Result =
- case [X||X <- ParseRes,element(1,X)==true] of
- [] -> %% all were false, time to quit
- lists:map(fun(X)->element(2,X) end,ParseRes);
- ParseRes -> %% all were true, continue with check
- InputModules =
- lists:map(
- fun(F)->
- E = filename:extension(F),
- B = filename:basename(F,E),
- if
- is_list(B) -> list_to_atom(B);
- true -> B
- end
- end,
- Files),
- check_set(ParseRes,SetBase,OutFile,Includes,
- EncodingRule,DbFile,Options,InputModules);
- Other ->
- {error,{'unexpected error in scan/parse phase',
- lists:map(fun(X)->element(3,X) end,Other)}}
- end,
- Result.
-
-check_set(ParseRes,SetBase,OutFile,Includes,EncRule,DbFile,
- Options,InputModules) ->
-
- MergedModule = merge_modules(ParseRes,SetBase),
- SetM = MergedModule#module{name=SetBase},
- Continue1 = check({true,SetM},SetBase,OutFile,Includes,EncRule,DbFile,
- Options,InputModules),
- Continue2 = generate(Continue1,OutFile,EncRule,Options),
-
- asn1ct_table:delete([renamed_defs, original_imports, automatic_tags]),
-
- compile_erl(Continue2, OutFile, Options).
+compile_set(SetBase, Files, #st{opts=Opts}=St0) ->
+ verbose("Erlang ASN.1 version ~p compiling ~p ~n", [?vsn,Files], Opts),
+ verbose("Compiler Options: ~p~n",[Opts], Opts),
+ OutFile = outfile(SetBase, "", Opts),
+ DbFile = outfile(SetBase, "asn1db", Opts),
+ InputModules = [begin
+ F1 = filename:basename(F0),
+ F = filename:rootname(F1),
+ list_to_atom(F)
+ end || F0 <- Files],
+ St = St0#st{file=SetBase,files=Files,outfile=OutFile,
+ dbfile=DbFile,inputmodules=InputModules},
+ Passes = set_passes(),
+ run_passes(Passes, St).
%% merge_modules/2 -> returns a module record where the typeorval lists are merged,
%% the exports lists are merged, the imports lists are merged when the
@@ -188,8 +369,7 @@ check_set(ParseRes,SetBase,OutFile,Includes,EncRule,DbFile,
%% field gets the shared value if all modules have same tagging scheme,
%% otherwise a tagging_error exception is thrown,
%% the extensiondefault ...(not handled yet).
-merge_modules(ParseRes,CommonName) ->
- ModuleList = lists:map(fun(X)->element(2,X) end,ParseRes),
+merge_modules(ModuleList, CommonName) ->
NewModuleList = remove_name_collisions(ModuleList),
case asn1ct_table:size(renamed_defs) of
0 -> asn1ct_table:delete(renamed_defs);
@@ -379,6 +559,8 @@ get_pos_of_def(#pobjectdef{pos=Pos}) ->
Pos;
get_pos_of_def(#pobjectsetdef{pos=Pos}) ->
Pos;
+get_pos_of_def(#'Externalvaluereference'{pos=Pos}) ->
+ Pos;
get_pos_of_def(_) ->
undefined.
@@ -651,123 +833,9 @@ delete_double_of_symbol1([],Acc) ->
Acc.
-scan_set(Files,Options) ->
- %% The files in Files already have their relative path and extension
- lists:map(
- fun(F)->
- case scan(F,Options) of
- {false,{error,Reason}} ->
- throw({error,{'scan error in file:',F,Reason}});
- {TrueOrFalse,Res} ->
- {TrueOrFalse,Res,F}
- end
- end,
- Files).
-
-parse_set(ScanRes,Options) ->
- lists:map(
- fun({TorF,Toks,F})->
- case parse({TorF,Toks},F,Options) of
- {false,{error,Reason}} ->
- throw({error,{'parse error in file:',F,Reason}});
- {TrueOrFalse,Res} ->
- {TrueOrFalse,Res,F}
- end
- end,
- ScanRes).
-
-
%%***********************************
-
-scan(File,Options) ->
- case asn1ct_tok:file(File) of
- {error,Reason} ->
- error("~p~n",[Reason],Options),
- {false,{error,Reason}};
- Tokens ->
- case lists:member(ss,Options) of
- true -> % we terminate after scan
- {false,Tokens};
- false -> % continue with next pass
- {true,Tokens}
- end
- end.
-
-
-parse({true,Tokens},File,Options) ->
- %Presult = asn1ct_parser2:parse(Tokens),
- %%case lists:member(p1,Options) of
- %% true ->
- %% asn1ct_parser:parse(Tokens);
- %% _ ->
- %% asn1ct_parser2:parse(Tokens)
- %% end,
- case catch asn1ct_parser2:parse(Tokens) of
- {error,{{Line,_Mod,Message},_TokTup}} ->
- if
- is_integer(Line) ->
- BaseName = filename:basename(File),
- error("syntax error at line ~p in module ~s:~n",
- [Line,BaseName],Options);
- true ->
- error("syntax error in module ~p:~n",
- [File],Options)
- end,
- print_error_message(Message),
- {false,{error,Message}};
- {error,{Line,_Mod,[Message,Token]}} ->
- error("syntax error: ~p ~p at line ~p~n",
- [Message,Token,Line],Options),
- {false,{error,{Line,[Message,Token]}}};
- {ok,M} ->
- case lists:member(sp,Options) of
- true -> % terminate after parse
- {false,M};
- false -> % continue with next pass
- {true,M}
- end;
- OtherError ->
- error("~p~n",[OtherError],Options)
- end;
-parse({false,Tokens},_,_) ->
- {false,Tokens}.
-
-check({true,M},File,OutFile,Includes,EncodingRule,DbFile,Options,InputMods) ->
-
- start(Includes),
- case asn1ct_check:storeindb(#state{erule=EncodingRule},M) of
- ok ->
- Module = asn1_db:dbget(M#module.name,'MODULE'),
- State = #state{mname=Module#module.name,
- module=Module#module{typeorval=[]},
- erule=EncodingRule,
- inputmodules=InputMods,
- options=Options,
- sourcedir=filename:dirname(File)},
- Check = asn1ct_check:check(State,Module#module.typeorval),
- case {Check,lists:member(abs,Options)} of
- {{error,Reason},_} ->
- {false,{error,Reason}};
- {{ok,NewTypeOrVal,_},true} ->
- NewM = Module#module{typeorval=NewTypeOrVal},
- asn1_db:dbput(NewM#module.name,'MODULE',NewM),
- pretty2(M#module.name,lists:concat([OutFile,".abs"])),
- {false,ok};
- {{ok,NewTypeOrVal,GenTypeOrVal},_} ->
- NewM = Module#module{typeorval=NewTypeOrVal},
- asn1_db:dbput(NewM#module.name,'MODULE',NewM),
- asn1_db:dbsave(DbFile,M#module.name),
- verbose("--~p--~n",[{generated,DbFile}],Options),
- {true,{M,NewM,GenTypeOrVal}}
- end;
- ErrorList = {error,_} ->
- {false,ErrorList}
- end;
-check({false,M},_,_,_,_,_,_,_) ->
- {false,M}.
-
-generate({true,{M,_Module,GenTOrV}}, OutFile, EncodingRule, Options) ->
+generate({M,GenTOrV}, OutFile, EncodingRule, Options) ->
debug_on(Options),
setup_bit_string_format(Options),
put(encoding_options,Options),
@@ -796,19 +864,7 @@ generate({true,{M,_Module,GenTOrV}}, OutFile, EncodingRule, Options) ->
erase(tlv_format), % used in ber
erase(class_default_type),% used in ber
asn1ct_table:delete(check_functions),
- case Result of
- {error,_} ->
- {false,Result};
- ok ->
- case lists:member(sg,Options) of
- true -> % terminate here , with .erl file generated
- {false,true};
- false ->
- {true,true}
- end
- end;
-generate({false,M},_,_,_) ->
- {false,M}.
+ Result.
setup_bit_string_format(Opts) ->
Format = case {lists:member(compact_bit_string, Opts),
@@ -836,14 +892,13 @@ get_bit_string_format() ->
parse_and_save(Module,S) ->
Options = S#state.options,
SourceDir = S#state.sourcedir,
- Includes = [I || {i,I} <-Options],
-
- case get_input_file(Module,[SourceDir|Includes]) of
+ Includes = [I || {i,I} <- Options],
+ case get_input_file(Module, [SourceDir|Includes]) of
%% search for asn1 source
{file,SuffixedASN1source} ->
case dbfile_uptodate(SuffixedASN1source,Options) of
false ->
- parse_and_save1(S,SuffixedASN1source,Options,Includes);
+ parse_and_save1(S, SuffixedASN1source, Options);
_ -> ok
end;
Err ->
@@ -851,24 +906,14 @@ parse_and_save(Module,S) ->
[lists:concat([Module,".asn1db"])],Options),
{error,{asn1,input_file_error,Err}}
end.
-parse_and_save1(S,File,Options,Includes) ->
+
+parse_and_save1(#state{erule=Erule}, File, Options) ->
Ext = filename:extension(File),
- Base = filename:basename(File,Ext),
- DbFile = outfile(Base,"asn1db",Options),
- Continue1 = scan(File,Options),
- M =
- case parse(Continue1,File,Options) of
- {true,Mod} -> Mod;
- _ ->
-%% io:format("~p~nnow I die!!!!!!!!!!!~n",[File]),
- exit({error,{asn1,File,"no such file"}})
- end,
-% start(["."|Includes]),
- start(Includes),
- case asn1ct_check:storeindb(S,M) of
- ok ->
- asn1_db:dbsave(DbFile,M#module.name)
- end.
+ Base = filename:basename(File, Ext),
+ DbFile = outfile(Base, "asn1db", Options),
+ St = #st{file=File,dbfile=DbFile,erule=Erule},
+ Passes = parse_and_save_passes(),
+ run_passes(Passes, St).
get_input_file(Module,[]) ->
Module;
@@ -926,13 +971,6 @@ dbfile_uptodate(File,Options) ->
end.
-compile_erl({true,_},OutFile,Options) ->
- erl_compile(OutFile,Options);
-compile_erl({false,true},_,_) ->
- ok;
-compile_erl({false,Result},_,_) ->
- Result.
-
input_file_type(Name,I) ->
case input_file_type(Name) of
{error,_} -> input_file_type2(filename:basename(Name),I);
@@ -1064,22 +1102,6 @@ translate_options([H|T]) ->
[H|translate_options(T)];
translate_options([]) -> [].
-erl_compile(OutFile,Options) ->
-% io:format("Options:~n~p~n",[Options]),
- case lists:member(noobj,Options) of
- true ->
- ok;
- _ ->
- ErlOptions = remove_asn_flags(Options),
- %% io:format("~n~nc:c(~p,~p)~n~n",[OutFile,ErlOptions]),
- case c:c(OutFile,ErlOptions) of
- {ok,_Module} ->
- ok;
- _ ->
- {error,'no_compilation'}
- end
- end.
-
remove_asn_flags(Options) ->
[X || X <- Options,
X /= get_rule(Options),
@@ -1216,7 +1238,6 @@ make_erl_options(Opts) ->
lists:map(fun(Dir) -> {i, Dir} end, Includes)]++Specific.
pretty2(Module,AbsFile) ->
- start(),
{ok,F} = file:open(AbsFile,[write]),
M = asn1_db:dbget(Module,'MODULE'),
io:format(F,"%%%%%%%%%%%%%%%%%%% ~p %%%%%%%%%%%%%%%%%%%~n",[Module]),
@@ -1251,10 +1272,6 @@ pretty2(Module,AbsFile) ->
lists:foreach(fun(T)-> io:format(F,"~s.\n",
[asn1ct_pretty_format:term(asn1_db:dbget(Module,T))])
end,ObjectSets).
-start() ->
- Includes = ["."],
- start(Includes).
-
start(Includes) when is_list(Includes) ->
asn1_db:dbstart(Includes).
@@ -2097,52 +2114,6 @@ update_namelist(Name) ->
Other -> Other
end.
-pop_namelist() ->
- DeepTail = %% removes next element in order
- fun([[{_,A}]|T],_Fun) when is_atom(A) -> T;
- ([{_N,L}|T],_Fun) when is_list(L) -> [L|T];
- ([[]|T],Fun) -> Fun(T,Fun);
- ([L1|L2],Fun) when is_list(L1) ->
- case lists:flatten(L1) of
- [] -> Fun([L2],Fun);
- _ -> [Fun(L1,Fun)|L2]
- end;
- ([_H|T],_Fun) -> T
- end,
- {Pop,NewNL} =
- case get_gen_state_field(namelist) of
- [] -> {[],[]};
- L ->
- {next_namelist_el(L),
- DeepTail(L,DeepTail)}
- end,
- update_gen_state(namelist,NewNL),
- Pop.
-
-%% next_namelist_el fetches the next type/component name in turn in
-%% the namelist, without changing the namelist.
-next_namelist_el() ->
- case get_gen_state_field(namelist) of
- undefined -> undefined;
- L when is_list(L) -> next_namelist_el(L)
- end.
-
-next_namelist_el([]) ->
- [];
-next_namelist_el([L]) when is_list(L) ->
- next_namelist_el(L);
-next_namelist_el([H|_]) when is_atom(H) ->
- H;
-next_namelist_el([L|T]) when is_list(L) ->
- case next_namelist_el(L) of
- [] ->
- next_namelist_el([T]);
- R ->
- R
- end;
-next_namelist_el([H={_,A}|_]) when is_atom(A) ->
- H.
-
%% removes a bracket from the namelist
step_in_constructed() ->
case get_gen_state_field(namelist) of
@@ -2382,14 +2353,6 @@ maybe_saved_sindex(Name,Pattern) ->
end
end.
-next_sindex() ->
- SI = get_gen_state_field(suffix_index),
- update_gen_state(suffix_index,SI+1),
- SI+1.
-
-latest_sindex() ->
- get_gen_state_field(suffix_index).
-
current_sindex() ->
get_gen_state_field(current_suffix_index).
diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl
index 0622998445..f94550b0a4 100644
--- a/lib/asn1/src/asn1ct_check.erl
+++ b/lib/asn1/src/asn1ct_check.erl
@@ -25,7 +25,7 @@
%-compile(export_all).
%% Avoid warning for local function error/1 clashing with autoimported BIF.
-compile({no_auto_import,[error/1]}).
--export([check/2,storeindb/2]).
+-export([check/2,storeindb/2,format_error/1]).
%-define(debug,1).
-include("asn1_records.hrl").
%%% The tag-number for universal types
@@ -73,7 +73,6 @@
end).
-record(newt,{type=unchanged,tag=unchanged,constraint=unchanged,inlined=no}). % used in check_type to update type and tag
--record(newv,{type=unchanged,value=unchanged}). % used in check_value to update type and value
check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) ->
%%Predicates used to filter errors
@@ -92,14 +91,14 @@ check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) ->
save_asn1db_uptodate(S,S#state.erule,S#state.mname),
put(top_module,S#state.mname),
- _Perror = checkp(S,ParameterizedTypes,[]), % must do this before the templates are used
+ _ = checkp(S, ParameterizedTypes), %must do this before the templates are used
%% table to save instances of parameterized objects,object sets
asn1ct_table:new(parameterized_objects),
asn1ct_table:new(inlined_objects),
- Terror = checkt(S,Types,[]),
+ Terror = checkt(S, Types),
?dbg("checkt finished with errors:~n~p~n~n",[Terror]),
%% get parameterized object sets sent to checkt/3
@@ -107,7 +106,7 @@ check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) ->
{PObjSetNames1,Terror2} = filter_errors(IsPObjSet,Terror),
- Verror = checkv(S,Values ++ ObjectSets,[]), %value sets may be parsed as object sets
+ Verror = checkv(S, Values ++ ObjectSets), %value sets may be parsed as object sets
?dbg("checkv finished with errors:~n~p~n~n",[Verror]),
%% get information object classes wrongly sent to checkt/3
%% and update Terror2
@@ -116,7 +115,7 @@ check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) ->
NewClasses = Classes++AddClasses,
- Cerror = checkc(S,NewClasses,[]),
+ Cerror = checkc(S, NewClasses),
?dbg("checkc finished with errors:~n~p~n~n",[Cerror]),
%% get object sets incorrectly sent to checkv/3
%% and update Verror
@@ -175,8 +174,9 @@ check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) ->
{NewTypes,NewValues,ParameterizedTypes,NewClasses,
lists:subtract(NewObjects,ExclO)++InlinedObjects,
lists:subtract(NewObjectSets,ExclOS)++ParObjectSetNames}};
- _ ->{error,{asn1,lists:flatten([Terror3,Verror5,Cerror,
- Oerror,Exporterror,ImportError])}}
+ _ ->
+ {error,lists:flatten([Terror3,Verror5,Cerror,
+ Oerror,Exporterror,ImportError])}
end.
context_switch_in_spec() ->
@@ -338,51 +338,40 @@ chained_import(S,ImpMod,DefMod,Name) ->
chained_import(S,OtherMod,DefMod,Name)
end
end.
-
-checkt(S,[Name|T],Acc) ->
- ?dbg("Checking type ~p~n",[Name]),
- Result =
- case asn1_db:dbget(S#state.mname,Name) of
- undefined ->
- error({type,{internal_error,'???'},S});
- Type when is_record(Type,typedef) ->
- NewS = S#state{type=Type,tname=Name},
- case catch(check_type(NewS,Type,Type#typedef.typespec)) of
- {error,Reason} ->
- error({type,Reason,NewS});
- {'EXIT',Reason} ->
- error({type,{internal_error,Reason},NewS});
- {asn1_class,_ClassDef} ->
- {asn1_class,Name};
- pobjectsetdef ->
- {pobjectsetdef,Name};
- pvalueset ->
- {pvalueset,Name};
- Ts ->
- case Type#typedef.checked of
- true -> % already checked and updated
- ok;
- _ ->
- NewTypeDef = Type#typedef{checked=true,typespec = Ts},
-
- asn1_db:dbput(NewS#state.mname,Name,NewTypeDef), % update the type
- ok
- end
- end
- end,
- case Result of
- ok ->
- checkt(S,T,Acc);
- _ ->
- checkt(S,T,[Result|Acc])
- end;
-checkt(S,[],Acc) ->
- case check_contextswitchingtypes(S,[]) of
- [] ->
- lists:reverse(Acc);
- L ->
- checkt(S,L,Acc)
+checkt(S0, Names) ->
+ Check = fun do_checkt/3,
+
+ %% NOTE: check_type/3 will store information in the process
+ %% dictionary if context switching types are encountered;
+ %% therefore we must force the evaluation order.
+ Types = check_fold(S0, Names, Check),
+ CtxtSwitch = check_contextswitchingtypes(S0, []),
+ check_fold(S0, lists:reverse(CtxtSwitch), Check) ++ Types.
+
+do_checkt(S, Name, #typedef{typespec=TypeSpec}=Type0) ->
+ NewS = S#state{type=Type0,tname=Name},
+ try check_type(NewS, Type0, TypeSpec) of
+ #type{}=Ts ->
+ case Type0#typedef.checked of
+ true -> %already checked and updated
+ ok;
+ _ ->
+ Type = Type0#typedef{checked=true,
+ typespec=Ts},
+ asn1_db:dbput(NewS#state.mname,
+ Name, Type),
+ ok
+ end
+ catch
+ {error,Reason} ->
+ error({type,Reason,NewS});
+ {asn1_class,_ClassDef} ->
+ {asn1_class,Name};
+ pobjectsetdef ->
+ {pobjectsetdef,Name};
+ pvalueset ->
+ {pvalueset,Name}
end.
check_contextswitchingtypes(S,Acc) ->
@@ -402,131 +391,86 @@ check_contextswitchingtypes(S,[{T,TName}|Ts],Acc) ->
check_contextswitchingtypes(_,[],Acc) ->
Acc.
-checkv(S,[Name|T],Acc) ->
- ?dbg("Checking valuedef ~p~n",[Name]),
- Result = case asn1_db:dbget(S#state.mname,Name) of
- undefined -> error({value,{internal_error,'???'},S});
- Value when is_record(Value,valuedef);
- is_record(Value,typedef); %Value set may be parsed as object set.
- is_record(Value,pvaluedef);
- is_record(Value,pvaluesetdef) ->
- NewS = S#state{value=Value},
- case catch(check_value(NewS,Value)) of
- {error,Reason} ->
- error({value,Reason,NewS});
- {'EXIT',Reason} ->
- error({value,{internal_error,Reason},NewS});
- {pobjectsetdef} ->
- {pobjectsetdef,Name};
- {objectsetdef} ->
- {objectsetdef,Name};
- {objectdef} ->
- %% this is an object, save as typedef
- #valuedef{checked=C,pos=Pos,name=N,type=Type,
- value=Def}=Value,
- ClassName = Type#type.def,
- NewSpec = #'Object'{classname=ClassName,
- def=Def},
- NewDef = #typedef{checked=C,pos=Pos,name=N,
- typespec=NewSpec},
- asn1_db:dbput(NewS#state.mname,Name,NewDef),
- {objectdef,Name};
- {valueset,VSet} ->
- Pos = asn1ct:get_pos_of_def(Value),
- CheckedVSDef = #typedef{checked=true,pos=Pos,
- name=Name,typespec=VSet},
- asn1_db:dbput(NewS#state.mname,Name,CheckedVSDef),
- {valueset,Name};
- V ->
- %% update the valuedef
- asn1_db:dbput(NewS#state.mname,Name,V),
- ok
- end
- end,
- case Result of
- ok ->
- checkv(S,T,Acc);
- _ ->
- checkv(S,T,[Result|Acc])
- end;
-checkv(_S,[],Acc) ->
- lists:reverse(Acc).
-
-
-checkp(S,[Name|T],Acc) ->
- %io:format("check_ptypedef:~p~n",[Name]),
- Result = case asn1_db:dbget(S#state.mname,Name) of
- undefined ->
- error({type,{internal_error,'???'},S});
- Type when is_record(Type,ptypedef) ->
- NewS = S#state{type=Type,tname=Name},
- case catch(check_ptype(NewS,Type,Type#ptypedef.typespec)) of
- {error,Reason} ->
- error({type,Reason,NewS});
- {'EXIT',Reason} ->
- error({type,{internal_error,Reason},NewS});
- {asn1_class,_ClassDef} ->
- {asn1_class,Name};
- {asn1_param_class,_} -> ok;
- Ts ->
- NewType = Type#ptypedef{checked=true,typespec = Ts},
- asn1_db:dbput(NewS#state.mname,Name,NewType), % update the type
- ok
- end
- end,
- case Result of
- ok ->
- checkp(S,T,Acc);
- _ ->
- checkp(S,T,[Result|Acc])
- end;
-checkp(_S,[],Acc) ->
- lists:reverse(Acc).
-
+checkv(S, Names) ->
+ check_fold(S, Names, fun do_checkv/3).
+
+do_checkv(S, Name, Value)
+ when is_record(Value, valuedef);
+ is_record(Value, typedef); %Value set may be parsed as object set.
+ is_record(Value, pvaluedef);
+ is_record(Value, pvaluesetdef) ->
+ NewS = S#state{value=Value},
+ try check_value(NewS, Value) of
+ {valueset,VSet} ->
+ Pos = asn1ct:get_pos_of_def(Value),
+ CheckedVSDef = #typedef{checked=true,pos=Pos,
+ name=Name,typespec=VSet},
+ asn1_db:dbput(NewS#state.mname, Name, CheckedVSDef),
+ {valueset,Name};
+ V ->
+ %% update the valuedef
+ asn1_db:dbput(NewS#state.mname, Name, V),
+ ok
+ catch
+ {error,Reason} ->
+ error({value,Reason,NewS});
+ {pobjectsetdef} ->
+ {pobjectsetdef,Name};
+ {objectsetdef} ->
+ {objectsetdef,Name};
+ {objectdef} ->
+ %% this is an object, save as typedef
+ #valuedef{checked=C,pos=Pos,name=N,type=Type,
+ value=Def} = Value,
+ ClassName = Type#type.def,
+ NewSpec = #'Object'{classname=ClassName,def=Def},
+ NewDef = #typedef{checked=C,pos=Pos,name=N,typespec=NewSpec},
+ asn1_db:dbput(NewS#state.mname, Name, NewDef),
+ {objectdef,Name}
+ end.
+%% Check parameterized types.
+checkp(S, Names) ->
+ check_fold(S, Names, fun do_checkp/3).
+do_checkp(S0, Name, #ptypedef{typespec=TypeSpec}=Type0) ->
+ S = S0#state{type=Type0,tname=Name},
+ try check_ptype(S, Type0, TypeSpec) of
+ #type{}=Ts ->
+ Type = Type0#ptypedef{checked=true,typespec=Ts},
+ asn1_db:dbput(S#state.mname, Name, Type),
+ ok
+ catch
+ {error,Reason} ->
+ error({type,Reason,S});
+ {asn1_class,_ClassDef} ->
+ {asn1_class,Name};
+ {asn1_param_class,_} ->
+ ok
+ end.
-checkc(S,[Name|Cs],Acc) ->
- Result =
- case asn1_db:dbget(S#state.mname,Name) of
- undefined ->
- error({class,{internal_error,'???'},S});
- Class ->
- ClassSpec = if
- is_record(Class,classdef) ->
-% Class#classdef.typespec;
- Class;
- is_record(Class,typedef) ->
- Class#typedef.typespec
- end,
- NewS = S#state{type=Class,tname=Name},
- case catch(check_class(NewS,ClassSpec)) of
- {error,Reason} ->
- error({class,Reason,NewS});
- {'EXIT',Reason} ->
- error({class,{internal_error,Reason},NewS});
- C ->
- %% update the classdef
- NewClass =
- if
- is_record(Class,classdef) ->
- Class#classdef{checked=true,typespec=C};
- is_record(Class,typedef) ->
- #classdef{checked=true,name=Name,typespec=C}
- end,
- asn1_db:dbput(NewS#state.mname,Name,NewClass),
- ok
- end
+%% Check class definitions.
+checkc(S, Names) ->
+ check_fold(S, Names, fun do_checkc/3).
+
+do_checkc(S0, Name, Class0) ->
+ {Class1,ClassSpec} =
+ case Class0 of
+ #classdef{} ->
+ {Class0,Class0};
+ #typedef{} ->
+ {#classdef{name=Name},Class0#typedef.typespec}
end,
- case Result of
- ok ->
- checkc(S,Cs,Acc);
- _ ->
- checkc(S,Cs,[Result|Acc])
- end;
-checkc(_S,[],Acc) ->
-%% include_default_class(S#state.mname),
- lists:reverse(Acc).
+ S = S0#state{type=Class0,tname=Name},
+ try check_class(S, ClassSpec) of
+ C ->
+ Class = Class1#classdef{checked=true,typespec=C},
+ asn1_db:dbput(S#state.mname, Name, Class),
+ ok
+ catch
+ {error,Reason} ->
+ error({class,Reason,S})
+ end.
checko(S,[Name|Os],Acc,ExclO,ExclOS) ->
?dbg("Checking object ~p~n",[Name]),
@@ -695,8 +639,7 @@ check_class_fields(S,[F|Fields],Acc) ->
Type2 = maybe_unchecked_OCFT(S,Type),
Cat =
case asn1ct_gen:type(asn1ct_gen:get_inner(Type2#type.def)) of
- Def when is_record(Def,typereference);
- is_record(Def,'Externaltypereference') ->
+ Def when is_record(Def,'Externaltypereference') ->
{_,D} = get_referenced_type(S,Def),
D;
{undefined,user} ->
@@ -876,14 +819,6 @@ check_object(S,
?dbg("check_object set: ~p~n",[ObjSet#'ObjectSet'.set]),
{_,ClassDef} = get_referenced_type(S,ClassRef),
NewClassRef = check_externaltypereference(S,ClassRef),
- %% XXXXXXXXXX
- case ObjSet of
- #'ObjectSet'{set={'Externaltypereference',undefined,'MSAccessProtocol',
- 'AllOperations'}} ->
- ok;
- _ ->
- ok
- end,
{UniqueFieldName,UniqueInfo} =
case (catch get_unique_fieldname(S,ClassDef)) of
{error,'__undefined_',_} ->
@@ -1233,8 +1168,7 @@ check_object_list(S,ClassRef,[ObjOrSet|Objs],Acc) ->
ObjSet when is_record(ObjSet,type) ->
ObjSetDef =
case ObjSet#type.def of
- Ref when is_record(Ref,typereference);
- is_record(Ref,'Externaltypereference') ->
+ Ref when is_record(Ref,'Externaltypereference') ->
{_,D} = get_referenced_type(S,ObjSet#type.def),
D;
Other ->
@@ -1826,10 +1760,6 @@ convert_to_defaultfield(S,ObjFieldName,[OFS|RestOFS],CField)->
T = check_type(S,#typedef{typespec=ObjFieldSetting},
ObjFieldSetting),
{#typedef{checked=true,name=Bif,typespec=T},RestSettings};
- _OCFT = #'ObjectClassFieldType'{} ->
- T=check_type(S,#typedef{typespec=ObjFieldSetting},ObjFieldSetting),
- %%io:format("OCFT=~p~n,T=~p~n",[OCFT,T]),
- {#typedef{checked=true,typespec=T},RestSettings};
_ ->
%this case should not happen any more
{Mod,T} =
@@ -2140,172 +2070,72 @@ check_value(S,#valuedef{pos=Pos,name=Name,type=Type,
NewType = Type#type{constraint=[Constr]},
{valueset,
check_type(S,#typedef{pos=Pos,name=Name,typespec=NewType},NewType)};
-check_value(OldS=#state{recordtopname=TopName},V) when is_record(V,valuedef) ->
- #valuedef{name=Name,checked=Checked,type=Vtype,
- value=Value,module=ModName} = V,
- ?dbg("check_value, V: ~p~n",[V]),
- case Checked of
- true ->
- V;
- {error,_} ->
+check_value(S, #valuedef{}=V) ->
+ ?dbg("check_value, V: ~p~n",[V0]),
+ case V of
+ #valuedef{checked=true} ->
V;
- false ->
- Def = Vtype#type.def,
- Constr = Vtype#type.constraint,
- S = OldS#state{type=Vtype,tname=Def,value=V,vname=Name},
- SVal = update_state(S,ModName),
- NewDef =
- case Def of
- Ext when is_record(Ext,'Externaltypereference') ->
- RecName = Ext#'Externaltypereference'.type,
- {RefM,Type} = get_referenced_type(S,Ext),
- %% If V isn't a value but an object Type is a #classdef{}
- %%NewS = S#state{mname=RefM},
- NewS = update_state(S,RefM),
- case Type of
- #classdef{} ->
- throw({objectdef});
- #typedef{} ->
- case is_contextswitchtype(Type) of
- true ->
- #valuedef{value=CheckedVal}=
- check_value(NewS,V#valuedef{type=Type#typedef.typespec}),
- #newv{value=CheckedVal};
- _ ->
- #valuedef{value=CheckedVal}=
- check_value(NewS#state{recordtopname=[RecName|TopName]},
- V#valuedef{type=Type#typedef.typespec}),
- #newv{value=CheckedVal}
- end;
- #type{} ->
- %% A parameter that couldn't be categorized.
- #valuedef{value=CheckedVal}=
- check_value(NewS#state{recordtopname=[RecName|TopName]},
- V#valuedef{type=Type}),
- #newv{value=CheckedVal}
- end;
- 'ANY' ->
- case Value of
- {opentypefieldvalue,ANYType,ANYValue} ->
- CheckedV=
- check_value(SVal,#valuedef{name=Name,
- type=ANYType,
- value=ANYValue,
- module=ModName}),
- #newv{value=CheckedV#valuedef.value};
- _ ->
- throw({error,{asn1,{'cant check value of type',Def}}})
- end;
- 'INTEGER' ->
- ok=validate_integer(SVal,Value,[],Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- {'INTEGER',NamedNumberList} ->
- ok=validate_integer(SVal,Value,NamedNumberList,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- {'BIT STRING',NamedNumberList} ->
- ok=validate_bitstring(SVal,Value,NamedNumberList,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'NULL' ->
- ok=validate_null(SVal,Value,Constr),
- #newv{};
- 'OBJECT IDENTIFIER' ->
- {ok,_}=validate_objectidentifier(SVal,Value,Constr),
- #newv{value = normalize_value(SVal,Vtype,Value,[])};
- 'RELATIVE-OID' ->
- {ok,_}=validate_relative_oid(SVal,Value,Constr),
- #newv{value = Value};
- 'ObjectDescriptor' ->
- ok=validate_objectdescriptor(SVal,Value,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'REAL' ->
- ok = validate_real(SVal,Value,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- {'ENUMERATED',NamedNumberList} ->
- ok=validate_enumerated(SVal,Value,NamedNumberList,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'BOOLEAN'->
- ok=validate_boolean(SVal,Value,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'OCTET STRING' ->
- ok=validate_octetstring(SVal,Value,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'NumericString' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- TString when TString =:= 'TeletexString';
- TString =:= 'T61String' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'VideotexString' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'UTCTime' ->
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
-% exit({'cant check value of type' ,Def});
- 'GeneralizedTime' ->
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
-% exit({'cant check value of type' ,Def});
- 'GraphicString' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'VisibleString' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'GeneralString' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'PrintableString' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'IA5String' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'BMPString' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'UTF8String' ->
- ok = validate_restrictedstring(SVal,Vtype,Value,Constr),
- %%io:format("Vtype: ~p~nValue: ~p~n",[Vtype,Value]);
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'UniversalString' -> %added 6/12 -00
- ok = validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- Seq when is_record(Seq,'SEQUENCE') ->
- {ok,SeqVal} = validate_sequence(SVal,Value,
- Seq#'SEQUENCE'.components,
- Constr),
- #newv{value=normalize_value(SVal,Vtype,SeqVal,TopName)};
- {'SEQUENCE OF',Components} ->
- ok=validate_sequenceof(SVal,Value,Components,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,TopName)};
- {'CHOICE',Components} ->
- ok=validate_choice(SVal,Value,Components,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,TopName)};
- Set when is_record(Set,'SET') ->
- ok=validate_set(SVal,Value,Set#'SET'.components,
- Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,TopName)};
- {'SET OF',Components} ->
- ok=validate_setof(SVal,Value,Components,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,TopName)};
- {'SelectionType',SelName,SelT} ->
- CheckedT = check_selectiontype(SVal,SelName,SelT),
- NewV = V#valuedef{type=CheckedT},
- SelVDef=check_value(S#state{value=NewV},NewV),
- #newv{value=SelVDef#valuedef.value};
- Other ->
- exit({'cannot check value of type' ,Other})
- end,
- case NewDef#newv.value of
- unchanged ->
- V#valuedef{checked=true,value=Value};
- ok ->
- V#valuedef{checked=true,value=Value};
- {error,Reason} ->
- V#valuedef{checked={error,Reason},value=Value};
- _V ->
- V#valuedef{checked=true,value=_V}
- end
+ #valuedef{checked=false} ->
+ check_valuedef(S, V)
+ end.
+
+check_valuedef(#state{recordtopname=TopName}=S0, V0) ->
+ #valuedef{name=Name,type=Vtype,value=Value,module=ModName} = V0,
+ V = V0#valuedef{checked=true},
+ Def = Vtype#type.def,
+ Constr = Vtype#type.constraint,
+ S1 = S0#state{type=Vtype,tname=Def,value=V0,vname=Name},
+ SVal = update_state(S1, ModName),
+ case Def of
+ #'Externaltypereference'{type=RecName}=Ext ->
+ {RefM,Type} = get_referenced_type(S1, Ext),
+ %% If V isn't a value but an object Type is a #classdef{}
+ S2 = update_state(S1, RefM),
+ case Type of
+ #classdef{} ->
+ throw({objectdef});
+ #typedef{typespec=TypeSpec} ->
+ S3 = case is_contextswitchtype(Type) of
+ true ->
+ S2;
+ false ->
+ S2#state{recordtopname=[RecName|TopName]}
+ end,
+ #valuedef{value=CheckedVal} =
+ check_value(S3, V0#valuedef{type=TypeSpec}),
+ V#valuedef{value=CheckedVal};
+ #type{} ->
+ %% A parameter that couldn't be categorized.
+ #valuedef{value=CheckedVal} =
+ check_value(S2#state{recordtopname=[RecName|TopName]},
+ V#valuedef{type=Type}),
+ V#valuedef{value=CheckedVal}
+ end;
+ 'ANY' ->
+ {opentypefieldvalue,ANYType,ANYValue} = Value,
+ CheckedV = check_value(SVal,#valuedef{name=Name,
+ type=ANYType,
+ value=ANYValue,
+ module=ModName}),
+ V#valuedef{value=CheckedV#valuedef.value};
+ 'INTEGER' ->
+ ok = validate_integer(SVal, Value, [], Constr),
+ V#valuedef{value=normalize_value(SVal, Vtype, Value, [])};
+ {'INTEGER',NamedNumberList} ->
+ ok = validate_integer(SVal, Value, NamedNumberList, Constr),
+ V#valuedef{value=normalize_value(SVal, Vtype, Value, [])};
+ #'SEQUENCE'{components=Components} ->
+ {ok,SeqVal} = validate_sequence(SVal, Value,
+ Components, Constr),
+ V#valuedef{value=normalize_value(SVal, Vtype,
+ SeqVal, TopName)};
+ {'SelectionType',SelName,SelT} ->
+ CheckedT = check_selectiontype(SVal, SelName, SelT),
+ NewV = V#valuedef{type=CheckedT},
+ SelVDef = check_value(S1#state{value=NewV}, NewV),
+ V#valuedef{value=SelVDef#valuedef.value};
+ _ ->
+ V#valuedef{value=normalize_value(SVal, Vtype, Value, TopName)}
end.
is_contextswitchtype(#typedef{name='EXTERNAL'})->
@@ -2358,23 +2188,7 @@ validate_integer_ref(S,Ref,NamedNumberList,Constr) ->
-check_integer_range(Int,Constr) when is_list(Constr) ->
- NewConstr = [X || #constraint{c=X} <- Constr],
- check_constr(Int,NewConstr);
-
-check_integer_range(_Int,_Constr) ->
- %%io:format("~p~n",[Constr]),
- ok.
-
-check_constr(Int,[{'ValueRange',Lb,Ub}|T]) when Int >= Lb, Int =< Ub ->
- check_constr(Int,T);
-check_constr(_Int,[]) ->
- ok.
-
-validate_bitstring(_S,_Value,_NamedNumberList,_Constr) ->
- ok.
-
-validate_null(_S,'NULL',_Constr) ->
+check_integer_range(_Int, Constr) when is_list(Constr) ->
ok.
%%------------
@@ -2390,9 +2204,6 @@ is_space_list([],Acc) ->
is_space_list([H|T],Acc) ->
is_space_list(T,[H|Acc]).
-validate_objectidentifier(S,ERef,C) ->
- validate_objectidentifier(S,o_id,ERef,C).
-
validate_objectidentifier(S,OID,ERef,C)
when is_record(ERef,'Externalvaluereference') ->
validate_objectidentifier(S,OID,[ERef],C);
@@ -2490,9 +2301,6 @@ validate_oid(_, S, OID, [Atom|Rest],Acc) when is_atom(Atom) ->
validate_oid(_, S, OID, V, Acc) ->
error({value, {"illegal "++to_string(OID),V,Acc},S}).
-validate_relative_oid(S,Value,Constr) ->
- validate_objectidentifier(S,rel_oid,Value,Constr).
-
is_object_id(OID,S,ERef=#'Externaltypereference'{}) ->
{_,OI} = get_referenced_type(S,ERef),
is_object_id(OID,S,OI#typedef.typespec);
@@ -2579,43 +2387,6 @@ valid_objectid(o_id,_I,[1]) -> false;
valid_objectid(o_id,_I,[2]) -> true;
valid_objectid(_,_,_) -> true.
-
-
-
-
-
-validate_objectdescriptor(_S,_Value,_Constr) ->
- ok.
-
-validate_real(_S,_Value,_Constr) ->
- ok.
-
-validate_enumerated(S,Id,NamedNumberList,_Constr) when is_atom(Id) ->
- case lists:keysearch(Id,1,NamedNumberList) of
- {value,_} -> ok;
- false -> error({value,"unknown ENUMERATED",S})
- end;
-validate_enumerated(S,{identifier,_Pos,Id},NamedNumberList,_Constr) ->
- case lists:keysearch(Id,1,NamedNumberList) of
- {value,_} -> ok;
- false -> error({value,"unknown ENUMERATED",S})
- end;
-validate_enumerated(S,#'Externalvaluereference'{value=Id},
- NamedNumberList,_Constr) ->
- case lists:keysearch(Id,1,NamedNumberList) of
- {value,_} -> ok;
- false -> error({value,"unknown ENUMERATED",S})
- end.
-
-validate_boolean(_S,_Value,_Constr) ->
- ok.
-
-validate_octetstring(_S,_Value,_Constr) ->
- ok.
-
-validate_restrictedstring(_S,_Value,_Def,_Constr) ->
- ok.
-
validate_sequence(S=#state{type=Vtype},Value,_Components,_Constr) ->
case Vtype of
#type{tag=[{tag,'UNIVERSAL',8,'IMPLICIT',32}]} ->
@@ -2630,18 +2401,6 @@ validate_sequence(S=#state{type=Vtype},Value,_Components,_Constr) ->
{ok,Value}
end.
-validate_sequenceof(_S,_Value,_Components,_Constr) ->
- ok.
-
-validate_choice(_S,_Value,_Components,_Constr) ->
- ok.
-
-validate_set(_S,_Value,_Components,_Constr) ->
- ok.
-
-validate_setof(_S,_Value,_Components,_Constr) ->
- ok.
-
to_EXTERNAL1990(S,[{identification,{'CHOICE',{syntax,Stx}}}|Rest]) ->
to_EXTERNAL1990(S,Rest,[{'direct-reference',Stx}]);
to_EXTERNAL1990(S,[{identification,{'CHOICE',{'presentation-context-id',I}}}|Rest]) ->
@@ -2667,7 +2426,8 @@ normalize_value(_,_,mandatory,_) ->
mandatory;
normalize_value(_,_,'OPTIONAL',_) ->
'OPTIONAL';
-normalize_value(S,Type,{'DEFAULT',Value},NameList) ->
+normalize_value(S0, Type, {'DEFAULT',Value}, NameList) ->
+ S = S0#state{value=Value},
case catch get_canonic_type(S,Type,NameList) of
{'BOOLEAN',CType,_} ->
normalize_boolean(S,Value,CType);
@@ -2892,12 +2652,12 @@ hstring_to_octetlist([H|T],BSL,Acc) when H >= $0; H =< $9 ->
hstring_to_octetlist([],_,Acc) ->
lists:reverse(Acc).
-normalize_objectidentifier(S,Value) ->
- {ok,Val}=validate_objectidentifier(S,Value,[]),
+normalize_objectidentifier(S, Value) ->
+ {ok,Val} = validate_objectidentifier(S, o_id, Value, []),
Val.
normalize_relative_oid(S,Value) ->
- {ok,Val} = validate_relative_oid(S,Value,[]),
+ {ok,Val} = validate_objectidentifier(S, rel_oid, Value, []),
Val.
normalize_objectdescriptor(Value) ->
@@ -2906,29 +2666,20 @@ normalize_objectdescriptor(Value) ->
normalize_real(Value) ->
Value.
-normalize_enumerated(S,#'Externalvaluereference'{value=V},CType)
- when is_list(CType) ->
- normalize_enumerated2(S,V,CType);
-normalize_enumerated(S,Value,CType) when is_atom(Value),is_list(CType) ->
- normalize_enumerated2(S,Value,CType);
-normalize_enumerated(S,{Name,EnumV},CType) when is_atom(Name) ->
- normalize_enumerated(S,EnumV,CType);
-normalize_enumerated(S,Value,{CType1,CType2}) when is_list(CType1), is_list(CType2)->
- normalize_enumerated(S,Value,CType1++CType2);
-normalize_enumerated(S,V,CType) ->
- asn1ct:warning("Enumerated unknown type ~p~n",[CType],S,
- "Enumerated unknown type"),
- V.
-normalize_enumerated2(S,V,Enum) ->
- case lists:keysearch(V,1,Enum) of
- {value,{Val,_}} -> Val;
- _ ->
- asn1ct:warning("enumerated value is not correct ~p~n",[V],S,
- "enumerated value is not correct"),
- V
+normalize_enumerated(S, Id, {Base,Ext}) ->
+ %% Extensible ENUMERATED.
+ normalize_enumerated(S, Id, Base++Ext);
+normalize_enumerated(S, #'Externalvaluereference'{value=Id},
+ NamedNumberList) ->
+ normalize_enumerated(S, Id, NamedNumberList);
+normalize_enumerated(S, Id, NamedNumberList) when is_atom(Id) ->
+ case lists:keymember(Id, 1, NamedNumberList) of
+ true ->
+ Id;
+ false ->
+ throw(asn1_error(S, S#state.value, {undefined,Id}))
end.
-
normalize_choice(S,{'CHOICE',{C,V}},CType,NameList) when is_atom(C) ->
case catch lists:keysearch(C,#'ComponentType'.name,CType) of
{value,#'ComponentType'{typespec=CT,name=Name}} ->
@@ -3535,10 +3286,6 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
merge_tags(Tag,?TAG_CONSTRUCTED(?N_SET))};
%% This is a temporary hack until the full Information Obj Spec
%% in X.681 is supported
- {{typereference,_,'TYPE-IDENTIFIER'},[{typefieldreference,_,'Type'}]} ->
- Ct=maybe_illicit_implicit_tag(open_type,Tag),
- TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct};
-
{#'Externaltypereference'{type='TYPE-IDENTIFIER'},
[{typefieldreference,_,'Type'}]} ->
Ct=maybe_illicit_implicit_tag(open_type,Tag),
@@ -3575,7 +3322,15 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
_ ->
MergedTag
end,
- TempNewDef#newt{type=NewTypeDef,tag=Ct};
+ case TopName of
+ [] when Type#typedef.name =/= undefined ->
+ %% This is a top-level type.
+ #type{def=Simplified} =
+ simplify_type(#type{def=NewTypeDef}),
+ TempNewDef#newt{type=Simplified,tag=Ct};
+ _ ->
+ TempNewDef#newt{type=NewTypeDef,tag=Ct}
+ end;
{'TypeFromObject',{object,Object},TypeField} ->
CheckedT = get_type_from_object(S,Object,TypeField),
@@ -3591,29 +3346,14 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
Other ->
exit({'cant check' ,Other})
end,
- Ts2 = case NewDef of
- #newt{type=unchanged} ->
- Ts#type{def=Def};
- #newt{type=TDef}->
- Ts#type{def=TDef}
- end,
- NewTag = case NewDef of
- #newt{tag=unchanged} ->
- Tag;
- #newt{tag=TT} ->
- TT
- end,
- T3 = Ts2#type{tag = lists:map(fun(TempTag = #tag{type={default,TTx}}) ->
- TempTag#tag{type=TTx};
- (Else) -> Else end, NewTag)},
- T4 = case NewDef of
- #newt{constraint=unchanged} ->
- T3#type{constraint=Constr};
- #newt{constraint=NewConstr} ->
- T3#type{constraint=NewConstr}
- end,
- T5 = T4#type{inlined=NewDef#newt.inlined},
- T5#type{constraint=check_constraints(S,T5#type.constraint)};
+ #newt{type=TDef,tag=NewTags,constraint=NewConstr,inlined=Inlined} = NewDef,
+ Ts#type{def=TDef,
+ inlined=Inlined,
+ constraint=check_constraints(S, NewConstr),
+ tag=lists:map(fun(#tag{type={default,TTx}}=TempTag) ->
+ TempTag#tag{type=TTx};
+ (Other) -> Other
+ end, NewTags)};
check_type(_S,Type,Ts) ->
exit({error,{asn1,internal_error,Type,Ts}}).
@@ -3625,6 +3365,28 @@ get_non_typedef(S, Tref0) ->
Type
end.
+
+%%
+%% Simplify the backends by getting rid of an #'ObjectClassFieldType'{}
+%% with a type known at compile time.
+%%
+
+simplify_comps(Comps) ->
+ [simplify_comp(Comp) || Comp <- Comps].
+
+simplify_comp(#'ComponentType'{typespec=Type0}=C) ->
+ Type = simplify_type(Type0),
+ C#'ComponentType'{typespec=Type};
+simplify_comp(Other) -> Other.
+
+simplify_type(#type{tag=Tag,def=Inner}=T) ->
+ case Inner of
+ #'ObjectClassFieldType'{type={fixedtypevaluefield,_,Type}} ->
+ Type#type{tag=Tag};
+ _ ->
+ T
+ end.
+
%% tablecinf_choose. A SEQUENCE or SET may be inserted in another
%% SEQUENCE or SET by the COMPONENTS OF directive. If this inserted
%% type is a referenced type that already has been checked it already
@@ -4003,26 +3765,10 @@ categorize(_S,type,Def) when is_record(Def,type) ->
categorize(_,_,Def) ->
[Def].
categorize(S,object_set,Def,ClassRef) ->
- %% XXXXXXXXXX
- case Def of
- {'Externaltypereference',undefined,'MSAccessProtocol','AllOperations'} ->
- ok;
- _ ->
- ok
- end,
NewObjSetSpec =
check_object(S,Def,#'ObjectSet'{class = ClassRef,
set = parse_objectset(Def)}),
Name = new_reference_name("object_set_argument"),
- %% XXXXXXXXXX
- case Name of
- internal_object_set_argument_78 ->
- ok;
- internal_object_set_argument_77 ->
- ok;
- _ ->
- ok
- end,
[save_object_set_instance(S,Name,NewObjSetSpec)];
categorize(_S,object,Def,_ClassRef) ->
%% should be handled
@@ -4048,9 +3794,7 @@ parse_objectset(Set) ->
%% check_constraints/2
%%
check_constraints(S,C) when is_list(C) ->
- check_constraints(S, C, []);
-check_constraints(S,C) when is_record(C,constraint) ->
- check_constraints(S, C#constraint.c, []).
+ check_constraints(S, C, []).
resolv_tuple_or_list(S,List) when is_list(List) ->
lists:map(fun(X)->resolv_value(S,X) end, List);
@@ -4077,23 +3821,19 @@ resolv_value1(S, ERef = #'Externalvaluereference'{value=Name}) ->
resolv_value1(S,VDef)
end
end;
-resolv_value1(S,{gt,V}) ->
- case V of
+resolv_value1(S, {gt,V}) ->
+ case resolv_value1(S, V) of
Int when is_integer(Int) ->
- V + 1;
- #valuedef{value=Int} ->
- 1 + resolv_value(S,Int);
+ Int + 1;
Other ->
- throw({error,{asn1,{undefined_type_or_value,Other}}})
+ throw({error,{asn1,{not_integer_value,Other}}})
end;
-resolv_value1(S,{lt,V}) ->
- case V of
+resolv_value1(S, {lt,V}) ->
+ case resolv_value1(S, V) of
Int when is_integer(Int) ->
- V - 1;
- #valuedef{value=Int} ->
- resolv_value(S,Int) - 1;
+ Int - 1;
Other ->
- throw({error,{asn1,{undefined_type_or_value,Other}}})
+ throw({error,{asn1,{not_integer_value,Other}}})
end;
resolv_value1(S,{'ValueFromObject',{object,Object},[{valuefieldreference,
FieldName}]}) ->
@@ -4356,7 +4096,42 @@ normalize_cs([{'ValueRange',{Sv,Sv}}|Cs]) ->
[{'SingleValue',Sv}|normalize_cs(Cs)];
normalize_cs([{'ValueRange',{'MIN','MAX'}}|Cs]) ->
normalize_cs(Cs);
-normalize_cs(Other) -> Other.
+normalize_cs([{'SizeConstraint',C0}|Cs]) ->
+ case normalize_size_constraint(C0) of
+ none ->
+ normalize_cs(Cs);
+ C ->
+ [{'SizeConstraint',C}|normalize_cs(Cs)]
+ end;
+normalize_cs([H|T]) ->
+ [H|normalize_cs(T)];
+normalize_cs([]) -> [].
+
+%% Normalize a size constraint to make it non-ambiguous and
+%% easy to interpret for the backends.
+%%
+%% Returns one of the following terms:
+%% {LowerBound,UpperBound}
+%% {{LowerBound,UpperBound},[]} % Extensible
+%% none % Remove size constraint from list
+%%
+%% where:
+%% LowerBound = integer()
+%% UpperBound = integer() | 'MAX'
+
+normalize_size_constraint(Sv) when is_integer(Sv) ->
+ {Sv,Sv};
+normalize_size_constraint({Root,Ext}) when is_list(Ext) ->
+ {normalize_size_constraint(Root),[]};
+normalize_size_constraint({{_,_},Ext}) when is_integer(Ext) ->
+ normalize_size_constraint(Ext);
+normalize_size_constraint([H|T]) ->
+ {H,lists:last(T)};
+normalize_size_constraint({0,'MAX'}) ->
+ none;
+normalize_size_constraint({Lb,Ub}=Range)
+ when is_integer(Lb), is_integer(Ub) orelse Ub =:= 'MAX' ->
+ Range.
is_range(Prev, [H|T]) when Prev =:= H - 1 -> is_range(H, T);
is_range(_, [_|_]) -> false;
@@ -4925,19 +4700,7 @@ get_referenced(S,Emod,Ename,Pos) ->
end;
T when is_record(T,typedef) ->
?dbg("get_referenced T: ~p~n",[T]),
- Spec = T#typedef.typespec, %% XXXX Spec may be something else than #type
- case Spec of
- #type{def=#typereference{}} ->
- Tref = Spec#type.def,
- Def = #'Externaltypereference'{module=Emod,
- type=Tref#typereference.val,
- pos=Tref#typereference.pos},
-
-
- {Emod,T#typedef{typespec=Spec#type{def=Def}}};
- _ ->
- {Emod,T} % should add check that T is exported here
- end;
+ {Emod,T}; % should add check that T is exported here
V ->
?dbg("get_referenced V: ~p~n",[V]),
{Emod,V}
@@ -5385,14 +5148,14 @@ iof_associated_type1(S,C) ->
prop=mandatory,
tags=[{'CONTEXT',0}]}],
#'SEQUENCE'{tablecinf=TableCInf,
- components=IOFComponents}.
+ components=simplify_comps(IOFComponents)}.
%% returns the leading attribute, the constraint of the components and
%% the tablecinf value for the second component.
instance_of_constraints(_,[]) ->
{false,[],[],[]};
-instance_of_constraints(S,#constraint{c={simpletable,Type}}) ->
+instance_of_constraints(S, [{simpletable,Type}]) ->
#type{def=#'Externaltypereference'{type=Name}} = Type,
ModuleName = S#state.mname,
ObjectSetRef=#'Externaltypereference'{module=ModuleName,
@@ -5403,7 +5166,8 @@ instance_of_constraints(S,#constraint{c={simpletable,Type}}) ->
[{innermost,
[#'Externalvaluereference'{module=ModuleName,
value=type}]}]}],
- TableCInf=#simpletableattributes{objectsetname=Name,
+ Mod = S#state.mname,
+ TableCInf=#simpletableattributes{objectsetname={Mod,Name},
c_name='type-id',
c_index=1,
usedclassfield=id,
@@ -5539,46 +5303,37 @@ check_sequence(S,Type,Comps) ->
%% the involved class removed, as the class of the object
%% set.
CompListWithTblInf = get_tableconstraint_info(S,Type,NewComps2),
- %% If encoding rule is in the PER family the Root Components
- %% after the second extension mark should be encoded before
- %% all extensions i.e together with the first Root components
NewComps3 = textual_order(CompListWithTblInf),
- CompListTuple =
- complist_as_tuple(is_erule_per(S#state.erule),NewComps3),
+ NewComps4 = simplify_comps(NewComps3),
+ CompListTuple = complist_as_tuple(NewComps4),
{CRelInf,CompListTuple};
Dupl ->
throw({error,{asn1,{duplicate_components,Dupl}}})
end.
-complist_as_tuple(Per,CompList) ->
- complist_as_tuple(Per,CompList,[],[],[],root).
+complist_as_tuple(CompList) ->
+ complist_as_tuple(CompList, [], [], [], root).
-complist_as_tuple(Per,[#'EXTENSIONMARK'{}|T],Acc,Ext,Acc2,root) ->
- complist_as_tuple(Per,T,Acc,Ext,Acc2,ext);
-complist_as_tuple(Per,[#'EXTENSIONMARK'{}|T],Acc,Ext,Acc2,ext) ->
- complist_as_tuple(Per,T,Acc,Ext,Acc2,root2);
-complist_as_tuple(_Per,[#'EXTENSIONMARK'{}|_T],_Acc,_Ext,_Acc2,root2) ->
+complist_as_tuple([#'EXTENSIONMARK'{}|T], Acc, Ext, Acc2, root) ->
+ complist_as_tuple(T, Acc, Ext, Acc2, ext);
+complist_as_tuple([#'EXTENSIONMARK'{}|T], Acc, Ext, Acc2, ext) ->
+ complist_as_tuple(T, Acc, Ext, Acc2, root2);
+complist_as_tuple([#'EXTENSIONMARK'{}|_T], _Acc, _Ext, _Acc2, root2) ->
throw({error,{asn1,{too_many_extension_marks}}});
-complist_as_tuple(Per,[C|T],Acc,Ext,Acc2,root) ->
- complist_as_tuple(Per,T,[C|Acc],Ext,Acc2,root);
-complist_as_tuple(Per,[C|T],Acc,Ext,Acc2,ext) ->
- complist_as_tuple(Per,T,Acc,[C|Ext],Acc2,ext);
-complist_as_tuple(Per,[C|T],Acc,Ext,Acc2,root2) ->
- complist_as_tuple(Per,T,Acc,Ext,[C|Acc2],root2);
-complist_as_tuple(_Per,[],Acc,_Ext,_Acc2,root) ->
+complist_as_tuple([C|T], Acc, Ext, Acc2, root) ->
+ complist_as_tuple(T, [C|Acc], Ext, Acc2, root);
+complist_as_tuple([C|T], Acc, Ext, Acc2, ext) ->
+ complist_as_tuple(T, Acc, [C|Ext], Acc2, ext);
+complist_as_tuple([C|T], Acc, Ext, Acc2, root2) ->
+ complist_as_tuple(T, Acc, Ext, [C|Acc2], root2);
+complist_as_tuple([], Acc, _Ext, _Acc2, root) ->
lists:reverse(Acc);
-complist_as_tuple(_Per,[],Acc,Ext,_Acc2,ext) ->
+complist_as_tuple([], Acc, Ext, _Acc2, ext) ->
{lists:reverse(Acc),lists:reverse(Ext)};
-%%complist_as_tuple(_Per = true,[],Acc,Ext,Acc2,root2) ->
-%% {lists:reverse(Acc)++lists:reverse(Acc2),lists:reverse(Ext)};
-complist_as_tuple(_Per,[],Acc,Ext,Acc2,root2) ->
+complist_as_tuple([], Acc, Ext, Acc2, root2) ->
{lists:reverse(Acc),lists:reverse(Ext),lists:reverse(Acc2)}.
-is_erule_per(per) -> true;
-is_erule_per(uper) -> true;
-is_erule_per(ber) -> false.
-
expand_components(S, [{'COMPONENTS OF',Type}|T]) ->
CompList = expand_components2(S,get_referenced_type(S,Type#type.def)),
expand_components(S,CompList) ++ expand_components(S,T);
@@ -5622,7 +5377,7 @@ take_only_rootset([H|T]) ->
[H|take_only_rootset(T)].
check_unique_sequence_tags(S,CompList) ->
- TagComps = case complist_as_tuple(false,CompList) of
+ TagComps = case complist_as_tuple(CompList) of
{R1,Ext,R2} ->
R1 ++ [C#'ComponentType'{prop='OPTIONAL'}||
C = #'ComponentType'{} <- Ext]++R2;
@@ -5657,7 +5412,7 @@ check_unique_sequence_tags1(S,[],Acc) ->
check_unique_tags(S,lists:reverse(Acc)).
check_sequenceof(S,Type,Component) when is_record(Component,type) ->
- check_type(S,Type,Component).
+ simplify_type(check_type(S, Type, Component)).
check_set(S,Type,Components) ->
{TableCInf,NewComponents} = check_sequence(S,Type,Components),
@@ -5879,7 +5634,7 @@ extension({Root1,ExtList,Root2}) ->
X = #'ComponentType'{prop=Y}<-ExtList], Root2}.
check_setof(S,Type,Component) when is_record(Component,type) ->
- check_type(S,Type,Component).
+ simplify_type(check_type(S, Type, Component)).
check_selectiontype(S,Name,#type{def=Eref})
when is_record(Eref,'Externaltypereference') ->
@@ -5943,8 +5698,9 @@ check_choice(S,Type,Components) when is_list(Components) ->
('ExtensionAdditionGroupEnd') -> false;
(_) -> true
end,NewComps),
- check_unique_tags(S,NewComps2),
- complist_as_tuple(is_erule_per(S#state.erule),NewComps2);
+ NewComps3 = simplify_comps(NewComps2),
+ check_unique_tags(S, NewComps3),
+ complist_as_tuple(NewComps3);
Dupl ->
throw({error,{asn1,{duplicate_choice_alternatives,Dupl}}})
end;
@@ -6322,7 +6078,7 @@ get_simple_table_info1(S,#'ComponentType'{typespec=TS},Cnames,Path) ->
simple_table_info(S,#'ObjectClassFieldType'{classname=ClRef,
class=ObjectClass,
fieldname=FieldName},Path) ->
-
+
ObjectClassFieldName =
case FieldName of
{LastFieldName,[]} -> LastFieldName;
@@ -6875,9 +6631,6 @@ get_OCFType(S,Fields,[PrimFieldName|Rest]) ->
get_taglist(S,Ext) when is_record(Ext,'Externaltypereference') ->
{_,T} = get_referenced_type(S,Ext),
get_taglist(S,T#typedef.typespec);
-get_taglist(S,Tref) when is_record(Tref,typereference) ->
- {_,T} = get_referenced_type(S,Tref),
- get_taglist(S,T#typedef.typespec);
get_taglist(S,Type) when is_record(Type,type) ->
case Type#type.tag of
[] ->
@@ -7047,60 +6800,27 @@ storeindb(S,M) when is_record(M,module) ->
NewM = M#module{typeorval=findtypes_and_values(TVlist)},
asn1_db:dbnew(NewM#module.name),
asn1_db:dbput(NewM#module.name,'MODULE', NewM),
- Res = storeindb(NewM#module.name,TVlist,[]),
+ Res = storeindb(#state{mname=NewM#module.name}, TVlist, []),
include_default_class(S,NewM#module.name),
include_default_type(NewM#module.name),
Res.
-storeindb(Module,[H|T],ErrAcc) when is_record(H,typedef) ->
- storeindb(Module,H#typedef.name,H,T,ErrAcc);
-storeindb(Module,[H|T],ErrAcc) when is_record(H,valuedef) ->
- storeindb(Module,H#valuedef.name,H,T,ErrAcc);
-storeindb(Module,[H|T],ErrAcc) when is_record(H,ptypedef) ->
- storeindb(Module,H#ptypedef.name,H,T,ErrAcc);
-storeindb(Module,[H|T],ErrAcc) when is_record(H,classdef) ->
- storeindb(Module,H#classdef.name,H,T,ErrAcc);
-storeindb(Module,[H|T],ErrAcc) when is_record(H,pvaluesetdef) ->
- storeindb(Module,H#pvaluesetdef.name,H,T,ErrAcc);
-storeindb(Module,[H|T],ErrAcc) when is_record(H,pobjectdef) ->
- storeindb(Module,H#pobjectdef.name,H,T,ErrAcc);
-storeindb(Module,[H|T],ErrAcc) when is_record(H,pvaluedef) ->
- storeindb(Module,H#pvaluedef.name,H,T,ErrAcc);
-storeindb(_,[],[]) -> ok;
-storeindb(_,[],ErrAcc) ->
- {error,ErrAcc}.
-
-storeindb(Module,Name,H,T,ErrAcc) ->
- case asn1_db:dbget(Module,Name) of
+storeindb(#state{mname=Module}=S, [H|T], Errors) ->
+ Name = asn1ct:get_name_of_def(H),
+ case asn1_db:dbget(Module, Name) of
undefined ->
- asn1_db:dbput(Module,Name,H),
- storeindb(Module,T,ErrAcc);
- _ ->
- case H of
- _Type when is_record(H,typedef) ->
- error({type,"already defined",
- #state{mname=Module,type=H,tname=Name}});
- _Type when is_record(H,valuedef) ->
- error({value,"already defined",
- #state{mname=Module,value=H,vname=Name}});
- _Type when is_record(H,ptypedef) ->
- error({ptype,"already defined",
- #state{mname=Module,type=H,tname=Name}});
- _Type when is_record(H,pobjectdef) ->
- error({ptype,"already defined",
- #state{mname=Module,type=H,tname=Name}});
- _Type when is_record(H,pvaluesetdef) ->
- error({ptype,"already defined",
- #state{mname=Module,type=H,tname=Name}});
- _Type when is_record(H,pvaluedef) ->
- error({ptype,"already defined",
- #state{mname=Module,type=H,tname=Name}});
- _Type when is_record(H,classdef) ->
- error({class,"already defined",
- #state{mname=Module,value=H,vname=Name}})
- end,
- storeindb(Module,T,[H|ErrAcc])
- end.
+ asn1_db:dbput(Module, Name, H),
+ storeindb(S, T, Errors);
+ Prev ->
+ PrevLine = asn1ct:get_pos_of_def(Prev),
+ {error,Error} = asn1_error(S, H, {already_defined,Name,PrevLine}),
+ storeindb(S, T, [Error|Errors])
+ end;
+storeindb(_, [], []) ->
+ ok;
+storeindb(_, [], [_|_]=Errors) ->
+ {error,Errors}.
+
findtypes_and_values(TVList) ->
findtypes_and_values(TVList,[],[],[],[],[],[]).%% Types,Values,
@@ -7140,8 +6860,20 @@ findtypes_and_values([],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) ->
{lists:reverse(Tacc),lists:reverse(Vacc),lists:reverse(Pacc),
lists:reverse(Cacc),lists:reverse(Oacc),lists:reverse(OSacc)}.
-
-
+asn1_error(#state{mname=Where}, Item, Error) ->
+ Pos = asn1ct:get_pos_of_def(Item),
+ {error,{structured_error,{Where,Pos},?MODULE,Error}}.
+
+format_error({already_defined,Name,PrevLine}) ->
+ io_lib:format("the name ~p has already been defined at line ~p",
+ [Name,PrevLine]);
+format_error({undefined,Name}) ->
+ io_lib:format("'~s' is referenced, but is not defined", [Name]);
+format_error(Other) ->
+ io_lib:format("~p", [Other]).
+
+error({_,{structured_error,_,_,_}=SE,_}) ->
+ SE;
error({export,Msg,#state{mname=Mname,type=Ref,tname=Typename}}) ->
Pos = Ref#'Externaltypereference'.pos,
io:format("asn1error:~p:~p:~p~n~p~n",[Pos,Mname,Typename,Msg]),
@@ -7444,3 +7176,13 @@ insert_once(S,Tab,Key) ->
_ ->
skipped
end.
+
+check_fold(S, [H|T], Check) ->
+ Type = asn1_db:dbget(S#state.mname, H),
+ case Check(S, H, Type) of
+ ok ->
+ check_fold(S, T, Check);
+ Error ->
+ [Error|check_fold(S, T, Check)]
+ end;
+check_fold(_, [], Check) when is_function(Check, 3) -> [].
diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl
index 341a04761b..761faa53c5 100644
--- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl
+++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl
@@ -114,30 +114,16 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) ->
usedclassfield=UniqueFieldName,
uniqueclassfield=UniqueFieldName,
valueindex=ValueIndex} -> %% N is index of attribute that determines constraint
- OSDef =
- case ObjectSetRef of
- {Module,OSName} ->
- asn1_db:dbget(Module,OSName);
- OSName ->
- asn1_db:dbget(get(currmod),OSName)
- end,
-% io:format("currmod: ~p~nOSName: ~p~nAttrN: ~p~nN: ~p~nUniqueFieldName: ~p~n",
-% [get(currmod),OSName,AttrN,N,UniqueFieldName]),
+ {ObjSetMod,ObjSetName} = ObjectSetRef,
+ OSDef = asn1_db:dbget(ObjSetMod, ObjSetName),
case (OSDef#typedef.typespec)#'ObjectSet'.gen of
true ->
ObjectEncode =
asn1ct_gen:un_hyphen_var(lists:concat(['Obj',
AttrN])),
- {ObjSetMod,ObjSetName} =
- case ObjectSetRef of
- {M,O} ->
- {{asis,M},O};
- _ ->
- {"?MODULE",ObjectSetRef}
- end,
- emit([ObjectEncode," = ",nl]),
- emit([" ",ObjSetMod,":'getenc_",ObjSetName,"'(",{asis,UniqueFieldName},
- ", ",nl]),
+ emit([ObjectEncode," = ",nl,
+ " ",{asis,ObjSetMod},":'getenc_",ObjSetName,
+ "'(",{asis,UniqueFieldName},", ",nl]),
ValueMatch = value_match(ValueIndex,
lists:concat(["Cindex",N])),
emit([indent(35),ValueMatch,"),",nl]),
@@ -183,7 +169,6 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) ->
gen_decode_sequence(Erules,Typename,D) when is_record(D,type) ->
asn1ct_name:start(),
- asn1ct_name:clear(),
asn1ct_name:new(tag),
#'SEQUENCE'{tablecinf=TableConsInfo,components=CList0} = D#type.def,
@@ -258,15 +243,9 @@ gen_decode_sequence(Erules,Typename,D) when is_record(D,type) ->
{[{ObjSetRef,LeadingAttr,Term}],PostponedDecArgs} ->
DecObj = asn1ct_gen:un_hyphen_var(lists:concat(['DecObj',LeadingAttr,Term])),
ValueMatch = value_match(ValueIndex,Term),
- {ObjSetMod,ObjSetName} =
- case ObjSetRef of
- {M,O} ->
- {{asis,M},O};
- _ ->
- {"?MODULE",ObjSetRef}
- end,
+ {ObjSetMod,ObjSetName} = ObjSetRef,
emit([DecObj," =",nl,
- " ",ObjSetMod,":'getdec_",ObjSetName,"'(",
+ " ",{asis,ObjSetMod},":'getdec_",ObjSetName,"'(",
{asis,UniqueFName},", ",ValueMatch,"),",nl]),
gen_dec_postponed_decs(DecObj,PostponedDecArgs)
end,
@@ -349,7 +328,6 @@ gen_encode_set(Erules,Typename,D) when is_record(D,type) ->
gen_decode_set(Erules,Typename,D) when is_record(D,type) ->
asn1ct_name:start(),
- asn1ct_name:clear(),
%% asn1ct_name:new(term),
asn1ct_name:new(tag),
#'SET'{tablecinf=TableConsInfo,components=TCompList0} = D#type.def,
@@ -444,15 +422,9 @@ gen_decode_set(Erules,Typename,D) when is_record(D,type) ->
{[{ObjSetRef,LeadingAttr,Term}],PostponedDecArgs} ->
DecObj = asn1ct_gen:un_hyphen_var(lists:concat(['DecObj',LeadingAttr,Term])),
ValueMatch = value_match(ValueIndex,Term),
- {ObjSetMod,ObjSetName} =
- case ObjSetRef of
- {M,O} ->
- {{asis,M},O};
- _ ->
- {"?MODULE",ObjSetRef}
- end,
+ {ObjSetMod,ObjSetName} = ObjSetRef,
emit([DecObj," =",nl,
- " ",ObjSetMod,":'getdec_",ObjSetName,"'(",
+ " ",{asis,ObjSetMod},":'getdec_",ObjSetName,"'(",
{asis,UniqueFName},", ",ValueMatch,"),",nl]),
gen_dec_postponed_decs(DecObj,PostponedDecArgs)
end,
@@ -504,7 +476,6 @@ gen_encode_sof(Erules,Typename,_InnerTypename,D) when is_record(D,type) ->
gen_decode_sof(Erules,TypeName,_InnerTypeName,D) when is_record(D,type) ->
asn1ct_name:start(),
- asn1ct_name:clear(),
{SeqOrSetOf, _TypeTag, Cont} =
case D#type.def of
{'SET OF',_Cont} -> {'SET OF','SET',_Cont};
@@ -1002,9 +973,7 @@ gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,Assign,EncObj)
{componentrelation,_,_}} ->
{_LeadingAttrName,Fun} = EncObj,
case RefedFieldName of
-%% {notype,T} ->
-%% throw({error,{notype,type_from_object,T}});
- {Name,RestFieldNames} when is_atom(Name), Name =/= notype ->
+ {Name,RestFieldNames} when is_atom(Name) ->
case OptOrMand of
mandatory -> ok;
_ ->
@@ -1035,17 +1004,8 @@ gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,Assign,EncObj)
_ ->
case WhatKind of
{primitive,bif} ->
- EncType =
- case Type#type.def of
- #'ObjectClassFieldType'{type={fixedtypevaluefield,_,Btype}} ->
- Btype;
- _ ->
- Type
- end,
- ?ASN1CT_GEN_BER:gen_encode_prim(ber,EncType,{asis,Tag},
- Element);
-%% {notype,_} ->
-%% emit(["'enc_",InnerType,"'(",Element,", ",{asis,Tag},")"]);
+ ?ASN1CT_GEN_BER:gen_encode_prim(ber, Type, {asis,Tag},
+ Element);
'ASN1_OPEN_TYPE' ->
case Type#type.def of
#'ObjectClassFieldType'{} -> %Open Type
@@ -1266,15 +1226,9 @@ gen_dec_call(InnerType,Erules,TopType,Cname,Type,BytesVar,Tag,PrimOptOrMand,
{Cname,{_,OSet,UniqueFName,ValIndex}} ->
Term = asn1ct_gen:mk_var(asn1ct_name:curr(term)),
ValueMatch = value_match(ValIndex,Term),
- {ObjSetMod,ObjSetName} =
- case OSet of
- {M,O} ->
- {{asis,M},O};
- _ ->
- {"?MODULE",OSet}
- end,
- emit([",",nl,"ObjFun = ",ObjSetMod,":'getdec_",ObjSetName,"'(",
- {asis,UniqueFName},", ",ValueMatch,")"]);
+ {ObjSetMod,ObjSetName} = OSet,
+ emit([",",nl,"ObjFun = ",{asis,ObjSetMod},":'getdec_",ObjSetName,
+ "'(",{asis,UniqueFName},", ",ValueMatch,")"]);
_ ->
ok
end,
@@ -1288,9 +1242,6 @@ gen_dec_call1({primitive,bif},InnerType,Erules,TopType,Cname,Type,BytesVar,
asn1ct:update_gen_state(namelist,Rest),
emit(["{'",asn1ct_gen:list2name([Cname|TopType]),"',",
BytesVar,"}"]);
- {_,{fixedtypevaluefield,_,Btype}} ->
- ?ASN1CT_GEN_BER:gen_dec_prim(Erules,Btype,BytesVar,Tag,[],
- ?PRIMITIVE,OptOrMand);
_ ->
?ASN1CT_GEN_BER:gen_dec_prim(Erules,Type,BytesVar,Tag,[],
?PRIMITIVE,OptOrMand)
@@ -1458,9 +1409,7 @@ print_attribute_comment(InnerType,Pos,Cname,Prop) ->
CommentLine = "%%-------------------------------------------------",
emit([nl,CommentLine]),
case InnerType of
- {typereference,_,Name} ->
- emit([nl,"%% attribute ",Cname,"(",Pos,") with type ",Name]);
- {'Externaltypereference',_,XModule,Name} ->
+ #'Externaltypereference'{module=XModule,type=Name} ->
emit([nl,"%% attribute ",Cname,"(",Pos,") External ",XModule,":",Name]);
_ ->
emit([nl,"%% attribute ",Cname,"(",Pos,") with type ",InnerType])
diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl
index aa5ee18c80..efb55cf015 100644
--- a/lib/asn1/src/asn1ct_constructed_per.erl
+++ b/lib/asn1/src/asn1ct_constructed_per.erl
@@ -143,40 +143,21 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) ->
uniqueclassfield=UniqueFieldName,
valueindex=ValueIndex
} -> %% N is index of attribute that determines constraint
- {{ObjSetMod,ObjSetName},OSDef} =
- case ObjectSet of
- {Module,OSName} ->
- {{{asis,Module},OSName},asn1_db:dbget(Module,OSName)};
- OSName ->
- {{"?MODULE",OSName},asn1_db:dbget(get(currmod),OSName)}
- end,
- case (OSDef#typedef.typespec)#'ObjectSet'.gen of
+ {Module,ObjSetName} = ObjectSet,
+ #typedef{typespec=#'ObjectSet'{gen=Gen}} =
+ asn1_db:dbget(Module, ObjSetName),
+ case Gen of
true ->
ObjectEncode =
asn1ct_gen:un_hyphen_var(lists:concat(['Obj',AttrN])),
- emit([ObjectEncode," = ",nl]),
- emit([" ",ObjSetMod,":'getenc_",ObjSetName,"'(",
- {asis,UniqueFieldName},", ",nl]),
- El = make_element(N+1,asn1ct_gen:mk_var(asn1ct_name:curr(val))),
-
- Length = fun(X,_LFun) when is_atom(X) ->
- length(atom_to_list(X));
- (X,_LFun) when is_list(X) ->
- length(X);
- ({X1,X2},LFun) ->
- LFun(X1,LFun) + LFun(X2,LFun)
- end,
- Indent = 12 + Length(ObjectSet,Length),
- case ValueIndex of
- [] ->
- emit([indent(Indent),El,"),",nl]);
- _ ->
- emit([indent(Indent),"value_match(",
- {asis,ValueIndex},",",El,")),",nl]),
- notice_value_match()
- end,
+ El = make_element(N+1, asn1ct_gen:mk_var(asn1ct_name:curr(val))),
+ ValueMatch = value_match(ValueIndex, El),
+ emit([ObjectEncode," =",nl,
+ " ",{asis,Module},":'getenc_",ObjSetName,"'(",
+ {asis,UniqueFieldName},", ",nl,
+ " ",ValueMatch,"),",nl]),
{AttrN,ObjectEncode};
- _ ->
+ false ->
false
end;
_ ->
@@ -227,7 +208,6 @@ gen_decode_constructed(Erule, Typename, #type{}=D) ->
Imm0 = gen_dec_constructed_imm(Erule, Typename, #type{}=D),
Imm = opt_imm(Imm0),
asn1ct_name:start(),
- asn1ct_name:clear(),
emit_gen_dec_imm(Imm),
emit([".",nl,nl]).
@@ -365,14 +345,10 @@ gen_dec_constructed_imm_2(Typename, CompList,
{[{ObjSet,LeadingAttr,Term}],ListOfOpenTypes} ->
DecObj = asn1ct_gen:un_hyphen_var(lists:concat(['DecObj',LeadingAttr,Term])),
ValueMatch = value_match(ValueIndex,Term),
- {ObjSetMod,ObjSetName} =
- case ObjSet of
- {M,O} -> {{asis,M},O};
- _ -> {"?MODULE",ObjSet}
- end,
- emit({DecObj," =",nl," ",ObjSetMod,":'getdec_",ObjSetName,"'(",
-% {asis,UniqueFName},", ",Term,"),",nl}),
- {asis,UniqueFName},", ",ValueMatch,"),",nl}),
+ {ObjSetMod,ObjSetName} = ObjSet,
+ emit([DecObj," =",nl,
+ " ",{asis,ObjSetMod},":'getdec_",ObjSetName,"'(",
+ {asis,UniqueFName},", ",ValueMatch,"),",nl]),
gen_dec_listofopentypes(DecObj,ListOfOpenTypes,false)
end,
%% we don't return named lists any more Cnames = mkcnamelist(CompList),
@@ -489,7 +465,6 @@ gen_encode_choice(Erule,Typename,D) when is_record(D,type) ->
gen_decode_choice(Erules,Typename,D) when is_record(D,type) ->
asn1ct_name:start(),
- asn1ct_name:clear(),
asn1ct_name:new(bytes),
{'CHOICE',CompList} = D#type.def,
Ext = extensible_enc(CompList),
@@ -504,12 +479,8 @@ gen_encode_sof(Erule,Typename,SeqOrSetOf,D) when is_record(D,type) ->
asn1ct_name:start(),
{_SeqOrSetOf,ComponentType} = D#type.def,
emit({"[",nl}),
- SizeConstraint =
- case asn1ct_gen:get_constraint(D#type.constraint,
- 'SizeConstraint') of
- no -> undefined;
- Range -> Range
- end,
+ SizeConstraint = asn1ct_imm:effective_constraint(bitstring,
+ D#type.constraint),
ObjFun =
case D#type.tablecinf of
[{objfun,_}|_R] ->
@@ -521,13 +492,7 @@ gen_encode_sof(Erule,Typename,SeqOrSetOf,D) when is_record(D,type) ->
emit({indent(3),"'enc_",asn1ct_gen:list2name(Typename),
"_components'(Val",ObjFun,", [])"}),
emit({nl,"].",nl}),
- NewComponentType =
- case ComponentType#type.def of
- {'ENUMERATED',_,Component}->
- ComponentType#type{def={'ENUMERATED',Component}};
- _ -> ComponentType
- end,
- gen_encode_sof_components(Erule,Typename,SeqOrSetOf,NewComponentType).
+ gen_encode_sof_components(Erule, Typename, SeqOrSetOf, ComponentType).
%% Logic copied from asn1_per_bin_rt2ct:encode_constrained_number
@@ -565,7 +530,7 @@ gen_encode_length(per, {Lb,Ub}) when Ub =< 65535, Lb >= 0 ->
gen_encode_length(Erules, SizeConstraint) ->
emit([nl,indent(3),
case SizeConstraint of
- undefined ->
+ no ->
{call,Erules,encode_length,["length(Val)"]};
_ ->
{call,Erules,encode_length,
@@ -576,12 +541,8 @@ gen_encode_length(Erules, SizeConstraint) ->
gen_decode_sof(Erules,Typename,SeqOrSetOf,D) when is_record(D,type) ->
asn1ct_name:start(),
{_SeqOrSetOf,ComponentType} = D#type.def,
- SizeConstraint =
- case asn1ct_gen:get_constraint(D#type.constraint,
- 'SizeConstraint') of
- no -> undefined;
- Range -> Range
- end,
+ SizeConstraint = asn1ct_imm:effective_constraint(bitstring,
+ D#type.constraint),
ObjFun =
case D#type.tablecinf of
[{objfun,_}|_R] ->
@@ -593,13 +554,7 @@ gen_decode_sof(Erules,Typename,SeqOrSetOf,D) when is_record(D,type) ->
emit([",",nl,
"'dec_",asn1ct_gen:list2name(Typename),
"_components'(",Num,", ",Buf,ObjFun,", []).",nl,nl]),
- NewComponentType =
- case ComponentType#type.def of
- {'ENUMERATED',_,Component}->
- ComponentType#type{def={'ENUMERATED',Component}};
- _ -> ComponentType
- end,
- gen_decode_sof_components(Erules,Typename,SeqOrSetOf,NewComponentType).
+ gen_decode_sof_components(Erules, Typename, SeqOrSetOf, ComponentType).
is_aligned(per) -> true;
is_aligned(uper) -> false.
@@ -629,10 +584,9 @@ gen_encode_sof_components(Erule,Typename,SeqOrSetOf,Cont) ->
Conttype = asn1ct_gen:get_inner(Cont#type.def),
Currmod = get(currmod),
- Ctgenmod = asn1ct_gen:ct_gen_module(Erule),
case asn1ct_gen:type(Conttype) of
{primitive,bif} ->
- gen_encode_prim_wrapper(Ctgenmod,Erule,Cont,false,"H");
+ asn1ct_gen_per:gen_encode_prim(Erule, Cont, "H");
{constructed,bif} ->
NewTypename = [Constructed_Suffix|Typename],
emit({"'enc_",asn1ct_gen:list2name(NewTypename),"'(H",
@@ -642,9 +596,9 @@ gen_encode_sof_components(Erule,Typename,SeqOrSetOf,Cont) ->
#'Externaltypereference'{module=EMod,type=EType} ->
emit({"'",EMod,"':'enc_",EType,"'(H)",nl,nl});
'ASN1_OPEN_TYPE' ->
- gen_encode_prim_wrapper(Ctgenmod,Erule,
- #type{def='ASN1_OPEN_TYPE'},
- false,"H");
+ asn1ct_gen_per:gen_encode_prim(Erule,
+ #type{def='ASN1_OPEN_TYPE'},
+ "H");
_ ->
emit({"'enc_",Conttype,"'(H)",nl,nl})
end,
@@ -668,7 +622,6 @@ gen_decode_sof_components(Erule,Typename,SeqOrSetOf,Cont) ->
Cont#type.def),
Conttype = asn1ct_gen:get_inner(Cont#type.def),
Ctgenmod = asn1ct_gen:ct_gen_module(Erule),
- CurrMod = get(currmod),
case asn1ct_gen:type(Conttype) of
{primitive,bif} ->
Ctgenmod:gen_dec_prim(Erule,Cont,"Bytes"),
@@ -677,12 +630,9 @@ gen_decode_sof_components(Erule,Typename,SeqOrSetOf,Cont) ->
NewTypename = [Constructed_Suffix|Typename],
emit({"'dec_",asn1ct_gen:list2name(NewTypename),
"'(Bytes, telltype",ObjFun,"),",nl});
- #typereference{val=Dname} ->
- emit({"'dec_",Dname,"'(Bytes,telltype),",nl});
- #'Externaltypereference'{module=CurrMod,type=EType} ->
- emit({"'dec_",EType,"'(Bytes,telltype),",nl});
- #'Externaltypereference'{module=EMod,type=EType} ->
- emit({"'",EMod,"':'dec_",EType,"'(Bytes,telltype),",nl});
+ #'Externaltypereference'{}=Etype ->
+ asn1ct_gen_per:gen_dec_external(Etype, "Bytes"),
+ emit([com,nl]);
'ASN1_OPEN_TYPE' ->
Ctgenmod:gen_dec_prim(Erule,#type{def='ASN1_OPEN_TYPE'},
"Bytes"),
@@ -1004,7 +954,6 @@ gen_enc_line(Erule,TopType, Cname, Type, [], Pos,DynamicEnc,Ext) ->
Element = make_element(Pos+1,asn1ct_gen:mk_var(asn1ct_name:curr(val))),
gen_enc_line(Erule,TopType,Cname,Type,Element, Pos,DynamicEnc,Ext);
gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) ->
- Ctgenmod = asn1ct_gen:ct_gen_module(Erule),
Atype =
case Type of
#type{def=#'ObjectClassFieldType'{type=InnerType}} ->
@@ -1026,8 +975,6 @@ gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) ->
case DynamicEnc of
{_LeadingAttrName,Fun} ->
case (Type#type.def)#'ObjectClassFieldType'.fieldname of
- {notype,T} ->
- throw({error,{notype,type_from_object,T}});
{Name,RestFieldNames} when is_atom(Name) ->
asn1ct_func:need({Erule,complete,1}),
asn1ct_func:need({Erule,encode_open_type,1}),
@@ -1057,29 +1004,17 @@ gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) ->
#'Externaltypereference'{module=Mod,type=EType} ->
emit({"'",Mod,"':'enc_",
EType,"'(",Element,")"});
- #typereference{val=Ename} ->
- emit({"'enc_",Ename,"'(",Element,")"});
- {notype,_} ->
- emit({"'enc_",Atype,"'(",Element,")"});
{primitive,bif} ->
- EncType =
- case Atype of
- {fixedtypevaluefield,_,Btype} ->
- Btype;
- _ ->
- Type
- end,
- gen_encode_prim_wrapper(Ctgenmod,Erule,EncType,
- false,Element);
+ asn1ct_gen_per:gen_encode_prim(Erule, Type, Element);
'ASN1_OPEN_TYPE' ->
case Type#type.def of
#'ObjectClassFieldType'{type=OpenType} ->
- gen_encode_prim_wrapper(Ctgenmod,Erule,
- #type{def=OpenType},
- false,Element);
+ asn1ct_gen_per:gen_encode_prim(Erule,
+ #type{def=OpenType},
+ Element);
_ ->
- gen_encode_prim_wrapper(Ctgenmod,Erule,Type,
- false,Element)
+ asn1ct_gen_per:gen_encode_prim(Erule, Type,
+ Element)
end;
{constructed,bif} ->
NewTypename = [Cname|TopType],
@@ -1235,68 +1170,67 @@ gen_dec_comp_call(Comp, Erule, TopType, Tpos, OptTable, DecInfObj,
end
end
end,
-
- OptOrDef =
- case {Ext,Prop} of
- {noext,mandatory} ->
- ignore;
- {noext,_} -> %% OPTIONAL or DEFAULT
- OptPos = get_optionality_pos(TextPos, OptTable),
- Element = io_lib:format("Opt band (1 bsl ~w)",
- [NumberOfOptionals - OptPos]),
- fun(St) ->
- emit(["case ",Element," of",nl]),
- emit([" _Opt",TextPos," when _Opt",TextPos," > 0 ->"]),
- St
- end;
- {{ext,_,_},_} -> %Extension
- fun(St) ->
- emit(["case Extensions of",nl,
- " <<_:",Pos-1,",1:1,_/bitstring>> ->",nl]),
- St
- end
- end,
- Lines = gen_dec_line_imm(Erule, TopType, Comp, Tpos, DecInfObj, Ext),
- Postamble =
- case {Ext,Prop} of
- {noext,mandatory} ->
- ignore;
- {noext,_} ->
- fun(St) ->
- emit([";",nl,"0 ->"]),
- emit(["{"]),
- gen_dec_component_no_val(Ext,Prop),
- emit({",",{curr,bytes},"}",nl}),
- emit([nl,"end"]),
- St
- end;
- _ ->
- fun(St) ->
- emit([";",nl,"_ ->",nl]),
- emit(["{"]),
- case Type of
- #type{def=#'SEQUENCE'{
- extaddgroup=Number2,
- components=ExtGroupCompList2}}
- when is_integer(Number2)->
- emit({"{extAddGroup,"}),
- gen_dec_extaddGroup_no_val(Ext,ExtGroupCompList2),
- emit({"}"});
- _ ->
- gen_dec_component_no_val(Ext, Prop)
- end,
- emit({",",{curr,bytes},"}",nl}),
- emit([nl,"end"]),
- St
- end
- end,
+ {Pre,Post} = comp_call_pre_post(Ext, Prop, Pos, Type, TextPos,
+ OptTable, NumberOfOptionals, Ext),
+ Lines = gen_dec_seq_line_imm(Erule, TopType, Comp, Tpos, DecInfObj, Ext),
AdvBuffer = {ignore,fun(St) ->
asn1ct_name:new(bytes),
St
end},
- [{group,[{safe,Comment},{safe,Preamble},
- OptOrDef|Lines]++
- [Postamble,{safe,AdvBuffer}]}].
+ [{group,[{safe,Comment},{safe,Preamble}] ++ Pre ++
+ Lines ++ Post ++ [{safe,AdvBuffer}]}].
+
+comp_call_pre_post(noext, mandatory, _, _, _, _, _, _) ->
+ {[],[]};
+comp_call_pre_post(noext, Prop, _, _, TextPos, OptTable, NumOptionals, Ext) ->
+ %% OPTIONAL or DEFAULT
+ OptPos = get_optionality_pos(TextPos, OptTable),
+ Element = case NumOptionals - OptPos of
+ 0 ->
+ "Opt band 1";
+ Shift ->
+ lists:concat(["(Opt bsr ",Shift,") band 1"])
+ end,
+ {[fun(St) ->
+ emit(["case ",Element," of",nl,
+ "1 ->",nl]),
+ St
+ end],
+ [fun(St) ->
+ emit([";",nl,
+ "0 ->",nl,
+ "{"]),
+ gen_dec_component_no_val(Ext, Prop),
+ emit([",",{curr,bytes},"}",nl,
+ "end"]),
+ St
+ end]};
+comp_call_pre_post({ext,_,_}, Prop, Pos, Type, _, _, _, Ext) ->
+ %% Extension
+ {[fun(St) ->
+ emit(["case Extensions of",nl,
+ " <<_:",Pos-1,",1:1,_/bitstring>> ->",nl]),
+ St
+ end],
+ [fun(St) ->
+ emit([";",nl,
+ "_ ->",nl,
+ "{"]),
+ case Type of
+ #type{def=#'SEQUENCE'{
+ extaddgroup=Number2,
+ components=ExtGroupCompList2}}
+ when is_integer(Number2)->
+ emit("{extAddGroup,"),
+ gen_dec_extaddGroup_no_val(Ext, ExtGroupCompList2),
+ emit("}");
+ _ ->
+ gen_dec_component_no_val(Ext, Prop)
+ end,
+ emit([",",{curr,bytes},"}",nl,
+ "end"]),
+ St
+ end]}.
is_mandatory_predef_tab_c(noext, mandatory,
{"got objfun through args","ObjFun"}) ->
@@ -1324,13 +1258,17 @@ gen_dec_component_no_val({ext,_,_},mandatory) ->
emit({"asn1_NOVALUE"}).
-gen_dec_line(Erule, TopType, Comp, Pos, DecInfObj, Ext) ->
- Imm0 = gen_dec_line_imm(Erule, TopType, Comp, Pos, DecInfObj, Ext),
+gen_dec_choice_line(Erule, TopType, Comp, Pre) ->
+ Imm0 = gen_dec_line_imm(Erule, TopType, Comp, false, Pre),
Init = {ignore,fun(_) -> {[],[]} end},
Imm = [{group,[Init|Imm0]}],
emit_gen_dec_imm(Imm).
-gen_dec_line_imm(Erule, TopType, Comp, Pos, DecInfObj, Ext) ->
+gen_dec_seq_line_imm(Erule, TopType, Comp, Pos, DecInfObj, Ext) ->
+ Pre = gen_dec_line_open_type(Erule, Ext, Pos),
+ gen_dec_line_imm(Erule, TopType, Comp, DecInfObj, Pre).
+
+gen_dec_line_imm(Erule, TopType, Comp, DecInfObj, Pre) ->
#'ComponentType'{name=Cname,typespec=Type} = Comp,
Atype =
case Type of
@@ -1339,9 +1277,7 @@ gen_dec_line_imm(Erule, TopType, Comp, Pos, DecInfObj, Ext) ->
_ ->
asn1ct_gen:get_inner(Type#type.def)
end,
-
- Pre = gen_dec_line_open_type(Erule, Ext, Pos),
- Decode = gen_dec_line_special(Erule, Atype, TopType, Comp, DecInfObj, Ext),
+ Decode = gen_dec_line_special(Erule, Atype, TopType, Comp, DecInfObj),
Post =
fun({SaveBytes,Finish}) ->
{AccTerm,AccBytes} = Finish(),
@@ -1385,7 +1321,7 @@ gen_dec_line_open_type(_, _, _) ->
end}.
gen_dec_line_special(Erule, {typefield,_}, _TopType, Comp,
- DecInfObj, Ext) ->
+ DecInfObj) ->
#'ComponentType'{name=Cname,typespec=Type,prop=Prop} = Comp,
fun({_BytesVar,PrevSt}) ->
case DecInfObj of
@@ -1417,7 +1353,7 @@ gen_dec_line_special(Erule, {typefield,_}, _TopType, Comp,
%% objfun though arguments on function
%% invocation.
if
- Ext == noext andalso Prop == mandatory ->
+ Prop =:= mandatory ->
ok;
true ->
asn1ct_name:new(tmpterm),
@@ -1431,7 +1367,7 @@ gen_dec_line_special(Erule, {typefield,_}, _TopType, Comp,
asn1ct_imm:dec_code_gen(Imm, BytesVar),
emit([com,nl]),
if
- Ext == noext andalso Prop == mandatory ->
+ Prop =:= mandatory ->
emit([{curr,term}," =",nl," "]);
true ->
emit([" {"])
@@ -1448,7 +1384,7 @@ gen_dec_line_special(Erule, {typefield,_}, _TopType, Comp,
emit([indent(6),{curr,tmpterm},nl]),
emit([indent(2),"end"]),
if
- Ext == noext andalso Prop == mandatory ->
+ Prop =:= mandatory ->
ok;
true ->
emit([",",nl,{curr,tmpbytes},"}"])
@@ -1468,7 +1404,7 @@ gen_dec_line_special(Erule, {typefield,_}, _TopType, Comp,
end
end;
gen_dec_line_special(Erule, {objectfield,PrimFieldName1,PFNList}, _TopType,
- Comp, _DecInfObj, _Ext) ->
+ Comp, _DecInfObj) ->
fun({_BytesVar,PrevSt}) ->
Imm = asn1ct_imm:per_dec_open_type(is_aligned(Erule)),
BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)),
@@ -1480,7 +1416,7 @@ gen_dec_line_special(Erule, {objectfield,PrimFieldName1,PFNList}, _TopType,
Prop}],
{SaveBytes,PrevSt}
end;
-gen_dec_line_special(Erule, Atype, TopType, Comp, DecInfObj, _Ext) ->
+gen_dec_line_special(Erule, Atype, TopType, Comp, DecInfObj) ->
case gen_dec_line_other(Erule, Atype, TopType, Comp) of
Fun when is_function(Fun, 1) ->
fun({BytesVar,PrevSt}) ->
@@ -1503,38 +1439,24 @@ gen_dec_line_dec_inf(Comp, DecInfObj) ->
{Cname,{_,OSet,UniqueFName,ValIndex}} ->
Term = asn1ct_gen:mk_var(asn1ct_name:curr(term)),
ValueMatch = value_match(ValIndex,Term),
- {ObjSetMod,ObjSetName} =
- case OSet of
- {M,O} -> {{asis,M},O};
- _ -> {"?MODULE",OSet}
- end,
- emit({",",nl,"ObjFun = ",ObjSetMod,
+ {ObjSetMod,ObjSetName} = OSet,
+ emit([",",nl,
+ "ObjFun = ",{asis,ObjSetMod},
":'getdec_",ObjSetName,"'(",
- {asis,UniqueFName},", ",ValueMatch,")"});
+ {asis,UniqueFName},", ",ValueMatch,")"]);
_ ->
ok
end.
gen_dec_line_other(Erule, Atype, TopType, Comp) ->
#'ComponentType'{name=Cname,typespec=Type} = Comp,
- CurrMod = get(currmod),
case asn1ct_gen:type(Atype) of
- #'Externaltypereference'{module=CurrMod,type=EType} ->
+ #'Externaltypereference'{}=Etype ->
fun(BytesVar) ->
- emit({"'dec_",EType,"'(",BytesVar,",telltype)"})
- end;
- #'Externaltypereference'{module=Mod,type=EType} ->
- fun(BytesVar) ->
- emit({"'",Mod,"':'dec_",EType,"'(",BytesVar,
- ",telltype)"})
+ asn1ct_gen_per:gen_dec_external(Etype, BytesVar)
end;
{primitive,bif} ->
- case Atype of
- {fixedtypevaluefield,_,Btype} ->
- asn1ct_gen_per:gen_dec_imm(Erule, Btype);
- _ ->
- asn1ct_gen_per:gen_dec_imm(Erule, Type)
- end;
+ asn1ct_gen_per:gen_dec_imm(Erule, Type);
'ASN1_OPEN_TYPE' ->
case Type#type.def of
#'ObjectClassFieldType'{type=OpenType} ->
@@ -1542,14 +1464,6 @@ gen_dec_line_other(Erule, Atype, TopType, Comp) ->
_ ->
asn1ct_gen_per:gen_dec_imm(Erule, Type)
end;
- #typereference{val=Dname} ->
- fun(BytesVar) ->
- emit({"'dec_",Dname,"'(",BytesVar,",telltype)"})
- end;
- {notype,_} ->
- fun(BytesVar) ->
- emit({"'dec_",Atype,"'(",BytesVar,",telltype)"})
- end;
{constructed,bif} ->
NewTypename = [Cname|TopType],
case Type#type.tablecinf of
@@ -1605,16 +1519,14 @@ get_name_list([], Acc) ->
gen_enc_choice2(Erule,TopType, {L1,L2}, Ext) ->
- gen_enc_choice2(Erule,TopType, L1 ++ L2, 0, Ext);
-gen_enc_choice2(Erule,TopType, {L1,L2,L3}, Ext) ->
- gen_enc_choice2(Erule,TopType, L1 ++ L3 ++ L2, 0, Ext);
+ gen_enc_choice2(Erule, TopType, L1 ++ L2, 0, [], Ext);
+gen_enc_choice2(Erule, TopType, {L1,L2,L3}, Ext) ->
+ gen_enc_choice2(Erule, TopType, L1 ++ L3 ++ L2, 0, [], Ext);
gen_enc_choice2(Erule,TopType, L, Ext) ->
- gen_enc_choice2(Erule,TopType, L, 0, Ext).
+ gen_enc_choice2(Erule,TopType, L, 0, [], Ext).
-gen_enc_choice2(Erule,TopType,[H1,H2|T], Pos, Ext)
-when is_record(H1,'ComponentType'), is_record(H2,'ComponentType') ->
- Cname = H1#'ComponentType'.name,
- Type = H1#'ComponentType'.typespec,
+gen_enc_choice2(Erule, TopType, [H|T], Pos, Sep0, Ext) ->
+ #'ComponentType'{name=Cname,typespec=Type} = H,
EncObj =
case asn1ct_gen:get_constraint(Type#type.constraint,
componentrelation) of
@@ -1622,130 +1534,157 @@ when is_record(H1,'ComponentType'), is_record(H2,'ComponentType') ->
case Type#type.tablecinf of
[{objfun,_}|_] ->
{"got objfun through args","ObjFun"};
- _ ->false
- end;
- _ -> {no_attr,"ObjFun"}
- end,
- emit({{asis,Cname}," ->",nl}),
- DoExt = case Ext of
- {ext,ExtPos,_} when (Pos + 1) < ExtPos -> noext;
- _ -> Ext
- end,
- gen_enc_line(Erule,TopType,Cname,Type,"element(2,Val)",
- Pos+1,EncObj,DoExt),
- emit({";",nl}),
- gen_enc_choice2(Erule,TopType,[H2|T], Pos+1, Ext);
-gen_enc_choice2(Erule,TopType,[H1|T], Pos, Ext)
- when is_record(H1,'ComponentType') ->
- Cname = H1#'ComponentType'.name,
- Type = H1#'ComponentType'.typespec,
- EncObj =
- case asn1ct_gen:get_constraint(Type#type.constraint,
- componentrelation) of
- no ->
- case Type#type.tablecinf of
- [{objfun,_}|_] ->
- {"got objfun through args","ObjFun"};
- _ ->false
+ _ ->
+ false
end;
- _ -> {no_attr,"ObjFun"}
+ _ ->
+ {no_attr,"ObjFun"}
end,
- emit({{asis,H1#'ComponentType'.name}," ->",nl}),
+ emit([Sep0,{asis,Cname}," ->",nl]),
DoExt = case Ext of
- {ext,ExtPos,_} when (Pos + 1) < ExtPos -> noext;
+ {ext,ExtPos,_} when Pos + 1 < ExtPos -> noext;
_ -> Ext
end,
- gen_enc_line(Erule,TopType,Cname,Type,"element(2,Val)",
- Pos+1,EncObj,DoExt),
- gen_enc_choice2(Erule,TopType,T, Pos+1, Ext);
-gen_enc_choice2(_Erule,_,[], _, _) ->
- true.
+ gen_enc_line(Erule, TopType, Cname, Type, "element(2, Val)",
+ Pos+1, EncObj, DoExt),
+ Sep = [";",nl],
+ gen_enc_choice2(Erule, TopType, T, Pos+1, Sep, Ext);
+gen_enc_choice2(_, _, [], _, _, _) -> ok.
+
+%% Generate the code for CHOICE. If the CHOICE is extensible,
+%% the structure of the generated code is as follows:
+%%
+%% case Bytes of
+%% <<0:1,Bytes1/bitstring>> ->
+%% Choice = <Decode INTEGER (0..LastRootChoice) from Bytes1>
+%% case Choice of
+%% 0 -> <Decode>;
+%% :
+%% LastRootChoice -> <Decode>
+%% end;
+%% <<1:1,Bytes1/bitstring>> ->
+%% Choice = <Decode normally small number from Bytes1>
+%% TmpVal = <Decode open type>
+%% case Choice of
+%% 0 -> <Decode TmpVal>;
+%% :
+%% LastExtension -> <Decode TmpVal>;
+%% _ -> <Return TmpVal since the type is unknown>
+%% end
+%% end
+%%
+%% The return value from the generated function always looks like:
+%% {{ChoiceTag,Value},RemainingBuffer}
+%% where ChoiceTag will be 'asn1_ExtAlt' for an unknown extension.
+%%
+%% If the CHOICE is not extensible, the top-level case is omitted
+%% and only the code in the first case arm is generated.
-gen_dec_choice(Erule,TopType,CompList,{ext,Pos,NumExt}) ->
- emit(["{Ext,",{curr,bytes},"} = ",
- {call,Erule,getbit,["Bytes"]},com,nl]),
+gen_dec_choice(Erule, TopType, CompList, {ext,_,_}=Ext) ->
+ {RootList,ExtList} = split_complist(CompList),
+ emit(["case Bytes of",nl]),
+ case RootList of
+ [] ->
+ ok;
+ [_|_] ->
+ emit(["<<0:1,Bytes1/bitstring>> ->",nl]),
+ asn1ct_name:new(bytes),
+ gen_dec_choice1(Erule, TopType, RootList, noext),
+ emit([";",nl,nl])
+ end,
+ emit(["<<1:1,Bytes1/bitstring>> ->",nl]),
+ asn1ct_name:clear(),
+ asn1ct_name:new(bytes),
asn1ct_name:new(bytes),
- gen_dec_choice1(Erule,TopType,CompList,{ext,Pos,NumExt});
-gen_dec_choice(Erule,TopType,CompList,noext) ->
- gen_dec_choice1(Erule,TopType,CompList,noext).
-
-gen_dec_choice1(Erule,TopType,CompList,noext) ->
- emit(["{Choice,",{curr,bytes},
- "} = ",{call,Erule,getchoice,
- [{prev,bytes},length(CompList),"0"]},com,nl,
- "{Cname,{Val,NewBytes}} = case Choice of",nl]),
- gen_dec_choice2(Erule,TopType,CompList,noext),
- emit({nl,"end,",nl}),
- emit({nl,"{{Cname,Val},NewBytes}"});
-gen_dec_choice1(Erule,TopType,{RootList,ExtList},Ext) ->
- NewList = RootList ++ ExtList,
- gen_dec_choice1(Erule,TopType, NewList, Ext);
-gen_dec_choice1(Erule,TopType,{RootList,ExtList,RootList2},Ext) ->
- NewList = RootList ++ RootList2 ++ ExtList,
- gen_dec_choice1(Erule,TopType, NewList, Ext);
-gen_dec_choice1(Erule,TopType,CompList,{ext,ExtPos,ExtNum}) ->
- emit(["{Choice,",{curr,bytes},"} = ",
- {call,Erule,getchoice,
- [{prev,bytes},length(CompList)-ExtNum,"Ext"]},com,nl]),
- emit({"{Cname,{Val,NewBytes}} = case Choice + Ext*",ExtPos-1," of",nl}),
- gen_dec_choice2(Erule,TopType,CompList,{ext,ExtPos,ExtNum}),
+ gen_dec_choice1(Erule, TopType, ExtList, Ext),
+ emit([nl,"end"]);
+gen_dec_choice(Erule, TopType, CompList, noext) ->
+ gen_dec_choice1(Erule, TopType, CompList, noext).
+
+split_complist({Root1,Ext,Root2}) ->
+ {Root1++Root2,Ext};
+split_complist({_,_}=CompList) ->
+ CompList.
+
+gen_dec_choice1(Erule, TopType, CompList, noext=Ext) ->
+ emit_getchoice(Erule, CompList, Ext),
+ emit(["case Choice of",nl]),
+ Pre = {safe,fun(St) ->
+ {asn1ct_gen:mk_var(asn1ct_name:curr(bytes)),
+ fun() -> St end}
+ end},
+ gen_dec_choice2(Erule, TopType, CompList, Pre),
+ emit([nl,"end"]);
+gen_dec_choice1(Erule, TopType, CompList, {ext,_,_}=Ext) ->
+ emit_getchoice(Erule, CompList, Ext),
Imm = asn1ct_imm:per_dec_open_type(is_aligned(Erule)),
+ emit(["begin",nl]),
BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)),
- emit([";",nl,
- "_ ->",nl]),
- {TmpTerm,TmpBuf} = asn1ct_imm:dec_slim_cg(Imm, BytesVar),
- emit([com,nl,
- "{asn1_ExtAlt,{",TmpTerm,com,TmpBuf,"}}",nl,
- "end,",nl,nl,
- "{{Cname,Val},NewBytes}"]).
-
+ {Dst,DstBuf} = asn1ct_imm:dec_slim_cg(Imm, BytesVar),
+ emit([nl,
+ "end,",nl,
+ "case Choice of",nl]),
+ Pre = {safe,fun(St) ->
+ emit(["{TmpVal,_} = "]),
+ {Dst,
+ fun() ->
+ emit([",",nl,
+ "{TmpVal,",DstBuf,"}"]),
+ St
+ end}
+ end},
+ gen_dec_choice2(Erule, TopType, CompList, Pre),
+ case CompList of
+ [] -> ok;
+ [_|_] -> emit([";",nl])
+ end,
+ emit(["_ ->",nl,
+ "{{asn1_ExtAlt,",Dst,"},",DstBuf,"}",nl,
+ "end"]).
+
+emit_getchoice(Erule, CompList, Ext) ->
+ Al = is_aligned(Erule),
+ Imm = case {Ext,CompList} of
+ {noext,[_]} ->
+ {value,0};
+ {noext,_} ->
+ asn1ct_imm:per_dec_constrained(0, length(CompList)-1, Al);
+ {{ext,_,_},_} ->
+ asn1ct_imm:per_dec_normally_small_number(Al)
+ end,
+ emit(["{Choice,",{curr,bytes},"} = ",nl]),
+ BytesVar = asn1ct_gen:mk_var(asn1ct_name:prev(bytes)),
+ asn1ct_imm:dec_code_gen(Imm, BytesVar),
+ emit([com,nl]).
gen_dec_choice2(Erule,TopType,L,Ext) ->
- gen_dec_choice2(Erule,TopType,L,0,Ext).
+ gen_dec_choice2(Erule, TopType, L, 0, [], Ext).
-gen_dec_choice2(Erule,TopType,[H1,H2|T],Pos,Ext)
-when is_record(H1,'ComponentType'), is_record(H2,'ComponentType') ->
- Cname = H1#'ComponentType'.name,
- Type = H1#'ComponentType'.typespec,
+gen_dec_choice2(Erule, TopType, [H0|T], Pos, Sep0, Pre) ->
+ #'ComponentType'{name=Cname,typespec=Type} = H0,
+ H = H0#'ComponentType'{prop=mandatory},
+ emit([Sep0,Pos," ->",nl]),
case Type#type.def of
#'ObjectClassFieldType'{type={typefield,_}} ->
- emit({Pos," -> ",nl}),
- wrap_gen_dec_line(Erule,H1,TopType,Cname,Type,Pos+1,false,Ext),
- emit({";",nl});
- _ ->
- emit({Pos," -> {",{asis,Cname},",",nl}),
- wrap_gen_dec_line(Erule,H1,TopType,Cname,Type,Pos+1,false,Ext),
- emit({"};",nl})
- end,
- gen_dec_choice2(Erule,TopType,[H2|T],Pos+1,Ext);
-gen_dec_choice2(Erule,TopType,[H1,_H2|T],Pos,Ext) when is_record(H1,'ComponentType') ->
- gen_dec_choice2(Erule,TopType,[H1|T],Pos,Ext); % skip extensionmark
-gen_dec_choice2(Erule,TopType,[H1|T],Pos,Ext) when is_record(H1,'ComponentType') ->
- Cname = H1#'ComponentType'.name,
- Type = H1#'ComponentType'.typespec,
- case Type#type.def of
- #'ObjectClassFieldType'{type={typefield,_}} ->
- emit({Pos," -> ",nl}),
- wrap_gen_dec_line(Erule,H1,TopType,Cname,Type,Pos+1,false,Ext);
+ emit("{Cname,{Val,NewBytes}} = begin\n"),
+ gen_dec_choice_line(Erule, TopType, H, Pre),
+ emit([nl,
+ "end,",nl,
+ "{{Cname,Val},NewBytes}"]);
_ ->
- emit({Pos," -> {",{asis,Cname},",",nl}),
- wrap_gen_dec_line(Erule,H1,TopType,Cname,Type,Pos+1,false,Ext),
- emit("}")
+ emit("{Val,NewBytes} = begin\n"),
+ gen_dec_choice_line(Erule, TopType, H, Pre),
+ emit([nl,
+ "end,",nl,
+ "{{",{asis,Cname},",Val},NewBytes}"])
end,
- gen_dec_choice2(Erule,TopType,[T],Pos+1);
-gen_dec_choice2(Erule,TopType,[_|T],Pos,Ext) ->
- gen_dec_choice2(Erule,TopType,T,Pos,Ext);% skip extensionmark
-gen_dec_choice2(_,_,[],Pos,_) ->
- Pos.
+ Sep = [";",nl],
+ gen_dec_choice2(Erule, TopType, T, Pos+1, Sep, Pre);
+gen_dec_choice2(_, _, [], _, _, _) -> ok.
indent(N) ->
lists:duplicate(N,32). % 32 = space
-gen_encode_prim_wrapper(CtgenMod,Erule,Cont,DoTag,Value) ->
-% put(component_type,true), % add more info in component_type
- CtgenMod:gen_encode_prim(Erule,Cont,DoTag,Value).
-% erase(component_type).
-
make_elements(I,Val,ExtCnames) ->
make_elements(I,Val,ExtCnames,[]).
@@ -1816,14 +1755,6 @@ wrap_extensionAdditionGroups([H|T],ExtAddGrpLenPos,Acc,ExtAddGroupDiff,ExtGroupN
wrap_extensionAdditionGroups([],_,Acc,_,_) ->
lists:reverse(Acc).
-
-wrap_gen_dec_line(Erule,C,TopType,_Cname,_Type,Pos,DIO,Ext) ->
- put(component_type,{true,C}),
- gen_dec_line(Erule, TopType, C#'ComponentType'{prop=mandatory},
- Pos, DIO, Ext),
- erase(component_type).
-
-
value_match(Index,Value) when is_atom(Value) ->
value_match(Index,atom_to_list(Value));
value_match([],Value) ->
@@ -1835,9 +1766,5 @@ value_match1(Value,[],Acc,Depth) ->
value_match1(Value,[{VI,_}|VIs],Acc,Depth) ->
value_match1(Value,VIs,Acc++lists:concat(["element(",VI,","]),Depth+1).
-notice_value_match() ->
- Module = get(currmod),
- put(value_match,{true,Module}).
-
is_optimized(per) -> true;
is_optimized(uper) -> false.
diff --git a/lib/asn1/src/asn1ct_func.erl b/lib/asn1/src/asn1ct_func.erl
index 2d221ca1b9..262bef6862 100644
--- a/lib/asn1/src/asn1ct_func.erl
+++ b/lib/asn1/src/asn1ct_func.erl
@@ -37,9 +37,13 @@ need(MFA) ->
cast({need,MFA}).
generate(Fd) ->
- req({generate,Fd}),
+ Used0 = req(get_used),
erase(?MODULE),
- ok.
+ Used = sofs:set(Used0, [mfa]),
+ Code = sofs:relation(asn1ct_rtt:code(), [{mfa,code}]),
+ Funcs0 = sofs:image(Code, Used),
+ Funcs = sofs:to_external(Funcs0),
+ ok = file:write(Fd, Funcs).
req(Req) ->
gen_server:call(get(?MODULE), Req, infinity).
@@ -64,9 +68,8 @@ handle_cast({need,MFA}, #st{used=Used0}=St) ->
{noreply,St}
end.
-handle_call({generate,Fd}, _From, #st{used=Used}=St) ->
- generate(Fd, Used),
- {stop,normal,ok,St}.
+handle_call(get_used, _From, #st{used=Used}=St) ->
+ {stop,normal,gb_sets:to_list(Used),St}.
terminate(_, _) ->
ok.
@@ -75,14 +78,6 @@ call_args([A|As], Sep) ->
[Sep,A|call_args(As, ", ")];
call_args([], _) -> [].
-generate(Fd, Used0) ->
- Used1 = gb_sets:to_list(Used0),
- Used = sofs:set(Used1, [mfa]),
- Code = sofs:relation(asn1ct_rtt:code(), [{mfa,code}]),
- Funcs0 = sofs:image(Code, Used),
- Funcs = sofs:to_external(Funcs0),
- io:put_chars(Fd, Funcs).
-
pull_in_deps(Ws0, Used0) ->
case gb_sets:is_empty(Ws0) of
true ->
diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl
index 76c4182160..9095e145a3 100644
--- a/lib/asn1/src/asn1ct_gen.erl
+++ b/lib/asn1/src/asn1ct_gen.erl
@@ -21,15 +21,9 @@
-include("asn1_records.hrl").
--export([pgen_exports/3,
- pgen_hrl/5,
- gen_head/3,
- demit/1,
+-export([demit/1,
emit/1,
get_inner/1,type/1,def_to_tag/1,prim_bif/1,
- type_from_object/1,
- get_typefromobject/1,get_fieldcategory/2,
- get_classfieldcategory/2,
list2name/1,
list2rname/1,
constructed_suffix/2,
@@ -41,7 +35,6 @@
index2suffix/1,
get_record_name_prefix/0]).
-export([pgen/5,
- pgen_module/6,
mk_var/1,
un_hyphen_var/1]).
-export([gen_encode_constructed/4,
@@ -75,7 +68,7 @@ pgen_module(OutFile,Erules,Module,
HrlGenerated = pgen_hrl(Erules,Module,TypeOrVal,Options,Indent),
asn1ct_name:start(),
ErlFile = lists:concat([OutFile,".erl"]),
- Fid = fopen(ErlFile,[write]),
+ Fid = fopen(ErlFile),
put(gen_file_out,Fid),
asn1ct_func:start_link(),
gen_head(Erules,Module,HrlGenerated),
@@ -115,8 +108,7 @@ pgen_values(Erules,Module,[H|T]) ->
gen_value(Valuedef),
pgen_values(Erules,Module,T).
-pgen_types(_,_,_,Module,[]) ->
- gen_value_match(Module),
+pgen_types(_, _, _, _, []) ->
true;
pgen_types(Rtmod,Erules,N2nConvEnums,Module,[H|T]) ->
asn1ct_name:clear(),
@@ -580,22 +572,6 @@ gen_types(Erules,Tname,Type) when is_record(Type,type) ->
asn1ct_name:clear(),
Rtmod:gen_decode(Erules,Tname,Type).
-gen_value_match(Module) ->
- case get(value_match) of
- {true,Module} ->
- emit(["value_match([{Index,Cname}|Rest],Value) ->",nl,
- " Value2 =",nl,
- " case element(Index,Value) of",nl,
- " {Cname,Val2} -> Val2;",nl,
- " X -> X",nl,
- " end,",nl,
- " value_match(Rest,Value2);",nl,
- "value_match([],Value) ->",nl,
- " Value.",nl]);
- _ -> ok
- end,
- put(value_match,undefined).
-
gen_check_defaultval(Erules,Module,[{Name,Type}|Rest]) ->
gen_check_func(Name,Type),
gen_check_defaultval(Erules,Module,Rest);
@@ -1131,7 +1107,7 @@ pgen_info() ->
open_hrl(OutFile,Module) ->
File = lists:concat([OutFile,".hrl"]),
- Fid = fopen(File,[write]),
+ Fid = fopen(File),
put(gen_file_out,Fid),
gen_hrlhead(Module).
@@ -1146,80 +1122,67 @@ demit(Term) ->
end.
% always generation
+emit(Term) ->
+ ok = file:write(get(gen_file_out), do_emit(Term)).
-emit({external,_M,T}) ->
- emit(T);
+do_emit({external,_M,T}) ->
+ do_emit(T);
-emit({prev,Variable}) when is_atom(Variable) ->
- emit({var,asn1ct_name:prev(Variable)});
+do_emit({prev,Variable}) when is_atom(Variable) ->
+ do_emit({var,asn1ct_name:prev(Variable)});
-emit({next,Variable}) when is_atom(Variable) ->
- emit({var,asn1ct_name:next(Variable)});
+do_emit({next,Variable}) when is_atom(Variable) ->
+ do_emit({var,asn1ct_name:next(Variable)});
-emit({curr,Variable}) when is_atom(Variable) ->
- emit({var,asn1ct_name:curr(Variable)});
+do_emit({curr,Variable}) when is_atom(Variable) ->
+ do_emit({var,asn1ct_name:curr(Variable)});
-emit({var,Variable}) when is_atom(Variable) ->
+do_emit({var,Variable}) when is_atom(Variable) ->
[Head|V] = atom_to_list(Variable),
- emit([Head-32|V]);
+ [Head-32|V];
-emit({var,Variable}) ->
+do_emit({var,Variable}) ->
[Head|V] = Variable,
- emit([Head-32|V]);
-
-emit({asis,What}) ->
- format(get(gen_file_out),"~w",[What]);
-
-emit({call,M,F,A}) ->
- asn1ct_func:call(M, F, A);
-
-emit(nl) ->
- nl(get(gen_file_out));
-
-emit(com) ->
- emit(",");
+ [Head-32|V];
-emit(tab) ->
- put_chars(get(gen_file_out)," ");
+do_emit({asis,What}) ->
+ io_lib:format("~w", [What]);
-emit(What) when is_integer(What) ->
- put_chars(get(gen_file_out),integer_to_list(What));
+do_emit({call,M,F,A}) ->
+ MFA = {M,F,length(A)},
+ asn1ct_func:need(MFA),
+ [atom_to_list(F),"(",call_args(A, "")|")"];
-emit(What) when is_list(What), is_integer(hd(What)) ->
- put_chars(get(gen_file_out),What);
+do_emit(nl) ->
+ "\n";
-emit(What) when is_atom(What) ->
- put_chars(get(gen_file_out),atom_to_list(What));
+do_emit(com) ->
+ ",";
-emit(What) when is_tuple(What) ->
- emit_parts(tuple_to_list(What));
+do_emit(tab) ->
+ " ";
-emit(What) when is_list(What) ->
- emit_parts(What);
+do_emit(What) when is_integer(What) ->
+ integer_to_list(What);
-emit(X) ->
- exit({'cant emit ',X}).
+do_emit(What) when is_list(What), is_integer(hd(What)) ->
+ What;
-emit_parts([]) -> true;
-emit_parts([H|T]) ->
- emit(H),
- emit_parts(T).
+do_emit(What) when is_atom(What) ->
+ atom_to_list(What);
-format(undefined,X,Y) ->
- io:format(X,Y);
-format(X,Y,Z) ->
- io:format(X,Y,Z).
+do_emit(What) when is_tuple(What) ->
+ [do_emit(E) || E <- tuple_to_list(What)];
-nl(undefined) -> io:nl();
-nl(X) -> io:nl(X).
+do_emit(What) when is_list(What) ->
+ [do_emit(E) || E <- What].
-put_chars(undefined,X) ->
- io:put_chars(X);
-put_chars(Y,X) ->
- io:put_chars(Y,X).
+call_args([A|As], Sep) ->
+ [Sep,do_emit(A)|call_args(As, ", ")];
+call_args([], _) -> [].
-fopen(F, ModeList) ->
- case file:open(F, ModeList) of
+fopen(F) ->
+ case file:open(F, [write,raw,delayed_write]) of
{ok, Fd} ->
Fd;
{error, Reason} ->
@@ -1671,7 +1634,6 @@ unify_if_string(PrimType) ->
get_inner(A) when is_atom(A) -> A;
get_inner(Ext) when is_record(Ext,'Externaltypereference') -> Ext;
-get_inner(Tref) when is_record(Tref,typereference) -> Tref;
get_inner({fixedtypevaluefield,_,Type}) ->
if
is_record(Type,type) ->
@@ -1704,8 +1666,6 @@ get_inner(T) when is_tuple(T) ->
type(X) when is_record(X,'Externaltypereference') ->
X;
-type(X) when is_record(X,typereference) ->
- X;
type('ASN1_OPEN_TYPE') ->
'ASN1_OPEN_TYPE';
type({fixedtypevaluefield,_Name,Type}) when is_record(Type,type) ->
@@ -1713,15 +1673,6 @@ type({fixedtypevaluefield,_Name,Type}) when is_record(Type,type) ->
type({typefield,_}) ->
'ASN1_OPEN_TYPE';
type(X) ->
- %% io:format("asn1_types:type(~p)~n",[X]),
- case catch type2(X) of
- {'EXIT',_} ->
- {notype,X};
- Normal ->
- Normal
- end.
-
-type2(X) ->
case prim_bif(X) of
true ->
{primitive,bif};
@@ -1740,7 +1691,6 @@ prim_bif(X) ->
'REAL',
'OBJECT IDENTIFIER',
'RELATIVE-OID',
- 'ANY',
'NULL',
'BIT STRING' ,
'OCTET STRING' ,
@@ -1784,15 +1734,6 @@ def_to_tag(Def) ->
%% Information Object Class
-type_from_object(X) ->
- case (catch lists:last(element(2,X))) of
- {'EXIT',_} ->
- {notype,X};
- Normal ->
- Normal
- end.
-
-
get_fieldtype([],_FieldName)->
{no_type,no_name};
get_fieldtype([Field|Rest],FieldName) ->
@@ -1808,34 +1749,6 @@ get_fieldtype([Field|Rest],FieldName) ->
get_fieldtype(Rest,FieldName)
end.
-get_fieldcategory([],_FieldName) ->
- no_cat;
-get_fieldcategory([Field|Rest],FieldName) ->
- case element(2,Field) of
- FieldName ->
- element(1,Field);
- _ ->
- get_fieldcategory(Rest,FieldName)
- end.
-
-get_typefromobject(Type) when is_record(Type,type) ->
- case Type#type.def of
- {{objectclass,_,_},TypeFrObj} when is_list(TypeFrObj) ->
- {_,FieldName} = lists:last(TypeFrObj),
- FieldName;
- _ ->
- {no_field}
- end.
-
-get_classfieldcategory(Type,FieldName) ->
- case (catch Type#type.def) of
- {{obejctclass,Fields,_},_} ->
- get_fieldcategory(Fields,FieldName);
- {'EXIT',_} ->
- no_cat;
- _ ->
- no_cat
- end.
%% Information Object Class
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -1902,7 +1815,7 @@ index2suffix(N) ->
ct_gen_module(ber) ->
asn1ct_gen_ber_bin_v2;
ct_gen_module(per) ->
- asn1ct_gen_per_rt2ct;
+ asn1ct_gen_per;
ct_gen_module(uper) ->
asn1ct_gen_per.
diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl
index de0adef2b2..8ab49aec2c 100644
--- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl
+++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl
@@ -24,9 +24,7 @@
-include("asn1_records.hrl").
--export([pgen/4]).
-export([decode_class/1, decode_type/1]).
--export([add_removed_bytes/0]).
-export([gen_encode/2,gen_encode/3,gen_decode/2,gen_decode/3]).
-export([gen_encode_prim/4]).
-export([gen_dec_prim/7]).
@@ -59,18 +57,6 @@
-define(T_VisibleString, ?UNIVERSAL bor ?PRIMITIVE bor 26). %can be constructed
-define(T_GeneralString, ?UNIVERSAL bor ?PRIMITIVE bor 27). %can be constructed
-%% pgen(Erules, Module, TypeOrVal)
-%% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module
-%% .hrl file is only generated if necessary
-%% Erules = per | ber
-%% Module = atom()
-%% TypeOrVal = {TypeList,ValueList,PTypeList}
-%% TypeList = ValueList = [atom()]
-
-pgen(OutFile,Erules,Module,TypeOrVal) ->
- asn1ct_gen:pgen_module(OutFile,Erules,Module,TypeOrVal,[],true).
-
-
%%===============================================================================
%%===============================================================================
%%===============================================================================
@@ -83,8 +69,8 @@ pgen(OutFile,Erules,Module,TypeOrVal) ->
%% encode #{typedef, {pos, name, typespec}}
%%===============================================================================
-gen_encode(Erules,Type) when is_record(Type,typedef) ->
- gen_encode_user(Erules,Type).
+gen_encode(Erules, #typedef{}=D) ->
+ gen_encode_user(Erules, #typedef{}=D, true).
%%===============================================================================
%% encode #{type, {tag, def, constraint}}
@@ -134,20 +120,28 @@ gen_encode(Erules,Tname,#'ComponentType'{name=Cname,typespec=Type}) ->
NewType = Type#type{tag=[]},
gen_encode(Erules,NewTname,NewType).
-gen_encode_user(Erules,D) when is_record(D,typedef) ->
+gen_encode_user(Erules, #typedef{}=D, Wrapper) ->
Typename = [D#typedef.name],
Type = D#typedef.typespec,
InnerType = asn1ct_gen:get_inner(Type#type.def),
- OTag = Type#type.tag,
- Tag = [encode_tag_val(decode_class(X#tag.class),X#tag.form,X#tag.number)|| X <- OTag],
emit([nl,nl,"%%================================"]),
emit([nl,"%% ",Typename]),
emit([nl,"%%================================",nl]),
- emit(["'enc_",asn1ct_gen:list2name(Typename),
- "'(Val",") ->",nl]),
- emit([" 'enc_",asn1ct_gen:list2name(Typename),
- "'(Val, ", {asis,lists:reverse(Tag)},").",nl,nl]),
- emit({"'enc_",asn1ct_gen:list2name(Typename),"'(Val, TagIn) ->",nl}),
+ FuncName = "'enc_" ++ asn1ct_gen:list2name(Typename) ++ "'",
+ case Wrapper of
+ true ->
+ %% This is a top-level type. Generate an 'enc_Type'/1
+ %% wrapper.
+ OTag = Type#type.tag,
+ Tag0 = [encode_tag_val(decode_class(Class), Form, Number) ||
+ #tag{class=Class,form=Form,number=Number} <- OTag],
+ Tag = lists:reverse(Tag0),
+ emit([FuncName,"(Val) ->",nl,
+ " ",FuncName,"(Val, ",{asis,Tag},").",nl,nl]);
+ false ->
+ ok
+ end,
+ emit([FuncName,"(Val, TagIn) ->",nl]),
CurrentMod = get(currmod),
case asn1ct_gen:type(InnerType) of
{constructed,bif} ->
@@ -155,8 +149,6 @@ gen_encode_user(Erules,D) when is_record(D,typedef) ->
{primitive,bif} ->
gen_encode_prim(ber,Type,"TagIn","Val"),
emit([".",nl]);
- #typereference{val=Ename} ->
- emit([" 'enc_",Ename,"'(Val, TagIn).",nl]);
#'Externaltypereference'{module=CurrentMod,type=Etype} ->
emit([" 'enc_",Etype,"'(Val, TagIn).",nl]);
#'Externaltypereference'{module=Emod,type=Etype} ->
@@ -169,8 +161,8 @@ gen_encode_user(Erules,D) when is_record(D,typedef) ->
emit([".",nl])
end.
-gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
- BitStringConstraint = D#type.constraint,
+gen_encode_prim(_Erules, #type{}=D, DoTag, Value) ->
+ BitStringConstraint = get_size_constraint(D#type.constraint),
asn1ct_name:new(enumval),
Type = case D#type.def of
'OCTET STRING' -> restricted_string;
@@ -184,6 +176,8 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
'GeneralString' -> restricted_string;
'PrintableString' -> restricted_string;
'IA5String' -> restricted_string;
+ 'UTCTime' -> restricted_string;
+ 'GeneralizedTime' -> restricted_string;
Other -> Other
end,
case Type of
@@ -208,8 +202,6 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
call(encode_bit_string,
[{asis,BitStringConstraint},Value,
{asis,NamedNumberList},DoTag]);
- 'ANY' ->
- call(encode_open_type, [Value,DoTag]);
'NULL' ->
call(encode_null, [Value,DoTag]);
'OBJECT IDENTIFIER' ->
@@ -222,19 +214,8 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
call(encode_UTF8_string, [Value,DoTag]);
'BMPString' ->
call(encode_BMP_string, [Value,DoTag]);
- 'UTCTime' ->
- call(encode_utc_time, [Value,DoTag]);
- 'GeneralizedTime' ->
- call(encode_generalized_time, [Value,DoTag]);
'ASN1_OPEN_TYPE' ->
- call(encode_open_type, [Value,DoTag]);
- #'ObjectClassFieldType'{} ->
- case asn1ct_gen:get_inner(D#type.def) of
- {fixedtypevaluefield,_,InnerType} ->
- gen_encode_prim(Erules,InnerType,DoTag,Value);
- 'ASN1_OPEN_TYPE' ->
- call(encode_open_type, [Value,DoTag])
- end
+ call(encode_open_type, [Value,DoTag])
end.
emit_enc_enumerated_cases({L1,L2}, Tags) ->
@@ -470,32 +451,18 @@ gen_decode_user(Erules,D) when is_record(D,typedef) ->
end.
-gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) ->
+gen_dec_prim(_Erules, Att, BytesVar, DoTag, _TagIn, _Form, _OptOrMand) ->
Typename = Att#type.def,
%% Currently not used for BER replaced with [] as place holder
%% Constraint = Att#type.constraint,
%% Constraint = [],
- Constraint =
- case get_constraint(Att#type.constraint,'SizeConstraint') of
- no -> [];
- Tc -> Tc
- end,
- ValueRange =
- case get_constraint(Att#type.constraint,'ValueRange') of
- no -> [];
- Tv -> Tv
- end,
- SingleValue =
- case get_constraint(Att#type.constraint,'SingleValue') of
- no -> [];
- Sv -> Sv
- end,
+ Constraint = get_size_constraint(Att#type.constraint),
+ IntConstr = int_constr(Att#type.constraint),
AsBin = case get(binary_strings) of
true -> "_as_bin";
_ -> ""
end,
NewTypeName = case Typename of
- 'ANY' -> 'ASN1_OPEN_TYPE';
'OCTET STRING' -> restricted_string;
'NumericString' -> restricted_string;
'TeletexString' -> restricted_string;
@@ -506,6 +473,9 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) ->
'GeneralString' -> restricted_string;
'PrintableString' -> restricted_string;
'IA5String' -> restricted_string;
+ 'ObjectDescriptor'-> restricted_string;
+ 'UTCTime' -> restricted_string;
+ 'GeneralizedTime' -> restricted_string;
_ -> Typename
end,
case NewTypeName of
@@ -513,14 +483,27 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) ->
emit(["decode_boolean(",BytesVar,","]),
need(decode_boolean, 2);
'INTEGER' ->
- emit(["decode_integer(",BytesVar,",",
- {asis,int_constr(SingleValue,ValueRange)},","]),
- need(decode_integer, 3);
+ case IntConstr of
+ [] ->
+ emit(["decode_integer(",BytesVar,","]),
+ need(decode_integer, 2);
+ {_,_} ->
+ emit(["decode_integer(",BytesVar,",",
+ {asis,IntConstr},","]),
+ need(decode_integer, 3)
+ end;
{'INTEGER',NamedNumberList} ->
- emit(["decode_integer(",BytesVar,",",
- {asis,int_constr(SingleValue,ValueRange)},",",
- {asis,NamedNumberList},","]),
- need(decode_integer, 4);
+ case IntConstr of
+ [] ->
+ emit(["decode_named_integer(",BytesVar,",",
+ {asis,NamedNumberList},","]),
+ need(decode_named_integer, 3);
+ {_,_} ->
+ emit(["decode_named_integer(",BytesVar,",",
+ {asis,IntConstr},",",
+ {asis,NamedNumberList},","]),
+ need(decode_named_integer, 4)
+ end;
{'ENUMERATED',NamedNumberList} ->
emit(["decode_enumerated(",BytesVar,",",
{asis,NamedNumberList},","]),
@@ -538,10 +521,6 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) ->
'RELATIVE-OID' ->
emit(["decode_relative_oid(",BytesVar,","]),
need(decode_relative_oid, 2);
- 'ObjectDescriptor' ->
- emit(["decode_restricted_string(",
- BytesVar,",",{asis,Constraint},","]),
- need(decode_restricted_string, 3);
restricted_string ->
emit(["decode_restricted_string",AsBin,"(",BytesVar,","]),
case Constraint of
@@ -563,31 +542,10 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) ->
emit(["decode_BMP_string",AsBin,"(",
BytesVar,",",{asis,Constraint},","]),
need(decode_BMP_string, 3);
- 'UTCTime' ->
- emit(["decode_utc_time",AsBin,"(",
- BytesVar,",",{asis,Constraint},","]),
- need(decode_utc_time, 3);
- 'GeneralizedTime' ->
- emit(["decode_generalized_time",AsBin,"(",
- BytesVar,",",{asis,Constraint},","]),
- need(decode_generalized_time, 3);
'ASN1_OPEN_TYPE' ->
emit(["decode_open_type_as_binary(",
BytesVar,","]),
- need(decode_open_type_as_binary, 2);
- #'ObjectClassFieldType'{} ->
- case asn1ct_gen:get_inner(Att#type.def) of
- {fixedtypevaluefield,_,InnerType} ->
- gen_dec_prim(Erules,InnerType,BytesVar,DoTag,TagIn,Form,OptOrMand);
- 'ASN1_OPEN_TYPE' ->
- emit(["decode_open_type_as_binary(",
- BytesVar,","]),
- need(decode_open_type_as_binary, 2);
- Other ->
- exit({'cannot decode',Other})
- end;
- Other ->
- exit({'cannot decode',Other})
+ need(decode_open_type_as_binary, 2)
end,
TagStr = case DoTag of
@@ -604,25 +562,27 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) ->
{call,ber,match_tags,[BytesVar,TagStr]},com,nl,
{call,real_common,decode_real,[{curr,tmpbuf}]},nl,
"end",nl]);
- #'ObjectClassFieldType'{} ->
- case asn1ct_gen:get_inner(Att#type.def) of
- 'ASN1_OPEN_TYPE' ->
- emit([TagStr,")"]);
- _ -> ok
- end;
_ ->
emit([TagStr,")"])
end.
-
-int_constr([],[]) ->
- [];
-int_constr([],ValueRange) ->
- ValueRange;
-int_constr(SingleValue,[]) ->
- SingleValue;
-int_constr(SV,VR) ->
- [SV,VR].
+%% Simplify an integer constraint so that we can efficiently test it.
+-spec int_constr(term()) -> [] | {integer(),integer()|'MAX'}.
+int_constr(C) ->
+ case asn1ct_imm:effective_constraint(integer, C) of
+ [{_,[]}] ->
+ %% Extension - ignore constraint.
+ [];
+ [{'ValueRange',{'MIN',_}}] ->
+ %% Tricky to implement efficiently - ignore it.
+ [];
+ [{'ValueRange',{_,_}=Range}] ->
+ Range;
+ [{'SingleValue',Sv}] ->
+ {Sv,Sv};
+ [] ->
+ []
+ end.
gen_dec_bit_string(BytesVar, _Constraint, [_|_]=NNL, TagStr) ->
call(decode_named_bit_string,
@@ -664,9 +624,7 @@ gen_obj_code(Erules,_Module,Obj) when is_record(Obj,typedef) ->
ObjName,Fields,[]),
emit(nl),
gen_decode_constr_type(Erules,DecConstructed),
- emit_tlv_format_function();
-gen_obj_code(_Erules,_Module,Obj) when is_record(Obj,pobjectdef) ->
- ok.
+ emit_tlv_format_function().
gen_encode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest],
ObjName,ObjectFields,ConstrAcc) ->
@@ -757,7 +715,7 @@ gen_encode_objectfields(_,[],_,_,Acc) ->
gen_encode_constr_type(Erules,[TypeDef|Rest]) when is_record(TypeDef,typedef) ->
case is_already_generated(enc,TypeDef#typedef.name) of
true -> ok;
- _ -> gen_encode_user(Erules,TypeDef)
+ false -> gen_encode_user(Erules, TypeDef, false)
end,
gen_encode_constr_type(Erules,Rest);
gen_encode_constr_type(_,[]) ->
@@ -815,8 +773,8 @@ gen_encode_default_call(ClassName,FieldName,Type) ->
Tag = [encode_tag_val(decode_class(X#tag.class),X#tag.form,X#tag.number)|| X <- OTag],
case asn1ct_gen:type(InnerType) of
{constructed,bif} ->
-%% asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type);
- emit([" 'enc_",ClassName,'_',FieldName,"'(Bytes)"]),
+ emit([" 'enc_",ClassName,'_',FieldName,"'",
+ "(Val, ",{asis,Tag},")"]),
[#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])),
typespec=Type}];
{primitive,bif} ->
@@ -964,7 +922,10 @@ gen_decode_constr_type(Erules,[TypeDef|Rest]) when is_record(TypeDef,typedef) ->
case is_already_generated(dec,TypeDef#typedef.name) of
true -> ok;
_ ->
- gen_decode(Erules,TypeDef)
+ emit([nl,nl,
+ "'dec_",TypeDef#typedef.name,
+ "'(Tlv, TagIn) ->",nl]),
+ gen_decode_user(Erules, TypeDef)
end,
gen_decode_constr_type(Erules,Rest);
gen_decode_constr_type(_,[]) ->
@@ -1108,54 +1069,29 @@ gen_objset_enc(_,_,{unique,undefined},_,_,_,_,_) ->
%% There is no unique field in the class of this object set
%% don't bother about the constraint
[];
-gen_objset_enc(Erules,ObjSName,UniqueName,
- [{ObjName,Val,Fields},T|Rest],ClName,ClFields,
+gen_objset_enc(Erules, ObjSetName, UniqueName,
+ [{ObjName,Val,Fields}|T], ClName, ClFields,
NthObj,Acc)->
- emit({"'getenc_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val},
- ") ->",nl}),
+ emit(["'getenc_",ObjSetName,"'(",{asis,UniqueName},",",{asis,Val},
+ ") ->",nl]),
CurrMod = get(currmod),
{InternalFunc,NewNthObj}=
case ObjName of
{no_mod,no_name} ->
- gen_inlined_enc_funs(Fields,ClFields,ObjSName,NthObj);
- {CurrMod,Name} ->
- emit({" fun 'enc_",Name,"'/3"}),
- {[],NthObj};
- {ModuleName,Name} ->
- emit_ext_fun(enc,ModuleName,Name),
-% emit([" {'",ModuleName,"', 'enc_",Name,"'}"]),
- {[],NthObj};
- _ ->
- emit({" fun 'enc_",ObjName,"'/3"}),
- {[],NthObj}
- end,
- emit({";",nl}),
- gen_objset_enc(Erules,ObjSName,UniqueName,[T|Rest],ClName,ClFields,
- NewNthObj,InternalFunc ++ Acc);
-gen_objset_enc(_,ObjSetName,UniqueName,
- [{ObjName,Val,Fields}],_ClName,ClFields,NthObj,Acc) ->
- emit({"'getenc_",ObjSetName,"'(",{asis,UniqueName},",",
- {asis,Val},") ->",nl}),
- CurrMod = get(currmod),
- {InternalFunc,_} =
- case ObjName of
- {no_mod,no_name} ->
gen_inlined_enc_funs(Fields,ClFields,ObjSetName,NthObj);
{CurrMod,Name} ->
emit({" fun 'enc_",Name,"'/3"}),
{[],NthObj};
{ModuleName,Name} ->
emit_ext_fun(enc,ModuleName,Name),
-% emit([" {'",ModuleName,"', 'enc_",Name,"'}"]),
{[],NthObj};
_ ->
emit({" fun 'enc_",ObjName,"'/3"}),
{[],NthObj}
end,
- emit([";",nl]),
- emit_default_getenc(ObjSetName,UniqueName),
- emit({".",nl,nl}),
- InternalFunc ++ Acc;
+ emit({";",nl}),
+ gen_objset_enc(Erules, ObjSetName, UniqueName, T, ClName, ClFields,
+ NewNthObj, InternalFunc ++ Acc);
%% See X.681 Annex E for the following case
gen_objset_enc(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,
_ClFields,_NthObj,Acc) ->
@@ -1167,7 +1103,9 @@ gen_objset_enc(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,
emit({indent(6),"{Val,Len}",nl}),
emit({indent(3),"end.",nl,nl}),
Acc;
-gen_objset_enc(_,_,_,[],_,_,_,Acc) ->
+gen_objset_enc(_, ObjSetName, UniqueName, [], _, _, _, Acc) ->
+ emit_default_getenc(ObjSetName, UniqueName),
+ emit({".",nl,nl}),
Acc.
emit_ext_fun(EncDec,ModuleName,Name) ->
@@ -1181,78 +1119,34 @@ emit_default_getenc(ObjSetName,UniqueName) ->
%% gen_inlined_enc_funs for each object iterates over all fields of a
%% class, and for each typefield it checks if the object has that
%% field and emits the proper code.
-gen_inlined_enc_funs(Fields,[{typefield,Name,_}|Rest],
- ObjSetName,NthObj) ->
- CurrMod = get(currmod),
- InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]),
- case lists:keysearch(Name,1,Fields) of
- {value,{_,Type}} when is_record(Type,type) ->
- emit({indent(3),"fun(Type, Val, _RestPrimFieldName) ->",nl,
- indent(6),"case Type of",nl}),
- {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName),
- gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+N,Ret);
- {value,{_,Type}} when is_record(Type,typedef) ->
- emit({indent(3),"fun(Type, Val, _RestPrimFieldName) ->",nl,
- indent(6),"case Type of",nl}),
- emit({indent(9),{asis,Name}," ->",nl}),
- {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName),
- gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+N,Ret);
- {value,{_,#'Externaltypereference'{module=M,type=T}}} ->
- emit([indent(3),"fun(Type, Val, _RestPrimFieldName) ->",nl,
- indent(6),"case Type of",nl]),
- emit([indent(9),{asis,Name}," ->",nl]),
- if
- M == CurrMod ->
- emit([indent(12),"'enc_",T,"'(Val)"]);
- true ->
- #typedef{typespec=Type} = asn1_db:dbget(M,T),
- OTag = Type#type.tag,
-%% Tag = [encode_tag_val((decode_class(X#tag.class) bsl 10) +
-%% X#tag.number) ||
-%% X <- OTag],
- Tag = [encode_tag_val(decode_class(X#tag.class),
- X#tag.form,X#tag.number) ||
- X <- OTag],
- emit([indent(12),"'",M,"':'enc_",T,"'(Val, ",{asis,Tag},")"])
- end,
- gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj,[]);
- false ->
- %% This field was not present in the object thus there
- %% were no type in the table and we therefore generate
- %% code that returns the input for application treatment.
- emit([indent(3),"fun(Type, Val, _RestPrimFieldName) ->",nl,
- indent(6),"case Type of",nl,
- indent(9),{asis,Name}," ->",nl,
- indent(12),"Len = case Val of",nl,
- indent(15),"B when is_binary(B) -> size(B);",nl,
- indent(15),"_ -> length(Val)",nl,
- indent(12),"end,",nl,
- indent(12),"{Val,Len}"]),
- gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj,[])
- end;
+gen_inlined_enc_funs(Fields, [{typefield,_,_}|_]=T, ObjSetName, NthObj) ->
+ emit([indent(3),"fun(Type, Val, _RestPrimFieldName) ->",nl,
+ indent(6),"case Type of",nl]),
+ gen_inlined_enc_funs1(Fields, T, ObjSetName, [], NthObj, []);
gen_inlined_enc_funs(Fields,[_|Rest],ObjSetName,NthObj) ->
gen_inlined_enc_funs(Fields,Rest,ObjSetName,NthObj);
gen_inlined_enc_funs(_,[],_,NthObj) ->
{[],NthObj}.
-gen_inlined_enc_funs1(Fields,[{typefield,Name,_}|Rest],ObjSetName,
- NthObj,Acc) ->
+gen_inlined_enc_funs1(Fields, [{typefield,Name,_}|Rest], ObjSetName,
+ Sep0, NthObj, Acc0) ->
+ emit(Sep0),
+ Sep = [";",nl],
CurrMod = get(currmod),
InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]),
- {Acc2,NAdd}=
- case lists:keysearch(Name,1,Fields) of
- {value,{_,Type}} when is_record(Type,type) ->
- emit({";",nl}),
- {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName),
- {Ret++Acc,N};
- {value,{_,Type}} when is_record(Type,typedef) ->
- emit({";",nl,indent(9),{asis,Name}," ->",nl}),
- {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName),
- {Ret++Acc,N};
- {value,{_,#'Externaltypereference'{module=M,type=T}}} ->
- emit({";",nl,indent(9),{asis,Name}," ->",nl}),
+ {Acc,NAdd} =
+ case lists:keyfind(Name,1,Fields) of
+ {_,#type{}=Type} ->
+ {Ret,N} = emit_inner_of_fun(Type,InternalDefFunName),
+ {Ret++Acc0,N};
+ {_,#typedef{}=Type} ->
+ emit([indent(9),{asis,Name}," ->",nl]),
+ {Ret,N} = emit_inner_of_fun(Type, InternalDefFunName),
+ {Ret++Acc0,N};
+ {_,#'Externaltypereference'{module=M,type=T}} ->
+ emit([indent(9),{asis,Name}," ->",nl]),
if
- M == CurrMod ->
+ M =:= CurrMod ->
emit([indent(12),"'enc_",T,"'(Val)"]);
true ->
#typedef{typespec=Type} = asn1_db:dbget(M,T),
@@ -1260,27 +1154,30 @@ gen_inlined_enc_funs1(Fields,[{typefield,Name,_}|Rest],ObjSetName,
Tag = [encode_tag_val(decode_class(X#tag.class),
X#tag.form,X#tag.number) ||
X <- OTag],
- emit([indent(12),"'",M,"':'enc_",T,"'(Val, ",{asis,Tag},")"])
+ emit([indent(12),"'",M,"':'enc_",T,"'(Val, ",
+ {asis,Tag},")"])
end,
- {Acc,0};
+ {Acc0,0};
false ->
%% This field was not present in the object thus there
%% were no type in the table and we therefore generate
%% code that returns the input for application
%% treatment.
- emit([";",nl,indent(9),{asis,Name}," ->",nl]),
- emit([indent(12),"Len = case Val of",nl,
- indent(15),"Bin when is_binary(Bin) -> byte_size(Bin);",nl,
- indent(15),"_ -> length(Val)",nl,indent(12),"end,",nl,
+ emit([indent(9),{asis,Name}," ->",nl,
+ indent(12),"Len = case Val of",nl,
+ indent(15),"Bin when is_binary(Bin) -> "
+ "byte_size(Bin);",nl,
+ indent(15),"_ -> length(Val)",nl,
+ indent(12),"end,",nl,
indent(12),"{Val,Len}"]),
- {Acc,0}
+ {Acc0,0}
end,
- gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+NAdd,Acc2);
-gen_inlined_enc_funs1(Fields,[_|Rest],ObjSetName,NthObj,Acc)->
- gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj,Acc);
-gen_inlined_enc_funs1(_,[],_,NthObj,Acc) ->
- emit({nl,indent(6),"end",nl}),
- emit({indent(3),"end"}),
+ gen_inlined_enc_funs1(Fields, Rest, ObjSetName, Sep, NthObj+NAdd, Acc);
+gen_inlined_enc_funs1(Fields,[_|Rest], ObjSetName, Sep, NthObj, Acc)->
+ gen_inlined_enc_funs1(Fields, Rest, ObjSetName, Sep, NthObj, Acc);
+gen_inlined_enc_funs1(_, [], _, _, NthObj, Acc) ->
+ emit([nl,indent(6),"end",nl,
+ indent(3),"end"]),
{Acc,NthObj}.
emit_inner_of_fun(TDef=#typedef{name={ExtMod,Name},typespec=Type},
@@ -1319,10 +1216,6 @@ emit_inner_of_fun(Type,_) when is_record(Type,type) ->
X#tag.form,X#tag.number)||X <- OTag],
emit([indent(9),Def," ->",nl,indent(12)]),
gen_encode_prim(ber,Type,{asis,lists:reverse(Tag)},"Val");
- TRef when is_record(TRef,typereference) ->
- T = TRef#typereference.val,
- emit([indent(9),T," ->",nl,indent(12),"'enc_",T,
- "'(Val)"]);
#'Externaltypereference'{module=CurrMod,type=T} ->
emit([indent(9),T," ->",nl,indent(12),"'enc_",T,
"'(Val)"]);
@@ -1345,8 +1238,8 @@ gen_objset_dec(_,_,{unique,undefined},_,_,_,_) ->
%% There is no unique field in the class of this object set
%% don't bother about the constraint
ok;
-gen_objset_dec(Erules,ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest],
- ClName,ClFields,NthObj)->
+gen_objset_dec(Erules, ObjSName, UniqueName, [{ObjName,Val,Fields}|T],
+ ClName, ClFields, NthObj)->
emit(["'getdec_",ObjSName,"'(",{asis,UniqueName},",",
{asis,Val},") ->",nl]),
CurrMod = get(currmod),
@@ -1359,35 +1252,14 @@ gen_objset_dec(Erules,ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest],
NthObj;
{ModuleName,Name} ->
emit_ext_fun(dec,ModuleName,Name),
-% emit([" {'",ModuleName,"', 'dec_",Name,"'}"]),
NthObj;
_ ->
emit([" fun 'dec_",ObjName,"'/3"]),
NthObj
end,
emit([";",nl]),
- gen_objset_dec(Erules,ObjSName,UniqueName,[T|Rest],ClName,
- ClFields,NewNthObj);
-gen_objset_dec(_,ObjSetName,UniqueName,[{ObjName,Val,Fields}],
- _ClName,ClFields,NthObj) ->
- emit(["'getdec_",ObjSetName,"'(",{asis,UniqueName},",",
- {asis,Val},") ->",nl]),
- CurrMod = get(currmod),
- case ObjName of
- {no_mod,no_name} ->
- gen_inlined_dec_funs(Fields,ClFields,ObjSetName,NthObj);
- {CurrMod,Name} ->
- emit([" fun 'dec_",Name,"'/3"]);
- {ModuleName,Name} ->
- emit_ext_fun(dec,ModuleName,Name);
-% emit([" {'",ModuleName,"', 'dec_",Name,"'}"]);
- _ ->
- emit([" fun 'dec_",ObjName,"'/3"])
- end,
- emit([";",nl]),
- emit_default_getdec(ObjSetName,UniqueName),
- emit([".",nl,nl]),
- ok;
+ gen_objset_dec(Erules, ObjSName, UniqueName, T, ClName,
+ ClFields, NewNthObj);
gen_objset_dec(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,
_ClFields,_NthObj) ->
emit(["'getdec_",ObjSetName,"'(_, _) ->",nl]),
@@ -1401,86 +1273,41 @@ gen_objset_dec(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,
indent(4),"end",nl]),
emit([indent(2),"end.",nl,nl]),
ok;
-gen_objset_dec(_,_,_,[],_,_,_) ->
+gen_objset_dec(_, ObjSetName, UniqueName, [], _, _, _) ->
+ emit_default_getdec(ObjSetName, UniqueName),
+ emit([".",nl,nl]),
ok.
emit_default_getdec(ObjSetName,UniqueName) ->
emit(["'getdec_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]),
emit([indent(2), "fun(C,V,_) -> exit({{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},", ErrV}}) end"]).
-gen_inlined_dec_funs(Fields,[{typefield,Name,Prop}|Rest],
- ObjSetName,NthObj) ->
- DecProp = case Prop of
- 'OPTIONAL' -> opt_or_default;
- {'DEFAULT',_} -> opt_or_default;
- _ -> mandatory
- end,
- CurrMod = get(currmod),
- InternalDefFunName = [NthObj,Name,ObjSetName],
- case lists:keysearch(Name,1,Fields) of
- {value,{_,Type}} when is_record(Type,type) ->
- emit([indent(3),"fun(Type, Bytes, _RestPrimFieldName) ->",
- nl,indent(6),"case Type of",nl]),
- N=emit_inner_of_decfun(Type,DecProp,InternalDefFunName),
- gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj+N);
- {value,{_,Type}} when is_record(Type,typedef) ->
- emit([indent(3),"fun(Type, Bytes, _RestPrimFieldName) ->",
- nl,indent(6),"case Type of",nl]),
- emit([indent(9),{asis,Name}," ->",nl]),
- N=emit_inner_of_decfun(Type,DecProp,InternalDefFunName),
- gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj+N);
- {value,{_,#'Externaltypereference'{module=M,type=T}}} ->
- emit([indent(3),"fun(Type, Bytes, _RestPrimFieldName) ->",
- nl,indent(6),"case Type of",nl]),
- emit([indent(9),{asis,Name}," ->",nl]),
- if
- M == CurrMod ->
- emit([indent(12),"'dec_",T,"'(Bytes)"]);
- true ->
- #typedef{typespec=Type} = asn1_db:dbget(M,T),
- OTag = Type#type.tag,
- Tag = [(decode_class(X#tag.class) bsl 10) + X#tag.number ||
- X <- OTag],
- emit([indent(12),"'",M,"':'dec_",T,"'(Bytes, ",{asis,Tag},")"])
- end,
- gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj);
- false ->
- emit([indent(3),"fun(Type, Bytes, _RestPrimFieldName) ->",
- nl,indent(6),"case Type of",nl,
- indent(9),{asis,Name}," ->",nl,
- indent(12),"Len = case Bytes of",nl,
- indent(15),"B when is_binary(B) -> byte_size(B);",nl,
- indent(15),"_ -> length(Bytes)",nl,
- indent(12),"end,",nl,
- indent(12),"{Bytes,[],Len}"]),
- gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj)
- end;
-gen_inlined_dec_funs(Fields,[_H|Rest],ObjSetName,NthObj) ->
- gen_inlined_dec_funs(Fields,Rest,ObjSetName,NthObj);
-gen_inlined_dec_funs(_,[],_,NthObj) ->
- NthObj.
+gen_inlined_dec_funs(Fields, ClFields, ObjSetName, NthObj) ->
+ emit([indent(3),"fun(Type, Bytes, _RestPrimFieldName) ->",nl,
+ indent(6),"case Type of",nl]),
+ gen_inlined_dec_funs1(Fields, ClFields, ObjSetName, "", NthObj).
-gen_inlined_dec_funs1(Fields,[{typefield,Name,Prop}|Rest],
- ObjSetName,NthObj) ->
+gen_inlined_dec_funs1(Fields, [{typefield,Name,Prop}|Rest],
+ ObjSetName, Sep0, NthObj) ->
+ emit(Sep0),
+ Sep = [";",nl],
DecProp = case Prop of
'OPTIONAL' -> opt_or_default;
{'DEFAULT',_} -> opt_or_default;
_ -> mandatory
end,
- CurrMod = get(currmod),
InternalDefFunName = [NthObj,Name,ObjSetName],
- N=
- case lists:keysearch(Name,1,Fields) of
- {value,{_,Type}} when is_record(Type,type) ->
- emit([";",nl]),
+ N = case lists:keyfind(Name, 1, Fields) of
+ {_,#type{}=Type} ->
emit_inner_of_decfun(Type,DecProp,InternalDefFunName);
- {value,{_,Type}} when is_record(Type,typedef) ->
- emit([";",nl,indent(9),{asis,Name}," ->",nl]),
+ {_,#typedef{}=Type} ->
+ emit([indent(9),{asis,Name}," ->",nl]),
emit_inner_of_decfun(Type,DecProp,InternalDefFunName);
- {value,{_,#'Externaltypereference'{module=M,type=T}}} ->
- emit([";",nl,indent(9),{asis,Name}," ->",nl]),
+ {_,#'Externaltypereference'{module=M,type=T}} ->
+ emit([indent(9),{asis,Name}," ->",nl]),
+ CurrMod = get(currmod),
if
- M == CurrMod ->
+ M =:= CurrMod ->
emit([indent(12),"'dec_",T,"'(Bytes)"]);
true ->
#typedef{typespec=Type} = asn1_db:dbget(M,T),
@@ -1491,21 +1318,20 @@ gen_inlined_dec_funs1(Fields,[{typefield,Name,Prop}|Rest],
end,
0;
false ->
- emit([";",nl,
- indent(9),{asis,Name}," ->",nl,
+ emit([indent(9),{asis,Name}," ->",nl,
indent(12),"Len = case Bytes of",nl,
- indent(15),"B when is_binary(B) -> size(B);",nl,
+ indent(15),"B when is_binary(B) -> byte_size(B);",nl,
indent(15),"_ -> length(Bytes)",nl,
indent(12),"end,",nl,
indent(12),"{Bytes,[],Len}"]),
0
end,
- gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj+N);
-gen_inlined_dec_funs1(Fields,[_|Rest],ObjSetName,NthObj)->
- gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj);
-gen_inlined_dec_funs1(_,[],_,NthObj) ->
- emit([nl,indent(6),"end",nl]),
- emit([indent(3),"end"]),
+ gen_inlined_dec_funs1(Fields, Rest, ObjSetName, Sep, NthObj+N);
+gen_inlined_dec_funs1(Fields, [_|Rest], ObjSetName, Sep, NthObj)->
+ gen_inlined_dec_funs1(Fields, Rest, ObjSetName, Sep, NthObj);
+gen_inlined_dec_funs1(_, [], _, _, NthObj) ->
+ emit([nl,indent(6),"end",nl,
+ indent(3),"end"]),
NthObj.
emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type},Prop,
@@ -1561,10 +1387,9 @@ emit_inner_of_decfun(Type,Prop,_) when is_record(Type,type) ->
gen_internal_funcs(_,[]) ->
ok;
gen_internal_funcs(Erules,[TypeDef|Rest]) ->
- gen_encode_user(Erules,TypeDef),
- emit([nl,nl,"'dec_",TypeDef#typedef.name,
-% "'(Tlv, OptOrMand, TagIn) ->",nl]),
- "'(Tlv, TagIn) ->",nl]),
+ gen_encode_user(Erules, TypeDef, false),
+ emit([nl,nl,
+ "'dec_",TypeDef#typedef.name,"'(Tlv, TagIn) ->",nl]),
gen_decode_user(Erules,TypeDef),
gen_internal_funcs(Erules,Rest).
@@ -1615,46 +1440,23 @@ decode_type('BMPString') -> 30;
decode_type('CHOICE') -> 'CHOICE'; % choice gets the tag from the actual alternative
decode_type(Else) -> exit({error,{asn1,{unrecognized_type,Else}}}).
-add_removed_bytes() ->
- asn1ct_name:delete(rb),
- add_removed_bytes(asn1ct_name:all(rb)).
-
-add_removed_bytes([H,T1|T]) ->
- emit({{var,H},"+"}),
- add_removed_bytes([T1|T]);
-add_removed_bytes([H|T]) ->
- emit({{var,H}}),
- add_removed_bytes(T);
-add_removed_bytes([]) ->
- true.
-
-mkfuncname(WhatKind,DecOrEnc) ->
- case WhatKind of
- #'Externaltypereference'{module=Mod,type=EType} ->
- CurrMod = get(currmod),
- case CurrMod of
- Mod ->
- lists:concat(["'",DecOrEnc,"_",EType,"'"]);
- _ ->
-% io:format("CurrMod: ~p, Mod: ~p~n",[CurrMod,Mod]),
- lists:concat(["'",Mod,"':'",DecOrEnc,"_",EType,"'"])
- end;
- #'typereference'{val=EType} ->
+mkfuncname(#'Externaltypereference'{module=Mod,type=EType}, DecOrEnc) ->
+ CurrMod = get(currmod),
+ case CurrMod of
+ Mod ->
lists:concat(["'",DecOrEnc,"_",EType,"'"]);
- 'ASN1_OPEN_TYPE' ->
- lists:concat(["'",DecOrEnc,"_",WhatKind,"'"])
-
+ _ ->
+ lists:concat(["'",Mod,"':'",DecOrEnc,"_",EType,"'"])
end.
-get_constraint(C,Key) ->
- case lists:keysearch(Key,1,C) of
- false ->
- no;
- {value,{_,V}} ->
- V
+get_size_constraint(C) ->
+ case lists:keyfind('SizeConstraint', 1, C) of
+ false -> [];
+ {_,{_,[]}} -> []; %Extensible.
+ {_,{Sv,Sv}} -> Sv;
+ {_,{_,_}=Tc} -> Tc
end.
-
get_class_fields(#classdef{typespec=ObjClass}) ->
ObjClass#objectclass.fields;
get_class_fields(#objectclass{fields=Fields}) ->
diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl
index fac233532b..30c9ab9365 100644
--- a/lib/asn1/src/asn1ct_gen_per.erl
+++ b/lib/asn1/src/asn1ct_gen_per.erl
@@ -26,28 +26,16 @@
%-compile(export_all).
-export([gen_dec_imm/2]).
--export([pgen/4,gen_dec_prim/3,gen_encode_prim/4]).
+-export([gen_dec_prim/3,gen_encode_prim/3]).
-export([gen_obj_code/3,gen_objectset_code/2]).
-export([gen_decode/2, gen_decode/3]).
-export([gen_encode/2, gen_encode/3]).
--export([is_already_generated/2,more_genfields/1,get_class_fields/1,
- get_object_field/2]).
+-export([gen_dec_external/2]).
-export([extaddgroup2sequence/1]).
-import(asn1ct_gen, [emit/1,demit/1]).
-import(asn1ct_func, [call/3]).
-%% pgen(Erules, Module, TypeOrVal)
-%% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module
-%% .hrl file is only generated if necessary
-%% Erules = per | ber
-%% Module = atom()
-%% TypeOrVal = {TypeList,ValueList}
-%% TypeList = ValueList = [atom()]
-
-pgen(OutFile,Erules,Module,TypeOrVal) ->
- asn1ct_gen:pgen_module(OutFile,Erules,Module,TypeOrVal,[],true).
-
%% Generate ENCODING ******************************
%%****************************************x
@@ -96,36 +84,44 @@ gen_encode_user(Erules,D) when is_record(D,typedef) ->
emit({"'enc_",asn1ct_gen:list2name(Typename),"'(Val) ->",nl}),
case asn1ct_gen:type(InnerType) of
{primitive,bif} ->
- gen_encode_prim(Erules,Def,"false"),
+ gen_encode_prim(Erules, Def),
emit({".",nl});
'ASN1_OPEN_TYPE' ->
- gen_encode_prim(Erules,Def#type{def='ASN1_OPEN_TYPE'},"false"),
+ gen_encode_prim(Erules, Def#type{def='ASN1_OPEN_TYPE'}),
emit({".",nl});
{constructed,bif} ->
asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,D);
#'Externaltypereference'{module=CurrMod,type=Etype} ->
emit({"'enc_",Etype,"'(Val).",nl,nl});
#'Externaltypereference'{module=Emod,type=Etype} ->
- emit({"'",Emod,"':'enc_",Etype,"'(Val).",nl,nl});
- #typereference{val=Ename} ->
- emit({"'enc_",Ename,"'(Val).",nl,nl});
- {notype,_} ->
- emit({"'enc_",InnerType,"'(Val).",nl,nl})
+ emit({"'",Emod,"':'enc_",Etype,"'(Val).",nl,nl})
end.
-gen_encode_prim(Erules,D,DoTag) ->
- Value = case asn1ct_name:active(val) of
- true ->
- asn1ct_gen:mk_var(asn1ct_name:curr(val));
- false ->
- "Val"
- end,
- gen_encode_prim(Erules,D,DoTag,Value).
-
-gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
+gen_encode_prim(Erules, D) ->
+ Value = asn1ct_gen:mk_var(asn1ct_name:curr(val)),
+ gen_encode_prim(Erules, D, Value).
+
+gen_encode_prim(Erules, #type{def={'ENUMERATED',{N1,N2}}}, Value) ->
+ NewList = [{0,X} || {X,_} <- N1] ++ ['EXT_MARK'] ++
+ [{1,X} || {X,_} <- N2],
+ NewC = {0,length(N1)-1},
+ emit(["case ",Value," of",nl]),
+ emit_enc_enumerated_cases(Erules, NewC, NewList, 0);
+gen_encode_prim(Erules, #type{def={'ENUMERATED',NNL}}, Value) ->
+ NewList = [X || {X,_} <- NNL],
+ NewC = {0,length(NewList)-1},
+ emit(["case ",Value," of",nl]),
+ emit_enc_enumerated_cases(Erules, NewC, NewList, 0);
+gen_encode_prim(per=Erules, D, Value) ->
+ asn1ct_gen_per_rt2ct:gen_encode_prim(Erules, D, Value);
+gen_encode_prim(Erules, #type{}=D, Value) ->
Constraint = D#type.constraint,
- asn1ct_name:new(enumval),
+ SizeConstr = asn1ct_imm:effective_constraint(bitstring, Constraint),
+ Pa = case lists:keyfind('PermittedAlphabet', 1, Constraint) of
+ false -> no;
+ {_,Pa0} -> Pa0
+ end,
case D#type.def of
'INTEGER' ->
Args = [{asis,asn1ct_imm:effective_constraint(integer,Constraint)},
@@ -135,23 +131,10 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
Args = [{asis,asn1ct_imm:effective_constraint(integer,Constraint)},
Value,{asis,NamedNumberList}],
call(Erules, encode_integer, Args);
- {'ENUMERATED',{Nlist1,Nlist2}} ->
- NewList = [{0,X} || {X,_} <- Nlist1] ++ ['EXT_MARK'] ++
- [{1,X} || {X,_} <- Nlist2],
- NewC = {0,length(Nlist1)-1},
- emit(["case ",Value," of",nl]),
- emit_enc_enumerated_cases(Erules, NewC, NewList, 0);
- {'ENUMERATED',NamedNumberList} ->
- NewList = [X || {X,_} <- NamedNumberList],
- NewC = {0,length(NewList)-1},
- emit(["case ",Value," of",nl]),
- emit_enc_enumerated_cases(Erules, NewC, NewList, 0);
-
'REAL' ->
emit_enc_real(Erules, Value);
{'BIT STRING',NamedNumberList} ->
- SizeConstr = get_constraint(Constraint, 'SizeConstraint'),
call(Erules, encode_bit_string,
[{asis,SizeConstr},Value,
{asis,NamedNumberList}]);
@@ -167,7 +150,7 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
'BOOLEAN' ->
call(Erules, encode_boolean, [Value]);
'OCTET STRING' ->
- case get_constraint(Constraint, 'SizeConstraint') of
+ case SizeConstr of
0 ->
emit("[]");
no ->
@@ -176,34 +159,40 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
call(Erules, encode_octet_string, [{asis,C},Value])
end;
'NumericString' ->
- call(Erules, encode_NumericString, [{asis,Constraint},Value]);
+ call(Erules, encode_NumericString, [{asis,SizeConstr},
+ {asis,Pa},Value]);
TString when TString == 'TeletexString';
TString == 'T61String' ->
call(Erules, encode_TeletexString, [{asis,Constraint},Value]);
'VideotexString' ->
call(Erules, encode_VideotexString, [{asis,Constraint},Value]);
'UTCTime' ->
- call(Erules, encode_VisibleString, [{asis,Constraint},Value]);
+ call(Erules, encode_VisibleString, [{asis,SizeConstr},
+ {asis,Pa},Value]);
'GeneralizedTime' ->
- call(Erules, encode_VisibleString, [{asis,Constraint},Value]);
+ call(Erules, encode_VisibleString, [{asis,SizeConstr},
+ {asis,Pa},Value]);
'GraphicString' ->
call(Erules, encode_GraphicString, [{asis,Constraint},Value]);
'VisibleString' ->
- call(Erules, encode_VisibleString, [{asis,Constraint},Value]);
+ call(Erules, encode_VisibleString, [{asis,SizeConstr},
+ {asis,Pa},Value]);
'GeneralString' ->
call(Erules, encode_GeneralString, [{asis,Constraint},Value]);
'PrintableString' ->
- call(Erules, encode_PrintableString, [{asis,Constraint},Value]);
+ call(Erules, encode_PrintableString, [{asis,SizeConstr},
+ {asis,Pa},Value]);
'IA5String' ->
- call(Erules, encode_IA5String, [{asis,Constraint},Value]);
+ call(Erules, encode_IA5String, [{asis,SizeConstr},
+ {asis,Pa},Value]);
'BMPString' ->
- call(Erules, encode_BMPString, [{asis,Constraint},Value]);
+ call(Erules, encode_BMPString, [{asis,SizeConstr},
+ {asis,Pa},Value]);
'UniversalString' ->
- call(Erules, encode_UniversalString, [{asis,Constraint},Value]);
+ call(Erules, encode_UniversalString, [{asis,SizeConstr},
+ {asis,Pa},Value]);
'UTF8String' ->
call(Erules, encode_UTF8String, [Value]);
- 'ANY' ->
- call(Erules, encode_open_type, [Value]);
'ASN1_OPEN_TYPE' ->
NewValue = case Constraint of
[#'Externaltypereference'{type=Tname}] ->
@@ -215,18 +204,11 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
io_lib:format(
"complete(enc_~s(~s))",
[Tname,Value]);
- _ -> Value
+ _ ->
+ io_lib:format("iolist_to_binary(~s)",
+ [Value])
end,
- call(Erules, encode_open_type, [NewValue]);
- #'ObjectClassFieldType'{} ->
- case asn1ct_gen:get_inner(D#type.def) of
- {fixedtypevaluefield,_,InnerType} ->
- gen_encode_prim(Erules,InnerType,DoTag,Value);
- T -> %% 'ASN1_OPEN_TYPE'
- gen_encode_prim(Erules,D#type{def=T},DoTag,Value)
- end;
- XX ->
- exit({asn1_error,nyi,XX})
+ call(Erules, encode_open_type, [NewValue])
end.
emit_enc_real(Erules, Real) ->
@@ -271,16 +253,6 @@ enc_ext_and_val(uper, E, F, Args) ->
<<E:1,(apply(asn1ct_eval_uper, F, Args))/bitstring>>.
-get_constraint([{Key,V}], Key) ->
- V;
-get_constraint([], _) ->
- no;
-get_constraint(C, Key) ->
- case lists:keyfind(Key, 1, C) of
- false -> no;
- {Key,V} -> V
- end.
-
%% Object code generating for encoding and decoding
%% ------------------------------------------------
@@ -301,17 +273,16 @@ gen_obj_code(Erules,_Module,Obj) when is_record(Obj,typedef) ->
gen_encode_constr_type(Erules,EncConstructed),
emit(nl),
DecConstructed =
- gen_decode_objectfields(ClassName,get_class_fields(Class),
- ObjName,Fields,[]),
+ gen_decode_objectfields(Erules, ClassName, get_class_fields(Class),
+ ObjName, Fields, []),
emit(nl),
gen_decode_constr_type(Erules,DecConstructed),
- emit(nl);
-gen_obj_code(_,_,Obj) when is_record(Obj,pobjectdef) ->
- ok.
+ emit(nl).
-gen_encode_objectfields(Erule,ClassName,[{typefield,Name,OptOrMand}|Rest],
- ObjName,ObjectFields,ConstrAcc) ->
+gen_encode_objectfields(Erule, ClassName,
+ [{typefield,Name,OptOrMand}|Rest],
+ ObjName, ObjectFields, ConstrAcc) ->
EmitFuncClause =
fun(V) ->
emit(["'enc_",ObjName,"'(",{asis,Name},
@@ -329,18 +300,24 @@ gen_encode_objectfields(Erule,ClassName,[{typefield,Name,OptOrMand}|Rest],
case Erule of
uper ->
emit(" Val");
- _ ->
- emit(" [{octets,Val}]")
+ per ->
+ emit([" if",nl,
+ " is_list(Val) ->",nl,
+ " NewVal = list_to_binary(Val),",nl,
+ " [20,byte_size(NewVal),NewVal];",nl,
+ " is_binary(Val) ->",nl,
+ " [20,byte_size(Val),Val]",nl,
+ " end"])
end,
[];
{false,{'DEFAULT',DefaultType}} ->
EmitFuncClause("Val"),
- gen_encode_default_call(ClassName,Name,DefaultType);
+ gen_encode_default_call(Erule, ClassName, Name, DefaultType);
{{Name,TypeSpec},_} ->
%% A specified field owerwrites any 'DEFAULT' or
%% 'OPTIONAL' field in the class
EmitFuncClause("Val"),
- gen_encode_field_call(ObjName,Name,TypeSpec)
+ gen_encode_field_call(Erule, ObjName, Name, TypeSpec)
end,
case more_genfields(Rest) of
true ->
@@ -416,7 +393,7 @@ gen_encode_constr_type(Erules,[TypeDef|Rest]) when is_record(TypeDef,typedef) ->
gen_encode_constr_type(_,[]) ->
ok.
-gen_encode_field_call(_ObjName,_FieldName,
+gen_encode_field_call(_Erules, _ObjName, _FieldName,
#'Externaltypereference'{module=M,type=T}) ->
CurrentMod = get(currmod),
if
@@ -427,12 +404,11 @@ gen_encode_field_call(_ObjName,_FieldName,
emit({" '",M,"':'enc_",T,"'(Val)"}),
[]
end;
-gen_encode_field_call(ObjName,FieldName,Type) ->
+gen_encode_field_call(Erules, ObjName, FieldName, Type) ->
Def = Type#typedef.typespec,
case Type#typedef.name of
{primitive,bif} ->
- gen_encode_prim(uper,Def,"false",
- "Val"),
+ gen_encode_prim(Erules, Def, "Val"),
[];
{constructed,bif} ->
emit({" 'enc_",ObjName,'_',FieldName,
@@ -448,7 +424,7 @@ gen_encode_field_call(ObjName,FieldName,Type) ->
[]
end.
-gen_encode_default_call(ClassName,FieldName,Type) ->
+gen_encode_default_call(Erules, ClassName, FieldName, Type) ->
CurrentMod = get(currmod),
InnerType = asn1ct_gen:get_inner(Type#type.def),
case asn1ct_gen:type(InnerType) of
@@ -459,7 +435,7 @@ gen_encode_default_call(ClassName,FieldName,Type) ->
[#typedef{name=[FieldName,ClassName],
typespec=Type}];
{primitive,bif} ->
- gen_encode_prim(per,Type,"false","Val"),
+ gen_encode_prim(Erules, Type, "Val"),
[];
#'Externaltypereference'{module=CurrentMod,type=Etype} ->
emit([" 'enc_",Etype,"'(Val)",nl]),
@@ -470,8 +446,9 @@ gen_encode_default_call(ClassName,FieldName,Type) ->
end.
-gen_decode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest],
- ObjName,ObjectFields,ConstrAcc) ->
+gen_decode_objectfields(Erules, ClassName,
+ [{typefield,Name,OptOrMand}|Rest],
+ ObjName, ObjectFields, ConstrAcc) ->
EmitFuncClause =
fun(Bytes) ->
emit(["'dec_",ObjName,"'(",{asis,Name},",",Bytes,
@@ -488,12 +465,13 @@ gen_decode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest],
[];
{false,{'DEFAULT',DefaultType}} ->
EmitFuncClause("Bytes"),
- gen_decode_default_call(ClassName,Name,"Bytes",DefaultType);
+ gen_decode_default_call(Erules, ClassName, Name, "Bytes",
+ DefaultType);
{{Name,TypeSpec},_} ->
%% A specified field owerwrites any 'DEFAULT' or
%% 'OPTIONAL' field in the class
EmitFuncClause("Bytes"),
- gen_decode_field_call(ObjName,Name,"Bytes",TypeSpec)
+ gen_decode_field_call(Erules, ObjName, Name, "Bytes", TypeSpec)
end,
case more_genfields(Rest) of
true ->
@@ -501,9 +479,11 @@ gen_decode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest],
false ->
emit([".",nl])
end,
- gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,MaybeConstr++ConstrAcc);
-gen_decode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest],
- ObjName,ObjectFields,ConstrAcc) ->
+ gen_decode_objectfields(Erules, ClassName, Rest, ObjName,
+ ObjectFields, MaybeConstr++ConstrAcc);
+gen_decode_objectfields(Erules, ClassName,
+ [{objectfield,Name,_,_,OptOrMand}|Rest],
+ ObjName, ObjectFields, ConstrAcc) ->
CurrentMod = get(currmod),
EmitFuncClause =
fun(Attrs) ->
@@ -546,30 +526,25 @@ gen_decode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest],
false ->
emit([".",nl])
end,
- gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,ConstrAcc);
-gen_decode_objectfields(CN,[_C|Cs],O,OF,CAcc) ->
- gen_decode_objectfields(CN,Cs,O,OF,CAcc);
-gen_decode_objectfields(_,[],_,_,CAcc) ->
+ gen_decode_objectfields(Erules, ClassName, Rest, ObjName,
+ ObjectFields, ConstrAcc);
+gen_decode_objectfields(Erules, CN, [_C|Cs], O, OF, CAcc) ->
+ gen_decode_objectfields(Erules, CN, Cs, O, OF, CAcc);
+gen_decode_objectfields(_, _, [], _, _, CAcc) ->
CAcc.
-gen_decode_field_call(_ObjName,_FieldName,Bytes,
- #'Externaltypereference'{module=M,type=T}) ->
- CurrentMod = get(currmod),
- if
- M == CurrentMod ->
- emit([" 'dec_",T,"'(",Bytes,", telltype)"]),
- [];
- true ->
- emit([" '",M,"':'dec_",T,"'(",Bytes,", telltype)"]),
- []
- end;
-gen_decode_field_call(ObjName,FieldName,Bytes,Type) ->
+gen_decode_field_call(_Erules, _ObjName, _FieldName, Bytes,
+ #'Externaltypereference'{}=Etype) ->
+ emit(" "),
+ gen_dec_external(Etype, Bytes),
+ [];
+gen_decode_field_call(Erules, ObjName, FieldName, Bytes, Type) ->
Def = Type#typedef.typespec,
case Type#typedef.name of
{primitive,bif} ->
- gen_dec_prim(uper, Def, Bytes),
+ gen_dec_prim(Erules, Def, Bytes),
[];
{constructed,bif} ->
emit({" 'dec_",ObjName,'_',FieldName,
@@ -585,8 +560,7 @@ gen_decode_field_call(ObjName,FieldName,Bytes,Type) ->
[]
end.
-gen_decode_default_call(ClassName,FieldName,Bytes,Type) ->
- CurrentMod = get(currmod),
+gen_decode_default_call(Erules, ClassName, FieldName, Bytes, Type) ->
InnerType = asn1ct_gen:get_inner(Type#type.def),
case asn1ct_gen:type(InnerType) of
{constructed,bif} ->
@@ -595,13 +569,10 @@ gen_decode_default_call(ClassName,FieldName,Bytes,Type) ->
[#typedef{name=[FieldName,ClassName],
typespec=Type}];
{primitive,bif} ->
- gen_dec_prim(per,Type,Bytes),
+ gen_dec_prim(Erules, Type, Bytes),
[];
- #'Externaltypereference'{module=CurrentMod,type=Etype} ->
- emit([" 'dec_",Etype,"'(",Bytes,", telltype)",nl]),
- [];
- #'Externaltypereference'{module=Emod,type=Etype} ->
- emit([" '",Emod,"':'dec_",Etype,"'(",Bytes,", telltype)",nl]),
+ #'Externaltypereference'{}=Etype ->
+ asn1ct_gen_per:gen_dec_external(Etype, Bytes),
[]
end.
@@ -657,7 +628,7 @@ gen_objset_code(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassDef)->
ClassFields = (ClassDef#classdef.typespec)#objectclass.fields,
InternalFuncs=
gen_objset_enc(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassFields,1,[]),
- gen_objset_dec(ObjSetName,UniqueFName,Set,ClassName,ClassFields,1),
+ gen_objset_dec(Erules, ObjSetName,UniqueFName,Set,ClassName,ClassFields,1),
gen_internal_funcs(Erules,InternalFuncs).
%% gen_objset_enc iterates over the objects of the object set
@@ -665,67 +636,56 @@ gen_objset_enc(_,_,{unique,undefined},_,_,_,_,_) ->
%% There is no unique field in the class of this object set
%% don't bother about the constraint
[];
-gen_objset_enc(Erule,ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest],
- ClName,ClFields,NthObj,Acc)->
- emit({"'getenc_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val},
- ") ->",nl}),
+gen_objset_enc(Erule, ObjSetName, UniqueName, [{ObjName,Val,Fields}|T],
+ ClName, ClFields, NthObj, Acc)->
+ emit(["'getenc_",ObjSetName,"'(",{asis,UniqueName},",",{asis,Val},
+ ") ->",nl]),
CurrMod = get(currmod),
{InternalFunc,NewNthObj}=
case ObjName of
{no_mod,no_name} ->
- gen_inlined_enc_funs(Erule,Fields,ClFields,ObjSName,NthObj);
+ gen_inlined_enc_funs(Erule, Fields, ClFields,
+ ObjSetName, NthObj);
{CurrMod,Name} ->
emit({" fun 'enc_",Name,"'/3"}),
{[],0};
{ModName,Name} ->
emit_ext_encfun(ModName,Name),
-% emit([" {'",ModName,"', 'enc_",Name,"'}"]),
{[],0};
_Other ->
emit({" fun 'enc_",ObjName,"'/3"}),
{[],0}
end,
emit({";",nl}),
- gen_objset_enc(Erule,ObjSName,UniqueName,[T|Rest],ClName,ClFields,
- NewNthObj,InternalFunc ++ Acc);
-gen_objset_enc(Erule,ObjSetName,UniqueName,
- [{ObjName,Val,Fields}],_ClName,ClFields,NthObj,Acc) ->
-
- emit({"'getenc_",ObjSetName,"'(",{asis,UniqueName},",",
- {asis,Val},") ->",nl}),
- CurrMod = get(currmod),
- {InternalFunc,_}=
- case ObjName of
- {no_mod,no_name} ->
- gen_inlined_enc_funs(Erule,Fields,ClFields,ObjSetName,NthObj);
- {CurrMod,Name} ->
- emit({" fun 'enc_",Name,"'/3"}),
- {[],NthObj};
- {ModName,Name} ->
- emit_ext_encfun(ModName,Name),
-% emit([" {'",ModName,"', 'enc_",Name,"'}"]),
- {[],NthObj};
- _Other ->
- emit({" fun 'enc_",ObjName,"'/3"}),
- {[],NthObj}
- end,
- emit([";",nl]),
- emit_default_getenc(ObjSetName,UniqueName),
- emit({".",nl,nl}),
- InternalFunc++Acc;
-gen_objset_enc(Erule,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,
- _ClFields,_NthObj,Acc) ->
+ gen_objset_enc(Erule, ObjSetName, UniqueName, T, ClName, ClFields,
+ NewNthObj, InternalFunc ++ Acc);
+gen_objset_enc(uper, ObjSetName, _UniqueName, ['EXTENSIONMARK'],
+ _ClName, _ClFields, _NthObj, Acc) ->
emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}),
emit({indent(3),"fun(_, Val, _) ->",nl}),
- case Erule of
- uper ->
- emit([indent(6),"Val",nl]);
- _ ->
- emit([indent(6),"[{octets,Val}]",nl])
- end,
- emit({indent(3),"end.",nl,nl}),
+ emit([indent(6),"Val",nl,
+ indent(3),"end.",nl,nl]),
+ Acc;
+gen_objset_enc(per, ObjSetName, _UniqueName, ['EXTENSIONMARK'],
+ _ClName, _ClFields, _NthObj, Acc) ->
+ emit(["'getenc_",ObjSetName,"'(_, _) ->",nl,
+ indent(3),"fun(_, Val, _) ->",nl,
+ indent(6),"BinVal = if",nl,
+ indent(9),"is_list(Val) -> list_to_binary(Val);",nl,
+ indent(9),"true -> Val",nl,
+ indent(6),"end,",nl,
+ indent(6),"Size = byte_size(BinVal),",nl,
+ indent(6),"if",nl,
+ indent(9),"Size < 256 ->",nl,
+ indent(12),"[20,Size,BinVal];",nl,
+ indent(9),"true ->",nl,
+ indent(12),"[21,<<Size:16>>,Val]",nl,
+ indent(6),"end",nl,
+ indent(3),"end.",nl,nl]),
Acc;
-gen_objset_enc(_,_,_,[],_,_,_,Acc) ->
+gen_objset_enc(_, ObjSetName, UniqueName, [], _, _, _, Acc) ->
+ emit_default_getenc(ObjSetName, UniqueName),
+ emit([".",nl,nl]),
Acc.
emit_ext_encfun(ModuleName,Name) ->
@@ -740,97 +700,70 @@ emit_default_getenc(ObjSetName,UniqueName) ->
%% gen_inlined_enc_funs for each object iterates over all fields of a
%% class, and for each typefield it checks if the object has that
%% field and emits the proper code.
-gen_inlined_enc_funs(Erule,Fields,[{typefield,Name,_}|Rest],ObjSetName,NthObj) ->
- CurrMod = get(currmod),
- InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]),
- case lists:keysearch(Name,1,Fields) of
- {value,{_,Type}} when is_record(Type,type) ->
- emit({indent(3),"fun(Type, Val, _) ->",nl,
- indent(6),"case Type of",nl}),
- {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName),
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj+N,Ret);
- {value,{_,Type}} when is_record(Type,typedef) ->
- emit({indent(3),"fun(Type, Val, _) ->",nl,
- indent(6),"case Type of",nl}),
- emit({indent(9),{asis,Name}," ->",nl}),
- {Ret,N} = emit_inner_of_fun(Type,InternalDefFunName),
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj+N,Ret);
- {value,{_,#'Externaltypereference'{module=CurrMod,type=T}}} ->
- emit({indent(3),"fun(Type, Val, _) ->",nl,
- indent(6),"case Type of",nl}),
- emit({indent(9),{asis,Name}," ->",nl}),
- emit([indent(12),"'enc_",T,"'(Val)"]),
-% {Ret,N} = emit_inner_of_fun(TDef,InternalDefFunName),
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,[]);
- {value,{_,#'Externaltypereference'{module=M,type=T}}} ->
- emit({indent(3),"fun(Type, Val, _) ->",nl,
- indent(6),"case Type of",nl}),
- emit({indent(9),{asis,Name}," ->",nl}),
- emit([indent(12),"'",M,"'",":'enc_",T,"'(Val)"]),
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,[]);
- false when Erule =:= uper ->
- emit([indent(3),"fun(Type,Val,_) ->",nl,
- indent(6),"case Type of",nl,
- indent(9),{asis,Name}," -> Val",nl]),
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,[]);
- false ->
- emit([indent(3),"fun(Type,Val,_) ->",nl,
- indent(6),"case Type of",nl,
- indent(9),{asis,Name}," -> [{octets,Val}]",nl]),
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,[])
- end;
+gen_inlined_enc_funs(Erule, Fields, [{typefield,_,_}|_]=T,
+ ObjSetName, NthObj) ->
+ emit([indent(3),"fun(Type, Val, _) ->",nl,
+ indent(6),"case Type of",nl]),
+ gen_inlined_enc_funs1(Erule, Fields, T, ObjSetName, [], NthObj, []);
gen_inlined_enc_funs(Erule,Fields,[_H|Rest],ObjSetName,NthObj) ->
gen_inlined_enc_funs(Erule,Fields,Rest,ObjSetName,NthObj);
gen_inlined_enc_funs(_,_,[],_,NthObj) ->
{[],NthObj}.
-gen_inlined_enc_funs1(Erule,Fields,[{typefield,Name,_}|Rest],ObjSetName,
- NthObj,Acc) ->
+gen_inlined_enc_funs1(Erule, Fields, [{typefield,Name,_}|Rest], ObjSetName,
+ Sep0, NthObj, Acc0) ->
+ emit(Sep0),
+ Sep = [";",nl],
CurrentMod = get(currmod),
InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]),
- {Acc2,NAdd}=
- case lists:keysearch(Name,1,Fields) of
- {value,{_,Type}} when is_record(Type,type) ->
- emit({";",nl}),
- {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName),
- {Ret++Acc,N};
- {value,{_,Type}} when is_record(Type,typedef) ->
- emit({";",nl,indent(9),{asis,Name}," ->",nl}),
- {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName),
- {Ret++Acc,N};
- {value,{_,#'Externaltypereference'{module=CurrentMod,type=T}}} ->
- emit({";",nl,indent(9),{asis,Name}," ->",nl}),
- emit([indent(12),"'enc_",T,"'(Val)"]),
- {Acc,0};
- {value,{_,#'Externaltypereference'{module=M,type=T}}} ->
- emit({";",nl,indent(9),{asis,Name}," ->",nl}),
- emit([indent(12),"'",M,"'",":'enc_",T,"'(Val)"]),
- {Acc,0};
+ {Acc,NAdd} =
+ case lists:keyfind(Name, 1, Fields) of
+ {_,#type{}=Type} ->
+ {Ret,N} = emit_inner_of_fun(Erule, Type, InternalDefFunName),
+ {Ret++Acc0,N};
+ {_,#typedef{}=Type} ->
+ emit([indent(9),{asis,Name}," ->",nl]),
+ {Ret,N} = emit_inner_of_fun(Erule, Type, InternalDefFunName),
+ {Ret++Acc0,N};
+ {_,#'Externaltypereference'{module=CurrentMod,type=T}} ->
+ emit([indent(9),{asis,Name}," ->",nl,
+ indent(12),"'enc_",T,"'(Val)"]),
+ {Acc0,0};
+ {_,#'Externaltypereference'{module=M,type=T}} ->
+ emit([indent(9),{asis,Name}," ->",nl,
+ indent(12),"'",M,"'",":'enc_",T,"'(Val)"]),
+ {Acc0,0};
false when Erule =:= uper ->
- emit([";",nl,
- indent(9),{asis,Name}," -> ",nl,
- "Val",nl]),
- {Acc,0};
- false ->
- emit([";",nl,
- indent(9),{asis,Name}," -> ",nl,
- "[{octets,Val}]",nl]),
- {Acc,0}
+ emit([indent(9),{asis,Name}," ->",nl,
+ indent(12),"Val",nl]),
+ {Acc0,0};
+ false when Erule =:= per ->
+ emit([indent(9),{asis,Name}," ->",nl,
+ indent(12),"Size = case Val of",nl,
+ indent(15),"B when is_binary(B) -> size(B);",nl,
+ indent(15),"_ -> length(Val)",nl,
+ indent(12),"end,",nl,
+ indent(12),"if",nl,
+ indent(15),"Size < 256 -> [20,Size,Val];",nl,
+ indent(15),"true -> [21,<<Size:16>>,Val]",nl,
+ indent(12),"end"]),
+ {Acc0,0}
end,
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj+NAdd,Acc2);
-gen_inlined_enc_funs1(Erule,Fields,[_H|Rest],ObjSetName,NthObj,Acc)->
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,Acc);
-gen_inlined_enc_funs1(_,_,[],_,NthObj,Acc) ->
- emit({nl,indent(6),"end",nl}),
- emit({indent(3),"end"}),
+ gen_inlined_enc_funs1(Erule, Fields, Rest, ObjSetName, Sep,
+ NthObj+NAdd, Acc);
+gen_inlined_enc_funs1(Erule, Fields, [_|T], ObjSetName, Sep, NthObj, Acc)->
+ gen_inlined_enc_funs1(Erule, Fields, T, ObjSetName, Sep, NthObj, Acc);
+gen_inlined_enc_funs1(_, _, [], _, _, NthObj, Acc) ->
+ emit([nl,indent(6),"end",nl,
+ indent(3),"end"]),
{Acc,NthObj}.
-emit_inner_of_fun(TDef=#typedef{name={ExtMod,Name},typespec=Type},
+emit_inner_of_fun(Erule, #typedef{name={ExtMod,Name},typespec=Type}=TDef,
InternalDefFunName) ->
case {ExtMod,Name} of
{primitive,bif} ->
emit(indent(12)),
- gen_encode_prim(uper,Type,dotag,"Val"),
+ gen_encode_prim(Erule, Type, "Val"),
{[],0};
{constructed,bif} ->
emit([indent(12),"'enc_",
@@ -840,18 +773,15 @@ emit_inner_of_fun(TDef=#typedef{name={ExtMod,Name},typespec=Type},
emit({indent(12),"'",ExtMod,"':'enc_",Name,"'(Val)"}),
{[],0}
end;
-emit_inner_of_fun(#typedef{name=Name},_) ->
+emit_inner_of_fun(_Erule, #typedef{name=Name}, _) ->
emit({indent(12),"'enc_",Name,"'(Val)"}),
{[],0};
-emit_inner_of_fun(Type,_) when is_record(Type,type) ->
+emit_inner_of_fun(Erule, #type{}=Type, _) ->
CurrMod = get(currmod),
case Type#type.def of
Def when is_atom(Def) ->
emit({indent(9),Def," ->",nl,indent(12)}),
- gen_encode_prim(erules,Type,dotag,"Val");
- TRef when is_record(TRef,typereference) ->
- T = TRef#typereference.val,
- emit({indent(9),T," ->",nl,indent(12),"'enc_",T,"'(Val)"});
+ gen_encode_prim(Erule, Type, "Val");
#'Externaltypereference'{module=CurrMod,type=T} ->
emit({indent(9),T," ->",nl,indent(12),"'enc_",T,"'(Val)"});
#'Externaltypereference'{module=ExtMod,type=T} ->
@@ -864,62 +794,42 @@ indent(N) ->
lists:duplicate(N,32). % 32 = space
-gen_objset_dec(_,{unique,undefined},_,_,_,_) ->
+gen_objset_dec(_, _, {unique,undefined}, _, _, _, _) ->
%% There is no unique field in the class of this object set
%% don't bother about the constraint
ok;
-gen_objset_dec(ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest],ClName,
- ClFields,NthObj)->
-
+gen_objset_dec(Erule, ObjSName, UniqueName, [{ObjName,Val,Fields}|T], ClName,
+ ClFields, NthObj)->
emit({"'getdec_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val},
") ->",nl}),
CurrMod = get(currmod),
NewNthObj=
case ObjName of
{no_mod,no_name} ->
- gen_inlined_dec_funs(Fields,ClFields,ObjSName,NthObj);
+ gen_inlined_dec_funs(Erule, Fields, ClFields,
+ ObjSName, NthObj);
{CurrMod,Name} ->
emit([" fun 'dec_",Name,"'/4"]),
NthObj;
{ModName,Name} ->
emit_ext_decfun(ModName,Name),
-% emit([" {'",ModName,"', 'dec_",Name,"'}"]),
NthObj;
_Other ->
emit({" fun 'dec_",ObjName,"'/4"}),
NthObj
end,
emit({";",nl}),
- gen_objset_dec(ObjSName,UniqueName,[T|Rest],ClName,ClFields,NewNthObj);
-gen_objset_dec(ObjSetName,UniqueName,[{ObjName,Val,Fields}],_ClName,
- ClFields,NthObj) ->
-
- emit({"'getdec_",ObjSetName,"'(",{asis,UniqueName},",",{asis,Val},
- ") ->",nl}),
- CurrMod=get(currmod),
- case ObjName of
- {no_mod,no_name} ->
- gen_inlined_dec_funs(Fields,ClFields,ObjSetName,NthObj);
- {CurrMod,Name} ->
- emit([" fun 'dec_",Name,"'/4"]);
- {ModName,Name} ->
- emit_ext_decfun(ModName,Name);
-% emit([" {'",ModName,"', 'dec_",Name,"'}"]);
- _Other ->
- emit({" fun 'dec_",ObjName,"'/4"})
- end,
- emit([";",nl]),
- emit_default_getdec(ObjSetName,UniqueName),
- emit({".",nl,nl}),
- ok;
-gen_objset_dec(ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,_ClFields,
- _NthObj) ->
+ gen_objset_dec(Erule, ObjSName, UniqueName, T, ClName, ClFields, NewNthObj);
+gen_objset_dec(_Erule, ObjSetName, _UniqueName, ['EXTENSIONMARK'],
+ _ClName, _ClFields, _NthObj) ->
emit({"'getdec_",ObjSetName,"'(_, _) ->",nl}),
emit({indent(3),"fun(Attr1, Bytes, _,_) ->",nl}),
emit({indent(6),"{Bytes,Attr1}",nl}),
emit({indent(3),"end.",nl,nl}),
ok;
-gen_objset_dec(_,_,[],_,_,_) ->
+gen_objset_dec(_Erule, ObjSetName, UniqueName, [], _, _, _) ->
+ emit_default_getdec(ObjSetName, UniqueName),
+ emit([".",nl,nl]),
ok.
emit_ext_decfun(ModuleName,Name) ->
@@ -931,49 +841,46 @@ emit_default_getdec(ObjSetName,UniqueName) ->
emit([indent(2), "fun(C,V,_,_) -> exit({{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},",ErrV}}) end"]).
-gen_inlined_dec_funs(Fields, List, ObjSetName, NthObj0) ->
+gen_inlined_dec_funs(Erule, Fields, List, ObjSetName, NthObj0) ->
emit([indent(3),"fun(Type, Val, _, _) ->",nl,
indent(6),"case Type of",nl]),
- NthObj = gen_inlined_dec_funs1(Fields, List, ObjSetName, "", NthObj0),
+ NthObj = gen_inlined_dec_funs1(Erule, Fields, List,
+ ObjSetName, "", NthObj0),
emit([nl,indent(6),"end",nl,
indent(3),"end"]),
NthObj.
-gen_inlined_dec_funs1(Fields, [{typefield,Name,_}|Rest],
+gen_inlined_dec_funs1(Erule, Fields, [{typefield,Name,_}|Rest],
ObjSetName, Sep0, NthObj) ->
- CurrentMod = get(currmod),
InternalDefFunName = [NthObj,Name,ObjSetName],
emit(Sep0),
Sep = [";",nl],
N = case lists:keyfind(Name, 1, Fields) of
{_,#type{}=Type} ->
- emit_inner_of_decfun(Type, InternalDefFunName);
+ emit_inner_of_decfun(Erule, Type, InternalDefFunName);
{_,#typedef{}=Type} ->
emit([indent(9),{asis,Name}," ->",nl]),
- emit_inner_of_decfun(Type, InternalDefFunName);
- {_,#'Externaltypereference'{module=CurrentMod,type=T}} ->
+ emit_inner_of_decfun(Erule, Type, InternalDefFunName);
+ {_,#'Externaltypereference'{}=Etype} ->
emit([indent(9),{asis,Name}," ->",nl,
- indent(12),"'dec_",T,"'(Val,telltype)"]),
- 0;
- {_,#'Externaltypereference'{module=M,type=T}} ->
- emit([indent(9),{asis,Name}," ->",nl,
- indent(12),"'",M,"':'dec_",T,"'(Val,telltype)"]),
+ indent(12)]),
+ gen_dec_external(Etype, "Val"),
0;
false ->
emit([indent(9),{asis,Name}," -> {Val,Type}"]),
0
end,
- gen_inlined_dec_funs1(Fields, Rest, ObjSetName, Sep, NthObj+N);
-gen_inlined_dec_funs1(Fields, [_|Rest], ObjSetName, Sep, NthObj) ->
- gen_inlined_dec_funs1(Fields, Rest, ObjSetName, Sep, NthObj);
-gen_inlined_dec_funs1(_, [], _, _, NthObj) -> NthObj.
+ gen_inlined_dec_funs1(Erule, Fields, Rest, ObjSetName, Sep, NthObj+N);
+gen_inlined_dec_funs1(Erule, Fields, [_|Rest], ObjSetName, Sep, NthObj) ->
+ gen_inlined_dec_funs1(Erule, Fields, Rest, ObjSetName, Sep, NthObj);
+gen_inlined_dec_funs1(_, _, [], _, _, NthObj) -> NthObj.
-emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type},
+emit_inner_of_decfun(Erule, #typedef{name={ExtName,Name},typespec=Type},
InternalDefFunName) ->
case {ExtName,Name} of
{primitive,bif} ->
emit(indent(12)),
- gen_dec_prim(uper, Type, "Val"),
+ gen_dec_prim(Erule, Type, "Val"),
0;
{constructed,bif} ->
emit({indent(12),"'dec_",
@@ -983,18 +890,15 @@ emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type},
emit({indent(12),"'",ExtName,"':'dec_",Name,"'(Val, telltype)"}),
0
end;
-emit_inner_of_decfun(#typedef{name=Name},_) ->
+emit_inner_of_decfun(_Erule, #typedef{name=Name}, _) ->
emit({indent(12),"'dec_",Name,"'(Val, telltype)"}),
0;
-emit_inner_of_decfun(Type,_) when is_record(Type,type) ->
+emit_inner_of_decfun(Erule, #type{}=Type, _) ->
CurrMod = get(currmod),
case Type#type.def of
Def when is_atom(Def) ->
emit({indent(9),Def," ->",nl,indent(12)}),
- gen_dec_prim(uper, Type, "Val");
- TRef when is_record(TRef,typereference) ->
- T = TRef#typereference.val,
- emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"});
+ gen_dec_prim(Erule, Type, "Val");
#'Externaltypereference'{module=CurrMod,type=T} ->
emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"});
#'Externaltypereference'{module=ExtMod,type=T} ->
@@ -1017,7 +921,6 @@ gen_internal_funcs(Erules,[TypeDef|Rest]) ->
%% DECODING *****************************
%%***************************************
-
gen_decode(Erules,Type) when is_record(Type,typedef) ->
D = Type,
emit({nl,nl}),
@@ -1054,7 +957,6 @@ dbdec(Type) ->
demit({"io:format(\"decoding: ",{asis,Type},"~w~n\",[Bytes]),",nl}).
gen_decode_user(Erules,D) when is_record(D,typedef) ->
- CurrMod = get(currmod),
Typename = [D#typedef.name],
Def = D#typedef.typespec,
InnerType = asn1ct_gen:get_inner(Def#type.def),
@@ -1067,17 +969,21 @@ gen_decode_user(Erules,D) when is_record(D,typedef) ->
emit({".",nl,nl});
{constructed,bif} ->
asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,D);
- #typereference{val=Dname} ->
- emit({"'dec_",Dname,"'(Bytes,telltype)"}),
- emit({".",nl,nl});
- #'Externaltypereference'{module=CurrMod,type=Etype} ->
- emit({"'dec_",Etype,"'(Bytes,telltype).",nl,nl});
- #'Externaltypereference'{module=Emod,type=Etype} ->
- emit({"'",Emod,"':'dec_",Etype,"'(Bytes,telltype).",nl,nl});
+ #'Externaltypereference'{}=Etype ->
+ gen_dec_external(Etype, "Bytes"),
+ emit([".",nl,nl]);
Other ->
exit({error,{asn1,{unknown,Other}}})
end.
+gen_dec_external(Ext, BytesVar) ->
+ CurrMod = get(currmod),
+ #'Externaltypereference'{module=Mod,type=Type} = Ext,
+ emit([case CurrMod of
+ Mod -> [];
+ _ -> ["'",Mod,"':"]
+ end,"'dec_",Type,"'(",BytesVar,",telltype)"]).
+
gen_dec_imm(Erule, #type{def=Name,constraint=C}) ->
Aligned = case Erule of
uper -> false;
@@ -1087,10 +993,8 @@ gen_dec_imm(Erule, #type{def=Name,constraint=C}) ->
gen_dec_imm_1('ASN1_OPEN_TYPE', Constraint, Aligned) ->
imm_decode_open_type(Constraint, Aligned);
-gen_dec_imm_1('ANY', _Constraint, Aligned) ->
- imm_decode_open_type([], Aligned);
gen_dec_imm_1({'BIT STRING',NNL}, Constr0, Aligned) ->
- Constr = get_constraint(Constr0, 'SizeConstraint'),
+ Constr = asn1ct_imm:effective_constraint(bitstring, Constr0),
Imm = asn1ct_imm:per_dec_raw_bitstring(Constr, Aligned),
case NNL of
[] ->
@@ -1143,7 +1047,7 @@ gen_dec_imm_1('UTCTime', Constraint, Aligned) ->
gen_dec_imm_1('GeneralizedTime', Constraint, Aligned) ->
gen_dec_k_m_string('VisibleString', Constraint, Aligned);
gen_dec_imm_1('OCTET STRING', Constraint, Aligned) ->
- SzConstr = get_constraint(Constraint, 'SizeConstraint'),
+ SzConstr = asn1ct_imm:effective_constraint(bitstring, Constraint),
Imm = asn1ct_imm:per_dec_octet_string(SzConstr, Aligned),
{convert,binary_to_list,Imm};
gen_dec_imm_1('TeletexString', _Constraint, Aligned) ->
@@ -1173,14 +1077,7 @@ gen_dec_imm_1('RELATIVE-OID', _Constraint, Aligned) ->
gen_dec_imm_1('UTF8String', _Constraint, Aligned) ->
asn1ct_imm:per_dec_restricted_string(Aligned);
gen_dec_imm_1('REAL', _Constraint, Aligned) ->
- asn1ct_imm:per_dec_real(Aligned);
-gen_dec_imm_1(#'ObjectClassFieldType'{}=TypeName, _Constraint, Aligned) ->
- case asn1ct_gen:get_inner(TypeName) of
- {fixedtypevaluefield,_,#type{def=InnerType,constraint=C}} ->
- gen_dec_imm_1(InnerType, C, Aligned);
- #type{def=T,constraint=C} ->
- gen_dec_imm_1(T, C, Aligned)
- end.
+ asn1ct_imm:per_dec_real(Aligned).
gen_dec_bit_string(F, Imm) ->
D = fun(V, Buf) ->
diff --git a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl
index 81d8cdcae6..012d54e7a1 100644
--- a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl
+++ b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl
@@ -19,105 +19,16 @@
%%
-module(asn1ct_gen_per_rt2ct).
-%% Generate erlang module which handles (PER) encode and decode for
-%% all types in an ASN.1 module
+%% Handle encoding of primitives for aligned PER.
-include("asn1_records.hrl").
-%-compile(export_all).
--export([pgen/4,gen_dec_prim/3,gen_encode_prim/4]).
--export([gen_obj_code/3,gen_objectset_code/2]).
--export([gen_decode/2, gen_decode/3]).
--export([gen_encode/2, gen_encode/3]).
--export([extaddgroup2sequence/1]).
+-export([gen_encode_prim/3]).
-import(asn1ct_gen, [emit/1,demit/1]).
--import(asn1ct_gen_per, [is_already_generated/2,more_genfields/1,
- get_class_fields/1,get_object_field/2]).
-import(asn1ct_func, [call/3]).
-%% pgen(Erules, Module, TypeOrVal)
-%% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module
-%% .hrl file is only generated if necessary
-%% Erules = per | ber
-%% Module = atom()
-%% TypeOrVal = {TypeList,ValueList}
-%% TypeList = ValueList = [atom()]
-
-pgen(OutFile,Erules,Module,TypeOrVal) ->
- asn1ct_gen:pgen_module(OutFile,Erules,Module,TypeOrVal,[],true).
-
-
-%% Generate ENCODING ******************************
-%%****************************************x
-
-
-gen_encode(Erules,Type) when is_record(Type,typedef) ->
- gen_encode_user(Erules,Type).
-
-gen_encode(Erules,Typename,#'ComponentType'{name=Cname,typespec=Type}) ->
- NewTypename = [Cname|Typename],
- gen_encode(Erules,NewTypename,Type);
-
-gen_encode(Erules,Typename,Type) when is_record(Type,type) ->
- InnerType = asn1ct_gen:get_inner(Type#type.def),
- ObjFun =
- case lists:keysearch(objfun,1,Type#type.tablecinf) of
- {value,{_,_Name}} ->
- ", ObjFun";
- false ->
- ""
- end,
- case asn1ct_gen:type(InnerType) of
- {constructed,bif} ->
- emit({"'enc_",asn1ct_gen:list2name(Typename),"'(Val",ObjFun,
- ") ->",nl}),
- asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type);
- _ ->
- true
- end.
-
-
-gen_encode_user(Erules,D) when is_record(D,typedef) ->
- CurrMod = get(currmod),
- Typename = [D#typedef.name],
- Def = D#typedef.typespec,
- InnerType = asn1ct_gen:get_inner(Def#type.def),
- emit({"'enc_",asn1ct_gen:list2name(Typename),"'(Val) ->",nl}),
- case asn1ct_gen:type(InnerType) of
- {primitive,bif} ->
- gen_encode_prim(Erules,Def,"false"),
- emit({".",nl});
- 'ASN1_OPEN_TYPE' ->
- gen_encode_prim(Erules,Def#type{def='ASN1_OPEN_TYPE'},"false"),
- emit({".",nl});
- {constructed,bif} ->
- asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,D);
- #'Externaltypereference'{module=CurrMod,type=Etype} ->
- emit({"'enc_",Etype,"'(Val).",nl,nl});
- #'Externaltypereference'{module=Emod,type=Etype} ->
- emit({"'",Emod,"':'enc_",Etype,"'(Val).",nl,nl});
- #typereference{val=Ename} ->
- emit({"'enc_",Ename,"'(Val).",nl,nl});
- {notype,_} ->
- emit({"'enc_",InnerType,"'(Val).",nl,nl})
- end.
-
-
-gen_encode_prim(Erules,D,DoTag) ->
- Value = case asn1ct_name:active(val) of
- true ->
- asn1ct_gen:mk_var(asn1ct_name:curr(val));
- false ->
- "Val"
- end,
- gen_encode_prim(Erules,D,DoTag,Value).
-
-
-
-
-
-gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
+gen_encode_prim(Erules, #type{}=D, Value) ->
Constraint = D#type.constraint,
case D#type.def of
'INTEGER' ->
@@ -131,8 +42,6 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
emit([" %%INTEGER with effective constraint: ",
{asis,EffectiveConstr},nl]),
emit_enc_integer_NNL(Erules,EffectiveConstr,Value,NamedNumberList);
- {'ENUMERATED',_} ->
- asn1ct_gen_per:gen_encode_prim(Erules, D, DoTag, Value);
'REAL' ->
emit_enc_real(Erules, Value);
@@ -191,8 +100,6 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
emit_enc_known_multiplier_string('UniversalString',Constraint,Value);
'UTF8String' ->
call(Erules, encode_UTF8String, [Value]);
- 'ANY' ->
- call(Erules, encode_open_type, [Value]);
'ASN1_OPEN_TYPE' ->
NewValue = case Constraint of
[#'Externaltypereference'{type=Tname}] ->
@@ -204,18 +111,11 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) ->
io_lib:format(
"complete(enc_~s(~s))",
[Tname,Value]);
- _ -> Value
+ _ ->
+ io_lib:format("iolist_to_binary(~s)",
+ [Value])
end,
- call(Erules, encode_open_type, [NewValue]);
- #'ObjectClassFieldType'{} ->
- case asn1ct_gen:get_inner(D#type.def) of
- {fixedtypevaluefield,_,InnerType} ->
- gen_encode_prim(Erules,InnerType,DoTag,Value);
- T -> %% 'ASN1_OPEN_TYPE'
- gen_encode_prim(Erules,D#type{def=T},DoTag,Value)
- end;
- XX ->
- exit({asn1_error,nyi,XX})
+ call(Erules, encode_open_type, [NewValue])
end.
emit_enc_real(Erules, Real) ->
@@ -230,11 +130,7 @@ emit_enc_real(Erules, Real) ->
"end"]).
emit_enc_known_multiplier_string(StringType,C,Value) ->
- SizeC =
- case get_constraint(C,'SizeConstraint') of
- L when is_list(L) -> {lists:min(L),lists:max(L)};
- L -> L
- end,
+ SizeC = effective_constraint(bitstring, C),
PAlphabC = get_constraint(C,'PermittedAlphabet'),
case {StringType,PAlphabC} of
{'UniversalString',{_,_}} ->
@@ -359,7 +255,7 @@ charbits1(NumOfChars) ->
%% copied from run time module
emit_enc_octet_string(Erules, Constraint, Value) ->
- case get_constraint(Constraint,'SizeConstraint') of
+ case effective_constraint(bitstring, Constraint) of
0 ->
emit({" []"});
1 ->
@@ -408,7 +304,7 @@ emit_enc_octet_string(Erules, Constraint, Value) ->
" end"]);
C ->
call(Erules, encode_octet_string,
- [{asis,C},false,Value])
+ [{asis,C},Value])
end.
emit_enc_integer_case(Value) ->
@@ -563,825 +459,3 @@ no_bits(N) when N=<32 -> 5;
no_bits(N) when N=<64 -> 6;
no_bits(N) when N=<128 -> 7;
no_bits(N) when N=<255 -> 8.
-
-%% Object code generating for encoding and decoding
-%% ------------------------------------------------
-
-gen_obj_code(Erules,_Module,Obj) when is_record(Obj,typedef) ->
- ObjName = Obj#typedef.name,
- Def = Obj#typedef.typespec,
- #'Externaltypereference'{module=Mod,type=ClassName} =
- Def#'Object'.classname,
- Class = asn1_db:dbget(Mod,ClassName),
- {object,_,Fields} = Def#'Object'.def,
- emit({nl,nl,nl,"%%================================"}),
- emit({nl,"%% ",ObjName}),
- emit({nl,"%%================================",nl}),
- EncConstructed =
- gen_encode_objectfields(Erules,ClassName,get_class_fields(Class),
- ObjName,Fields,[]),
- emit(nl),
- gen_encode_constr_type(Erules,EncConstructed),
- emit(nl),
- DecConstructed =
- gen_decode_objectfields(ClassName,get_class_fields(Class),
- ObjName,Fields,[]),
- emit(nl),
- gen_decode_constr_type(Erules,DecConstructed),
- emit(nl);
-gen_obj_code(_Erules,_Module,Obj) when is_record(Obj,pobjectdef) ->
- ok.
-
-gen_encode_objectfields(Erules,ClassName,[{typefield,Name,OptOrMand}|Rest],
- ObjName,ObjectFields,ConstrAcc) ->
- EmitFuncClause =
- fun(V) ->
- emit(["'enc_",ObjName,"'(",{asis,Name},
- ",",V,",_RestPrimFieldName) ->",nl])
- end,
-
- MaybeConstr =
- case {get_object_field(Name,ObjectFields),OptOrMand} of
- {false,'MANDATORY'} -> %% this case is illegal
- exit({error,{asn1,{"missing mandatory field in object",
- ObjName}}});
- {false,'OPTIONAL'} ->
- EmitFuncClause("Val"),
- emit([" if",nl,
- " is_list(Val) ->",nl,
- " NewVal = list_to_binary(Val),",nl,
- " [20,byte_size(NewVal),NewVal];",nl,
- " is_binary(Val) ->",nl,
- " [20,byte_size(Val),Val]",nl,
- " end"]),
- [];
- {false,{'DEFAULT',DefaultType}} ->
- EmitFuncClause("Val"),
- gen_encode_default_call(Erules,ClassName,Name,DefaultType);
- {{Name,TypeSpec},_} ->
- %% A specified field owerwrites any 'DEFAULT' or
- %% 'OPTIONAL' field in the class
- EmitFuncClause("Val"),
- gen_encode_field_call(Erules,ObjName,Name,TypeSpec)
- end,
- case more_genfields(Rest) of
- true ->
- emit([";",nl]);
- false ->
- emit([".",nl])
- end,
- gen_encode_objectfields(Erules,ClassName,Rest,ObjName,ObjectFields,
- MaybeConstr++ConstrAcc);
-gen_encode_objectfields(Erules,ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest],
- ObjName,ObjectFields,ConstrAcc) ->
- CurrentMod = get(currmod),
- EmitFuncClause =
- fun(Attrs) ->
- emit(["'enc_",ObjName,"'(",{asis,Name},
- ",",Attrs,") ->",nl])
- end,
-% emit(["'enc_",ObjName,"'(",{asis,Name},
-% ", Val,[H|T]) ->",nl]),
- case {get_object_field(Name,ObjectFields),OptOrMand} of
- {false,'MANDATORY'} ->
- exit({error,{asn1,{"missing mandatory field in object",
- ObjName}}});
- {false,'OPTIONAL'} ->
- EmitFuncClause("_,_"),
- emit([" exit({error,{'use of missing field in object', ",{asis,Name},
- "}})"]);
- {false,{'DEFAULT',_DefaultObject}} ->
- exit({error,{asn1,{"not implemented yet",Name}}});
- {{Name,#'Externalvaluereference'{module=CurrentMod,
- value=TypeName}},_} ->
- EmitFuncClause(" Val, [H|T]"),
- emit({indent(3),"'enc_",TypeName,"'(H, Val, T)"});
- {{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} ->
- EmitFuncClause(" Val, [H|T]"),
- emit({indent(3),"'",M,"':'enc_",TypeName,"'(H, Val, T)"});
- {{Name,TypeSpec},_} ->
- EmitFuncClause("Val,[H|T]"),
- case TypeSpec#typedef.name of
- {ExtMod,TypeName} ->
- emit({indent(3),"'",ExtMod,"':'enc_",TypeName,
- "'(H, Val, T)"});
- TypeName ->
- emit({indent(3),"'enc_",TypeName,"'(H, Val, T)"})
- end
- end,
- case more_genfields(Rest) of
- true ->
- emit([";",nl]);
- false ->
- emit([".",nl])
- end,
- gen_encode_objectfields(Erules,ClassName,Rest,ObjName,ObjectFields,ConstrAcc);
-gen_encode_objectfields(Erules,ClassName,[_C|Cs],O,OF,Acc) ->
- gen_encode_objectfields(Erules,ClassName,Cs,O,OF,Acc);
-gen_encode_objectfields(_Erules,_,[],_,_,Acc) ->
- Acc.
-
-
-
-gen_encode_constr_type(Erules,[TypeDef|Rest]) when is_record(TypeDef,typedef) ->
- case is_already_generated(enc,TypeDef#typedef.name) of
- true -> ok;
- _ ->
- Name = lists:concat(["enc_",TypeDef#typedef.name]),
- emit({Name,"(Val) ->",nl}),
- Def = TypeDef#typedef.typespec,
- InnerType = asn1ct_gen:get_inner(Def#type.def),
- asn1ct_gen:gen_encode_constructed(Erules,Name,InnerType,Def),
- gen_encode_constr_type(Erules,Rest)
- end;
-gen_encode_constr_type(_,[]) ->
- ok.
-
-gen_encode_field_call(_Erule,_ObjName,_FieldName,
- #'Externaltypereference'{module=M,type=T}) ->
- CurrentMod = get(currmod),
- if
- M == CurrentMod ->
- emit({" 'enc_",T,"'(Val)"}),
- [];
- true ->
- emit({" '",M,"':'enc_",T,"'(Val)"}),
- []
- end;
-gen_encode_field_call(Erule,ObjName,FieldName,Type) ->
- Def = Type#typedef.typespec,
- case Type#typedef.name of
- {primitive,bif} ->
- gen_encode_prim(Erule,Def,"false",
- "Val"),
- [];
- {constructed,bif} ->
- emit({" 'enc_",ObjName,'_',FieldName,
- "'(Val)"}),
- [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}];
- {ExtMod,TypeName} ->
- emit({" '",ExtMod,"':'enc_",TypeName,
- "'(Val)"}),
- [];
- TypeName ->
- emit({" 'enc_",TypeName,"'(Val)"}),
- []
- end.
-
-gen_encode_default_call(Erules,ClassName,FieldName,Type) ->
- CurrentMod = get(currmod),
- InnerType = asn1ct_gen:get_inner(Type#type.def),
- case asn1ct_gen:type(InnerType) of
- {constructed,bif} ->
-%% asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type);
- emit([" 'enc_",ClassName,'_',FieldName,"'(Val)"]),
- [#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])),
- typespec=Type}];
- {primitive,bif} ->
- gen_encode_prim(Erules,Type,"false","Val"),
- [];
- #'Externaltypereference'{module=CurrentMod,type=Etype} ->
- emit([" 'enc_",Etype,"'(Val)",nl]),
- [];
- #'Externaltypereference'{module=Emod,type=Etype} ->
- emit([" '",Emod,"':'enc_",Etype,"'(Val)",nl]),
- []
- end.
-
-
-
-gen_decode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest],
- ObjName,ObjectFields,ConstrAcc) ->
- EmitFuncClause =
- fun(Bytes) ->
- emit(["'dec_",ObjName,"'(",{asis,Name},",",Bytes,
- ",_,_RestPrimFieldName) ->",nl])
- end,
-% emit(["'dec_",ObjName,"'(",{asis,Name},
-% ", Bytes, _, RestPrimFieldName) ->",nl]),
- MaybeConstr=
- case {get_object_field(Name,ObjectFields),OptOrMand} of
- {false,'MANDATORY'} -> %% this case is illegal
- exit({error,{asn1,{"missing mandatory field in object",
- ObjName}}});
- {false,'OPTIONAL'} ->
- EmitFuncClause("Bytes"),
- emit([" {Bytes,[]}"]),
- [];
- {false,{'DEFAULT',DefaultType}} ->
- EmitFuncClause("Bytes"),
- gen_decode_default_call(ClassName,Name,"Bytes",DefaultType);
- {{Name,TypeSpec},_} ->
- %% A specified field owerwrites any 'DEFAULT' or
- %% 'OPTIONAL' field in the class
- EmitFuncClause("Bytes"),
- gen_decode_field_call(ObjName,Name,"Bytes",TypeSpec)
- end,
- case more_genfields(Rest) of
- true ->
- emit([";",nl]);
- false ->
- emit([".",nl])
- end,
- gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,MaybeConstr++ConstrAcc);
-gen_decode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest],
- ObjName,ObjectFields,ConstrAcc) ->
- CurrentMod = get(currmod),
- EmitFuncClause =
- fun(Attrs) ->
- emit(["'dec_",ObjName,"'(",{asis,Name},
- ",",Attrs,") ->",nl])
- end,
-% emit(["'dec_",ObjName,"'(",{asis,Name},
-% ", Bytes,_,[H|T]) ->",nl]),
- case {get_object_field(Name,ObjectFields),OptOrMand} of
- {false,'MANDATORY'} ->
- exit({error,{asn1,{"missing mandatory field in object",
- ObjName}}});
- {false,'OPTIONAL'} ->
- EmitFuncClause("_,_,_"),
- emit([" exit({error,{'illegal use of missing field in object', ",{asis,Name},
- "}})"]);
- {false,{'DEFAULT',_DefaultObject}} ->
- exit({error,{asn1,{"not implemented yet",Name}}});
- {{Name,#'Externalvaluereference'{module=CurrentMod,
- value=TypeName}},_} ->
- EmitFuncClause("Bytes,_,[H|T]"),
- emit({indent(3),"'dec_",TypeName,"'(H, Bytes, telltype, T)"});
- {{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} ->
- EmitFuncClause("Bytes,_,[H|T]"),
- emit({indent(3),"'",M,"':'dec_",TypeName,
- "'(H, Bytes, telltype, T)"});
- {{Name,TypeSpec},_} ->
- EmitFuncClause("Bytes,_,[H|T]"),
- case TypeSpec#typedef.name of
- {ExtMod,TypeName} ->
- emit({indent(3),"'",ExtMod,"':'dec_",TypeName,
- "'(H, Bytes, telltype, T)"});
- TypeName ->
- emit({indent(3),"'dec_",TypeName,"'(H, Bytes, telltype, T)"})
- end
- end,
- case more_genfields(Rest) of
- true ->
- emit([";",nl]);
- false ->
- emit([".",nl])
- end,
- gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,ConstrAcc);
-gen_decode_objectfields(CN,[_C|Cs],O,OF,CAcc) ->
- gen_decode_objectfields(CN,Cs,O,OF,CAcc);
-gen_decode_objectfields(_,[],_,_,CAcc) ->
- CAcc.
-
-
-gen_decode_field_call(_ObjName,_FieldName,Bytes,
- #'Externaltypereference'{module=M,type=T}) ->
- CurrentMod = get(currmod),
- if
- M == CurrentMod ->
- emit([" 'dec_",T,"'(",Bytes,", telltype)"]),
- [];
- true ->
- emit([" '",M,"':'dec_",T,"'(",Bytes,", telltype)"]),
- []
- end;
-gen_decode_field_call(ObjName,FieldName,Bytes,Type) ->
- Def = Type#typedef.typespec,
- case Type#typedef.name of
- {primitive,bif} ->
- gen_dec_prim(per,Def,Bytes),
- [];
- {constructed,bif} ->
- emit({" 'dec_",ObjName,'_',FieldName,
- "'(",Bytes,",telltype)"}),
- [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}];
- {ExtMod,TypeName} ->
- emit({" '",ExtMod,"':'dec_",TypeName,
- "'(",Bytes,", telltype)"}),
- [];
- TypeName ->
- emit({" 'dec_",TypeName,"'(",Bytes,", telltype)"}),
- []
- end.
-
-gen_decode_default_call(ClassName,FieldName,Bytes,Type) ->
- CurrentMod = get(currmod),
- InnerType = asn1ct_gen:get_inner(Type#type.def),
- case asn1ct_gen:type(InnerType) of
- {constructed,bif} ->
- emit([" 'dec_",ClassName,'_',FieldName,"'(",Bytes,", telltype)"]),
- [#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])),
- typespec=Type}];
- {primitive,bif} ->
- gen_dec_prim(per,Type,Bytes),
- [];
- #'Externaltypereference'{module=CurrentMod,type=Etype} ->
- emit([" 'dec_",Etype,"'(",Bytes,", telltype)",nl]),
- [];
- #'Externaltypereference'{module=Emod,type=Etype} ->
- emit([" '",Emod,"':'dec_",Etype,"'(",Bytes,", telltype)",nl]),
- []
- end.
-
-%%%%%%%%%%%%%%%
-
-
-gen_decode_constr_type(Erules,[TypeDef|Rest]) when is_record(TypeDef,typedef) ->
- case is_already_generated(dec,TypeDef#typedef.name) of
- true -> ok;
- _ ->
- gen_decode(Erules,TypeDef)
- end,
- gen_decode_constr_type(Erules,Rest);
-gen_decode_constr_type(_,[]) ->
- ok.
-
-%% Object Set code generating for encoding and decoding
-%% ----------------------------------------------------
-gen_objectset_code(Erules,ObjSet) ->
- ObjSetName = ObjSet#typedef.name,
- Def = ObjSet#typedef.typespec,
-%% {ClassName,ClassDef} = Def#'ObjectSet'.class,
- #'Externaltypereference'{module=ClassModule,
- type=ClassName} = Def#'ObjectSet'.class,
- ClassDef = asn1_db:dbget(ClassModule,ClassName),
- UniqueFName = Def#'ObjectSet'.uniquefname,
- Set = Def#'ObjectSet'.set,
- emit({nl,nl,nl,"%%================================"}),
- emit({nl,"%% ",ObjSetName}),
- emit({nl,"%%================================",nl}),
- case ClassName of
- {_Module,ExtClassName} ->
- gen_objset_code(Erules,ObjSetName,UniqueFName,Set,
- ExtClassName,ClassDef);
- _ ->
- gen_objset_code(Erules,ObjSetName,UniqueFName,Set,
- ClassName,ClassDef)
- end,
- emit(nl).
-
-gen_objset_code(Erule,ObjSetName,UniqueFName,Set,ClassName,ClassDef)->
- ClassFields = (ClassDef#classdef.typespec)#objectclass.fields,
- InternalFuncs=
- gen_objset_enc(Erule,ObjSetName,UniqueFName,Set,ClassName,
- ClassFields,1,[]),
- gen_objset_dec(ObjSetName,UniqueFName,Set,ClassName,ClassFields,1),
- gen_internal_funcs(Erule,InternalFuncs).
-
-gen_objset_enc(_Erule,_,{unique,undefined},_,_,_,_,_) ->
- %% There is no unique field in the class of this object set
- %% don't bother about the constraint
- [];
-gen_objset_enc(Erule,ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest],
- ClName,ClFields,NthObj,Acc)->
- emit({"'getenc_",ObjSName,"'(",{asis,UniqueName},",",
- {asis,Val},") ->",nl}),
- CurrMod = get(currmod),
- {InternalFunc,NewNthObj}=
- case ObjName of
- {no_mod,no_name} ->
- gen_inlined_enc_funs(Erule,Fields,ClFields,ObjSName,NthObj);
- {CurrMod,Name} ->
- emit({" fun 'enc_",Name,"'/3"}),
- {[],NthObj};
- {ModName,Name} ->
- emit_ext_encfun(ModName,Name),
-% emit([" {'",ModName,"', 'enc_",Name,"'}"]),
- {[],NthObj};
- _ ->
- emit({" fun 'enc_",ObjName,"'/3"}),
- {[],NthObj}
- end,
- emit({";",nl}),
- gen_objset_enc(Erule,ObjSName,UniqueName,[T|Rest],ClName,ClFields,
- NewNthObj,InternalFunc++Acc);
-gen_objset_enc(Erule,ObjSetName,UniqueName,
- [{ObjName,Val,Fields}],_ClName,ClFields,NthObj,Acc) ->
-
- emit({"'getenc_",ObjSetName,"'(",{asis,UniqueName},",",
- {asis,Val},") ->",nl}),
- CurrMod = get(currmod),
- {InternalFunc,_}=
- case ObjName of
- {no_mod,no_name} ->
- gen_inlined_enc_funs(Erule,Fields,ClFields,ObjSetName,NthObj);
- {CurrMod,Name} ->
- emit({" fun 'enc_",Name,"'/3"}),
- {[],NthObj};
- {ModName,Name} ->
- emit_ext_encfun(ModName,Name),
-% emit([" {'",ModName,"', 'enc_",Name,"'}"]),
- {[],NthObj};
- _ ->
- emit({" fun 'enc_",ObjName,"'/3"}),
- {[],NthObj}
- end,
- emit([";",nl]),
- emit_default_getenc(ObjSetName,UniqueName),
- emit({".",nl,nl}),
- InternalFunc++Acc;
-gen_objset_enc(_Erule,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,
- _ClFields,_NthObj,Acc) ->
- emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}),
- emit({indent(3),"fun(_, Val, _) ->",nl}),
- emit({indent(6),"BinVal = if",nl}),
- emit({indent(9),"is_list(Val) -> list_to_binary(Val);",nl}),
- emit({indent(9),"true -> Val",nl}),
- emit({indent(6),"end,",nl}),
- emit({indent(6),"Size = byte_size(BinVal),",nl}),
- emit({indent(6),"if",nl}),
- emit({indent(9),"Size < 256 ->",nl}),
- emit({indent(12),"[20,Size,BinVal];",nl}),
- emit({indent(9),"true ->",nl}),
- emit({indent(12),"[21,<<Size:16>>,Val]",nl}),
- emit({indent(6),"end",nl}),
- emit({indent(3),"end.",nl,nl}),
- Acc;
-gen_objset_enc(_Erule,_,_,[],_,_,_,Acc) ->
- Acc.
-
-emit_ext_encfun(ModuleName,Name) ->
- emit([indent(4),"fun(T,V,O) -> '",ModuleName,"':'enc_",
- Name,"'(T,V,O) end"]).
-
-emit_default_getenc(ObjSetName,UniqueName) ->
- emit(["'getenc_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]),
- emit([indent(4),"fun(C,V,_) -> exit({'Type not compatible with table constraint',{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},",ErrV}}) end"]).
-
-
-%% gen_inlined_enc_funs for each object iterates over all fields of a
-%% class, and for each typefield it checks if the object has that
-%% field and emits the proper code.
-gen_inlined_enc_funs(Erule,Fields,[{typefield,Name,_}|Rest],ObjSetName,NthObj) ->
- CurrMod = get(currmod),
- InternalDefFunName=asn1ct_gen:list2name([NthObj,Name,ObjSetName]),
- case lists:keysearch(Name,1,Fields) of
- {value,{_,Type}} when is_record(Type,type) ->
- emit({indent(3),"fun(Type, Val, _) ->",nl,
- indent(6),"case Type of",nl}),
- {Ret,N}=emit_inner_of_fun(Erule,Type,InternalDefFunName),
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj+N,Ret);
- {value,{_,Type}} when is_record(Type,typedef) ->
- emit({indent(3),"fun(Type, Val, _) ->",nl,
- indent(6),"case Type of",nl}),
- emit({indent(9),{asis,Name}," ->",nl}),
- {Ret,N}=emit_inner_of_fun(Erule,Type,InternalDefFunName),
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj+N,Ret);
- {value,{_,#'Externaltypereference'{module=CurrMod,type=T}}} ->
- emit({indent(3),"fun(Type, Val, _) ->",nl,
- indent(6),"case Type of",nl}),
- emit({indent(9),{asis,Name}," ->",nl}),
- emit([indent(12),"'enc_",T,"'(Val)"]),
-% {Ret,N} = emit_inner_of_fun(Erule,TDef,InternalDefFunName),
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,[]);
- {value,{_,#'Externaltypereference'{module=M,type=T}}} ->
- emit({indent(3),"fun(Type, Val, _) ->",nl,
- indent(6),"case Type of",nl}),
- emit({indent(9),{asis,Name}," ->",nl}),
- emit([indent(12),"'",M,"'",":'enc_",T,"'(Val)"]),
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,[]);
- false ->
- emit([indent(3),"fun(Type, Val, _) ->",nl,
- indent(6),"case Type of",nl,
- indent(9),{asis,Name}," ->",nl,
- indent(12),"Size = case Val of",nl,
- indent(15),"B when is_binary(B) -> size(B);",nl,
- indent(15),"_ -> length(Val)",nl,
- indent(12),"end,",nl,
- indent(12),"if",nl,
- indent(15),"Size < 256 -> [20,Size,Val];",nl,
- indent(15),"true -> [21,<<Size:16>>,Val]",nl,
- indent(12),"end"]),
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,[])
- end;
-gen_inlined_enc_funs(Erule,Fields,[_|Rest],ObjSetName,NthObj) ->
- gen_inlined_enc_funs(Erule,Fields,Rest,ObjSetName,NthObj);
-gen_inlined_enc_funs(_Erule,_,[],_,NthObj) ->
- {[],NthObj}.
-
-gen_inlined_enc_funs1(Erule,Fields,[{typefield,Name,_}|Rest],ObjSetName,
- NthObj,Acc) ->
- CurrentMod = get(currmod),
- InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]),
- {Acc2,NAdd}=
- case lists:keysearch(Name,1,Fields) of
- {value,{_,Type}} when is_record(Type,type) ->
- emit({";",nl}),
- {Ret,N}=emit_inner_of_fun(Erule,Type,InternalDefFunName),
- {Ret++Acc,N};
- {value,{_,Type}} when is_record(Type,typedef) ->
- emit({";",nl,indent(9),{asis,Name}," ->",nl}),
- {Ret,N}=emit_inner_of_fun(Erule,Type,InternalDefFunName),
- {Ret++Acc,N};
- {value,{_,#'Externaltypereference'{module=CurrentMod,type=T}}} ->
- emit({";",nl,indent(9),{asis,Name}," ->",nl}),
- emit([indent(12),"'enc_",T,"'(Val)"]),
- {Acc,0};
- {value,{_,#'Externaltypereference'{module=M,type=T}}} ->
- emit({";",nl,indent(9),{asis,Name}," ->",nl}),
- emit([indent(12),"'",M,"'",":'enc_",T,"'(Val)"]),
- {Acc,0};
- false ->
- emit([";",nl,
- indent(9),{asis,Name}," ->",nl,
- indent(12),"Size = case Val of",nl,
- indent(15),"B when is_binary(B) -> size(B);",nl,
- indent(15),"_ -> length(Val)",nl,
- indent(12),"end,",nl,
- indent(12),"if",nl,
- indent(15),"Size < 256 -> [20,Size,Val];",nl,
- indent(15),"true -> [21,<<Size:16>>,Val]",nl,
- indent(12),"end"]),
- {Acc,0}
- end,
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj+NAdd,Acc2);
-gen_inlined_enc_funs1(Erule,Fields,[_|Rest],ObjSetName,NthObj,Acc)->
- gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,Acc);
-gen_inlined_enc_funs1(_Erule,_,[],_,NthObj,Acc) ->
- emit({nl,indent(6),"end",nl}),
- emit({indent(3),"end"}),
- {Acc,NthObj}.
-
-emit_inner_of_fun(Erule,TDef=#typedef{name={ExtMod,Name},typespec=Type},
- InternalDefFunName) ->
- case {ExtMod,Name} of
- {primitive,bif} ->
- emit(indent(12)),
- gen_encode_prim(Erule,Type,dotag,"Val"),
- {[],0};
- {constructed,bif} ->
- emit([indent(12),"'enc_",
- InternalDefFunName,"'(Val)"]),
- {[TDef#typedef{name=InternalDefFunName}],1};
- _ ->
- emit({indent(12),"'",ExtMod,"':'enc_",Name,"'(Val)"}),
- {[],0}
- end;
-emit_inner_of_fun(_Erule,#typedef{name=Name},_) ->
- emit({indent(12),"'enc_",Name,"'(Val)"}),
- {[],0};
-emit_inner_of_fun(Erule,Type,_) when is_record(Type,type) ->
- CurrMod = get(currmod),
- case Type#type.def of
- Def when is_atom(Def) ->
- emit({indent(9),Def," ->",nl,indent(12)}),
- gen_encode_prim(Erule,Type,dotag,"Val");
- TRef when is_record(TRef,typereference) ->
- T = TRef#typereference.val,
- emit({indent(9),T," ->",nl,indent(12),"'enc_",T,"'(Val)"});
- #'Externaltypereference'{module=CurrMod,type=T} ->
- emit({indent(9),T," ->",nl,indent(12),"'enc_",T,"'(Val)"});
- #'Externaltypereference'{module=ExtMod,type=T} ->
- emit({indent(9),T," ->",nl,indent(12),ExtMod,":'enc_",
- T,"'(Val)"})
- end,
- {[],0}.
-
-indent(N) ->
- lists:duplicate(N,32). % 32 = space
-
-
-gen_objset_dec(_,{unique,undefined},_,_,_,_) ->
- %% There is no unique field in the class of this object set
- %% don't bother about the constraint
- ok;
-gen_objset_dec(ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest],ClName,
- ClFields,NthObj)->
-
- emit({"'getdec_",ObjSName,"'(",{asis,UniqueName},",",
- {asis,Val},") ->",nl}),
- CurrMod = get(currmod),
- NewNthObj=
- case ObjName of
- {no_mod,no_name} ->
- gen_inlined_dec_funs(Fields,ClFields,ObjSName,NthObj);
- {CurrMod,Name} ->
- emit([" fun 'dec_",Name,"'/4"]),
- NthObj;
- {ModName,Name} ->
- emit_ext_decfun(ModName,Name),
-% emit([" {'",ModName,"', 'dec_",Name,"'}"]),
- NthObj;
- _ ->
- emit({" fun 'dec_",ObjName,"'/4"}),
- NthObj
- end,
- emit({";",nl}),
- gen_objset_dec(ObjSName,UniqueName,[T|Rest],ClName,ClFields,NewNthObj);
-gen_objset_dec(ObjSetName,UniqueName,[{ObjName,Val,Fields}],_ClName,
- ClFields,NthObj) ->
-
- emit({"'getdec_",ObjSetName,"'(",{asis,UniqueName},",",
- {asis,Val},") ->",nl}),
- CurrMod=get(currmod),
- case ObjName of
- {no_mod,no_name} ->
- gen_inlined_dec_funs(Fields,ClFields,ObjSetName,NthObj);
- {CurrMod,Name} ->
- emit([" fun 'dec_",Name,"'/4"]);
- {ModName,Name} ->
- emit_ext_decfun(ModName,Name);
-% emit([" {'",ModName,"', 'dec_",Name,"'}"]);
- _ ->
- emit({" fun 'dec_",ObjName,"'/4"})
- end,
- emit([";",nl]),
- emit_default_getdec(ObjSetName,UniqueName),
- emit({".",nl,nl}),
- ok;
-gen_objset_dec(ObjSetName,_,['EXTENSIONMARK'],_ClName,_ClFields,
- _NthObj) ->
- emit({"'getdec_",ObjSetName,"'(_, _) ->",nl}),
- emit({indent(3),"fun(Attr1, Bytes, _, _) ->",nl}),
- emit({indent(6),"{Bytes,Attr1}",nl}),
- emit({indent(3),"end.",nl,nl}),
- ok;
-gen_objset_dec(_,_,[],_,_,_) ->
- ok.
-
-emit_ext_decfun(ModuleName,Name) ->
- emit([indent(3),"fun(T,V,O1,O2) -> '",ModuleName,"':'dec_",
- Name,"'(T,V,O1,O2) end"]).
-
-emit_default_getdec(ObjSetName,UniqueName) ->
- emit(["'getdec_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]),
- emit([indent(2), "fun(C,V,_,_) -> exit({{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},",ErrV}}) end"]).
-
-
-gen_inlined_dec_funs(Fields, List, ObjSetName, NthObj0) ->
- emit([indent(3),"fun(Type, Val, _, _) ->",nl,
- indent(6),"case Type of",nl]),
- NthObj = gen_inlined_dec_funs1(Fields, List, ObjSetName, "", NthObj0),
- emit([nl,indent(6),"end",nl,
- indent(3),"end"]),
- NthObj.
-
-gen_inlined_dec_funs1(Fields, [{typefield,Name,_}|Rest],
- ObjSetName, Sep0, NthObj) ->
- CurrentMod = get(currmod),
- InternalDefFunName = [NthObj,Name,ObjSetName],
- emit(Sep0),
- Sep = [";",nl],
- N = case lists:keyfind(Name, 1, Fields) of
- {_,#type{}=Type} ->
- emit_inner_of_decfun(Type, InternalDefFunName);
- {_,#typedef{}=Type} ->
- emit([indent(9),{asis,Name}," ->",nl]),
- emit_inner_of_decfun(Type, InternalDefFunName);
- {_,#'Externaltypereference'{module=CurrentMod,type=T}} ->
- emit([indent(9),{asis,Name}," ->",nl,
- indent(12),"'dec_",T,"'(Val,telltype)"]),
- 0;
- {_,#'Externaltypereference'{module=M,type=T}} ->
- emit([indent(9),{asis,Name}," ->",nl,
- indent(12),"'",M,"':'dec_",T,"'(Val,telltype)"]),
- 0;
- false ->
- emit([indent(9),{asis,Name}," -> {Val,Type}"]),
- 0
- end,
- gen_inlined_dec_funs1(Fields, Rest, ObjSetName, Sep, NthObj+N);
-gen_inlined_dec_funs1(Fields, [_|Rest], ObjSetName, Sep, NthObj) ->
- gen_inlined_dec_funs1(Fields, Rest, ObjSetName, Sep, NthObj);
-gen_inlined_dec_funs1(_, [], _, _, NthObj) -> NthObj.
-
-emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type},
- InternalDefFunName) ->
- case {ExtName,Name} of
- {primitive,bif} ->
- emit(indent(12)),
- gen_dec_prim(per,Type,"Val"),
- 0;
- {constructed,bif} ->
- emit({indent(12),"'dec_",
- asn1ct_gen:list2name(InternalDefFunName),"'(Val)"}),
- 1;
- _ ->
- emit({indent(12),"'",ExtName,"':'dec_",Name,
- "'(Val, telltype)"}),
- 0
- end;
-emit_inner_of_decfun(#typedef{name=Name},_) ->
- emit({indent(12),"'dec_",Name,"'(Val, telltype)"}),
- 0;
-emit_inner_of_decfun(Type,_) when is_record(Type,type) ->
- CurrMod = get(currmod),
- case Type#type.def of
- Def when is_atom(Def) ->
- emit({indent(9),Def," ->",nl,indent(12)}),
- gen_dec_prim(per, Type, "Val");
- TRef when is_record(TRef,typereference) ->
- T = TRef#typereference.val,
- emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"});
- #'Externaltypereference'{module=CurrMod,type=T} ->
- emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"});
- #'Externaltypereference'{module=ExtMod,type=T} ->
- emit({indent(9),T," ->",nl,indent(12),ExtMod,":'dec_",
- T,"'(Val)"})
- end,
- 0.
-
-
-gen_internal_funcs(_Erules,[]) ->
- ok;
-gen_internal_funcs(Erules,[TypeDef|Rest]) ->
- gen_encode_user(Erules,TypeDef),
- emit([nl,nl,"'dec_",TypeDef#typedef.name,"'(Bytes) ->",nl]),
- gen_decode_user(Erules,TypeDef),
- gen_internal_funcs(Erules,Rest).
-
-
-
-%% DECODING *****************************
-%%***************************************
-
-
-gen_decode(Erules,Type) when is_record(Type,typedef) ->
- D = Type,
- emit({nl,nl}),
- emit({"'dec_",Type#typedef.name,"'(Bytes,_) ->",nl}),
- dbdec(Type#typedef.name),
- gen_decode_user(Erules,D).
-
-gen_decode(Erules,Tname,#'ComponentType'{name=Cname,typespec=Type}) ->
- NewTname = [Cname|Tname],
- gen_decode(Erules,NewTname,Type);
-
-gen_decode(Erules,Typename,Type) when is_record(Type,type) ->
- InnerType = asn1ct_gen:get_inner(Type#type.def),
- case asn1ct_gen:type(InnerType) of
- {constructed,bif} ->
- ObjFun =
- case Type#type.tablecinf of
- [{objfun,_}|_R] ->
- ", ObjFun";
- _ ->
- ""
- end,
- emit({nl,"'dec_",asn1ct_gen:list2name(Typename),
- "'(Bytes,_",ObjFun,") ->",nl}),
- dbdec(Typename),
- asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,Type);
- _ ->
- true
- end.
-
-dbdec(Type) when is_list(Type)->
- demit({"io:format(\"decoding: ",asn1ct_gen:list2name(Type),"~w~n\",[Bytes]),",nl});
-dbdec(Type) ->
- demit({"io:format(\"decoding: ",{asis,Type},"~w~n\",[Bytes]),",nl}).
-
-gen_decode_user(Erules,D) when is_record(D,typedef) ->
- CurrMod = get(currmod),
- Typename = [D#typedef.name],
- Def = D#typedef.typespec,
- InnerType = asn1ct_gen:get_inner(Def#type.def),
- case asn1ct_gen:type(InnerType) of
- {primitive,bif} ->
- gen_dec_prim(Erules,Def,"Bytes"),
- emit({".",nl,nl});
- 'ASN1_OPEN_TYPE' ->
- gen_dec_prim(Erules,Def#type{def='ASN1_OPEN_TYPE'},"Bytes"),
- emit({".",nl,nl});
- {constructed,bif} ->
- asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,D);
- #typereference{val=Dname} ->
- emit({"'dec_",Dname,"'(Bytes,telltype)"}),
- emit({".",nl,nl});
- #'Externaltypereference'{module=CurrMod,type=Etype} ->
- emit({"'dec_",Etype,"'(Bytes,telltype).",nl,nl});
- #'Externaltypereference'{module=Emod,type=Etype} ->
- emit({"'",Emod,"':'dec_",Etype,"'(Bytes,telltype).",nl,nl});
- Other ->
- exit({error,{asn1,{unknown,Other}}})
- end.
-
-
-
-gen_dec_prim(Erules, Att, BytesVar) ->
- asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar).
-
-%% For PER the ExtensionAdditionGroup notation has significance for the encoding and decoding
-%% the components within the ExtensionAdditionGroup is treated in a similar way as if they
-%% have been specified within a SEQUENCE, therefore we construct a fake sequence type here
-%% so that we can generate code for it
-extaddgroup2sequence(ExtList) ->
- extaddgroup2sequence(ExtList,0,[]).
-
-extaddgroup2sequence([{'ExtensionAdditionGroup',Number0}|T],ExtNum,Acc) ->
- Number = case Number0 of undefined -> 1; _ -> Number0 end,
- {ExtGroupComps,['ExtensionAdditionGroupEnd'|T2]} =
- lists:splitwith(fun(Elem) -> is_record(Elem,'ComponentType') end,T),
- extaddgroup2sequence(T2,ExtNum+1,
- [#'ComponentType'{
- name=list_to_atom("ExtAddGroup"++
- integer_to_list(ExtNum+1)),
- typespec=#type{def=#'SEQUENCE'{
- extaddgroup=Number,
- components=ExtGroupComps}},
- prop='OPTIONAL'}|Acc]);
-extaddgroup2sequence([C|T],ExtNum,Acc) ->
- extaddgroup2sequence(T,ExtNum,[C|Acc]);
-extaddgroup2sequence([],_,Acc) ->
- lists:reverse(Acc).
diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl
index 4b2c3b1b65..c6803a0f96 100644
--- a/lib/asn1/src/asn1ct_imm.erl
+++ b/lib/asn1/src/asn1ct_imm.erl
@@ -25,6 +25,7 @@
per_dec_length/3,per_dec_named_integer/3,
per_dec_octet_string/2,per_dec_open_type/1,per_dec_real/1,
per_dec_restricted_string/1]).
+-export([per_dec_constrained/3,per_dec_normally_small_number/1]).
-export([optimize_alignment/1,optimize_alignment/2,
dec_slim_cg/2,dec_code_gen/2]).
-export([effective_constraint/2]).
@@ -94,18 +95,16 @@ per_dec_integer(Constraint0, Aligned) ->
per_dec_length(SingleValue, _, _Aligned) when is_integer(SingleValue) ->
{value,SingleValue};
-per_dec_length({S,S}, _, _Aligned) when is_integer(S) ->
- {value,S};
-per_dec_length({{_,_}=Constr,_}, AllowZero, Aligned) ->
+per_dec_length({{Fixed,Fixed},[]}, AllowZero, Aligned) ->
+ bit_case(per_dec_length(Fixed, AllowZero, Aligned),
+ per_dec_length(no, AllowZero, Aligned));
+per_dec_length({{_,_}=Constr,[]}, AllowZero, Aligned) ->
bit_case(per_dec_length(Constr, AllowZero, Aligned),
- per_dec_length(undefined, AllowZero, Aligned));
+ per_dec_length(no, AllowZero, Aligned));
per_dec_length({Lb,Ub}, _AllowZero, Aligned) when is_integer(Lb),
- is_integer(Lb),
- Ub =< 65535 ->
+ is_integer(Lb) ->
per_dec_constrained(Lb, Ub, Aligned);
-per_dec_length({_,_}, AllowZero, Aligned) ->
- decode_unconstrained_length(AllowZero, Aligned);
-per_dec_length(undefined, AllowZero, Aligned) ->
+per_dec_length(no, AllowZero, Aligned) ->
decode_unconstrained_length(AllowZero, Aligned).
per_dec_named_integer(Constraint, NamedList0, Aligned) ->
@@ -114,17 +113,27 @@ per_dec_named_integer(Constraint, NamedList0, Aligned) ->
{map,Int,NamedList}.
per_dec_k_m_string(StringType, Constraint, Aligned) ->
- SzConstr = get_constraint(Constraint, 'SizeConstraint'),
+ SzConstr = effective_constraint(bitstring, Constraint),
N = string_num_bits(StringType, Constraint, Aligned),
- Imm = dec_string(SzConstr, N, Aligned),
+ %% X.691 (07/2002) 27.5.7 says if the upper bound times the number
+ %% of bits is greater than or equal to 16, then the bit field should
+ %% be aligned.
+ Imm = dec_string(SzConstr, N, Aligned, fun(_, Ub) -> Ub >= 16 end),
Chars = char_tab(Constraint, StringType, N),
convert_string(N, Chars, Imm).
per_dec_octet_string(Constraint, Aligned) ->
- dec_string(Constraint, 8, Aligned).
+ dec_string(Constraint, 8, Aligned,
+ %% Aligned unless the size is fixed and =< 16.
+ fun(Sv, Sv) -> Sv > 16;
+ (_, _) -> true
+ end).
per_dec_raw_bitstring(Constraint, Aligned) ->
- dec_string(Constraint, 1, Aligned).
+ dec_string(Constraint, 1, Aligned,
+ fun(Sv, Sv) -> Sv > 16;
+ (_, _) -> true
+ end).
per_dec_open_type(Aligned) ->
{get_bits,decode_unconstrained_length(true, Aligned),
@@ -148,21 +157,21 @@ per_dec_restricted_string(Aligned) ->
%%% Local functions.
%%%
-dec_string(Sv, U, _Aligned) when is_integer(Sv), U*Sv =< 16 ->
- {get_bits,Sv,[U,binary]};
-dec_string(Sv, U, Aligned) when is_integer(Sv), Sv < 16#10000 ->
+dec_string(Sv, U, Aligned0, AF) when is_integer(Sv) ->
+ Bits = U*Sv,
+ Aligned = Aligned0 andalso AF(Bits, Bits),
{get_bits,Sv,[U,binary,{align,Aligned}]};
-dec_string([_|_]=C, U, Aligned) when is_list(C) ->
- dec_string({hd(C),lists:max(C)}, U, Aligned);
-dec_string({Sv,Sv}, U, Aligned) ->
- dec_string(Sv, U, Aligned);
-dec_string({{_,_}=C,_}, U, Aligned) ->
- bit_case(dec_string(C, U, Aligned),
- dec_string(no, U, Aligned));
-dec_string({Lb,Ub}, U, Aligned) when Ub < 16#10000 ->
- Len = per_dec_constrained(Lb, Ub, Aligned),
+dec_string({{Sv,Sv},[]}, U, Aligned, AF) ->
+ bit_case(dec_string(Sv, U, Aligned, AF),
+ dec_string(no, U, Aligned, AF));
+dec_string({{_,_}=C,[]}, U, Aligned, AF) ->
+ bit_case(dec_string(C, U, Aligned, AF),
+ dec_string(no, U, Aligned, AF));
+dec_string({Lb,Ub}, U, Aligned0, AF) ->
+ Len = per_dec_constrained(Lb, Ub, Aligned0),
+ Aligned = Aligned0 andalso AF(Lb*U, Ub*U),
{get_bits,Len,[U,binary,{align,Aligned}]};
-dec_string(_, U, Aligned) ->
+dec_string(_, U, Aligned, _AF) ->
Al = [{align,Aligned}],
DecRest = fun(V, Buf) ->
asn1ct_func:call(per_common,
@@ -189,7 +198,7 @@ per_dec_enumerated_fix_list([], Tail, _) -> Tail.
per_dec_integer_1([{'SingleValue',Value}], _Aligned) ->
{value,Value};
per_dec_integer_1([{'ValueRange',{Lb,'MAX'}}], Aligned) when is_integer(Lb) ->
- per_dec_unconstrained(Aligned);
+ per_decode_semi_constrained(Lb, Aligned);
per_dec_integer_1([{'ValueRange',{Lb,Ub}}], Aligned) when is_integer(Lb),
is_integer(Ub) ->
per_dec_constrained(Lb, Ub, Aligned);
@@ -700,7 +709,27 @@ effective_constraint(integer, C) ->
VR = effective_constr('ValueRange', VRs),
greatest_common_range(SV, VR);
effective_constraint(bitstring, C) ->
- get_constraint(C, 'SizeConstraint').
+ case get_constraint(C, 'SizeConstraint') of
+ {{Lb,Ub},[]}=Range when is_integer(Lb) ->
+ if
+ is_integer(Ub), Ub < 16#10000 ->
+ Range;
+ true ->
+ no
+ end;
+ {Lb,Ub}=Range when is_integer(Lb) ->
+ if
+ is_integer(Ub), Ub < 16#10000 ->
+ if
+ Lb =:= Ub -> Lb;
+ true -> Range
+ end;
+ true ->
+ no
+ end;
+ no ->
+ no
+ end.
effective_constr(_, []) -> [];
effective_constr('SingleValue', List) ->
diff --git a/lib/asn1/src/asn1ct_name.erl b/lib/asn1/src/asn1ct_name.erl
index 3ab6f7b0ed..c0c2ed302c 100644
--- a/lib/asn1/src/asn1ct_name.erl
+++ b/lib/asn1/src/asn1ct_name.erl
@@ -21,13 +21,8 @@
%%-compile(export_all).
-export([start/0,
- stop/0,
- push/1,
- pop/1,
curr/1,
clear/0,
- delete/1,
- active/1,
prev/1,
next/1,
all/1,
@@ -43,30 +38,19 @@ start() ->
end)),
ok;
_Pid ->
- already_started
+ %% Already started. Clear the variables.
+ clear()
end.
-stop() ->
- req(stop),
- erase(?MODULE).
-
name_server_loop({Ref, Parent} = Monitor,Vars) ->
%% io:format("name -- ~w~n",[Vars]),
receive
+ {_From,clear} ->
+ name_server_loop(Monitor, []);
{From,{current,Variable}} ->
From ! {?MODULE,get_curr(Vars,Variable)},
name_server_loop(Monitor,Vars);
- {From,{pop,Variable}} ->
- From ! {?MODULE,done},
- name_server_loop(Monitor,pop_var(Vars,Variable));
- {From,{push,Variable}} ->
- From ! {?MODULE,done},
- name_server_loop(Monitor,push_var(Vars,Variable));
- {From,{delete,Variable}} ->
- From ! {?MODULE,done},
- name_server_loop(Monitor,delete_var(Vars,Variable));
- {From,{new,Variable}} ->
- From ! {?MODULE,done},
+ {_From,{new,Variable}} ->
name_server_loop(Monitor,new_var(Vars,Variable));
{From,{prev,Variable}} ->
From ! {?MODULE,get_prev(Vars,Variable)},
@@ -74,32 +58,29 @@ name_server_loop({Ref, Parent} = Monitor,Vars) ->
{From,{next,Variable}} ->
From ! {?MODULE,get_next(Vars,Variable)},
name_server_loop(Monitor,Vars);
- {'DOWN', Ref, process, Parent, Reason} ->
- exit(Reason);
- {From,stop} ->
- From ! {?MODULE,stopped}
- end.
-
-active(V) ->
- case curr(V) of
- nil -> false;
- _ -> true
+ {'DOWN', Ref, process, Parent, Reason} ->
+ exit(Reason)
end.
req(Req) ->
- get(?MODULE) ! {self(), Req},
+ Pid = get(?MODULE),
+ Ref = monitor(process, Pid),
+ Pid ! {self(), Req},
receive
- {?MODULE, Reply} -> Reply
- after 5000 ->
- exit(name_server_timeout)
+ {?MODULE, Reply} ->
+ Reply;
+ {'DOWN', Ref, process, Pid, Reason} ->
+ error({name_server_died,Reason})
end.
-pop(V) -> req({pop,V}).
-push(V) -> req({push,V}).
-clear() -> stop(), start().
+cast(Req) ->
+ get(?MODULE) ! {self(), Req},
+ ok.
+
+clear() -> cast(clear).
curr(V) -> req({current,V}).
-new(V) -> req({new,V}).
-delete(V) -> req({delete,V}).
+new(V) -> cast({new,V}).
+
prev(V) ->
case req({prev,V}) of
none ->
@@ -108,11 +89,7 @@ prev(V) ->
end.
next(V) ->
- case req({next,V}) of
- none ->
- exit('cant get next of none');
- Rep -> Rep
- end.
+ req({next,V}).
all(V) ->
Curr = curr(V),
@@ -146,81 +123,36 @@ get_digs([H|T]) ->
[]
end.
-push_var(Vars,Variable) ->
- case lists:keysearch(Variable,1,Vars) of
- false ->
- [{Variable,[0]}|Vars];
- {value,{Variable,[Digit|Drest]}} ->
- NewVars = lists:keydelete(Variable,1,Vars),
- [{Variable,[Digit,Digit|Drest]}|NewVars]
- end.
-
-pop_var(Vars,Variable) ->
- case lists:keysearch(Variable,1,Vars) of
- false ->
- ok;
- {value,{Variable,[_Dig]}} ->
- lists:keydelete(Variable,1,Vars);
- {value,{Variable,[_Dig|Digits]}} ->
- NewVars = lists:keydelete(Variable,1,Vars),
- [{Variable,Digits}|NewVars]
- end.
-
-get_curr([],Variable) ->
+get_curr([], Variable) ->
Variable;
-get_curr([{Variable,[0|_Drest]}|_Tail],Variable) ->
- Variable;
-get_curr([{Variable,[Digit|_Drest]}|_Tail],Variable) ->
- list_to_atom(lists:concat([Variable,integer_to_list(Digit)]));
-
-get_curr([_|Tail],Variable) ->
- get_curr(Tail,Variable).
-
-new_var(Vars,Variable) ->
- case lists:keysearch(Variable,1,Vars) of
- false ->
- [{Variable,[1]}|Vars];
- {value,{Variable,[Digit|Drest]}} ->
- NewVars = lists:keydelete(Variable,1,Vars),
- [{Variable,[Digit+1|Drest]}|NewVars]
- end.
+get_curr([{Variable,Digit}|_Tail], Variable) ->
+ list_to_atom(lists:concat([Variable,Digit]));
+get_curr([_|Tail], Variable) ->
+ get_curr(Tail, Variable).
-delete_var(Vars,Variable) ->
- case lists:keysearch(Variable,1,Vars) of
+new_var(Vars, Variable) ->
+ case lists:keyfind(Variable, 1, Vars) of
false ->
- Vars;
- {value,{Variable,[N]}} when N =< 1 ->
- lists:keydelete(Variable,1,Vars);
- {value,{Variable,[Digit|Drest]}} ->
- case Digit of
- 0 ->
- Vars;
- _ ->
- NewVars = lists:keydelete(Variable,1,Vars),
- [{Variable,[Digit-1|Drest]}|NewVars]
- end
+ [{Variable,1}|Vars];
+ {Variable,Digit} ->
+ NewVars = lists:keydelete(Variable, 1, Vars),
+ [{Variable,Digit+1}|NewVars]
end.
-get_prev(Vars,Variable) ->
- case lists:keysearch(Variable,1,Vars) of
+get_prev(Vars, Variable) ->
+ case lists:keyfind(Variable, 1, Vars) of
false ->
none;
- {value,{Variable,[Digit|_]}} when Digit =< 1 ->
+ {Variable,Digit} when Digit =< 1 ->
Variable;
- {value,{Variable,[Digit|_]}} when Digit > 1 ->
- list_to_atom(lists:concat([Variable,
- integer_to_list(Digit-1)]));
- _ ->
- none
+ {Variable,Digit} when Digit > 1 ->
+ list_to_atom(lists:concat([Variable,Digit-1]))
end.
-get_next(Vars,Variable) ->
- case lists:keysearch(Variable,1,Vars) of
+get_next(Vars, Variable) ->
+ case lists:keyfind(Variable, 1, Vars) of
false ->
list_to_atom(lists:concat([Variable,"1"]));
- {value,{Variable,[Digit|_]}} when Digit >= 0 ->
- list_to_atom(lists:concat([Variable,
- integer_to_list(Digit+1)]));
- _ ->
- none
+ {Variable,Digit} when Digit >= 0 ->
+ list_to_atom(lists:concat([Variable,Digit+1]))
end.
diff --git a/lib/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl
index 9e1fcce2b1..344fdf44dd 100644
--- a/lib/asn1/src/asn1ct_parser2.erl
+++ b/lib/asn1/src/asn1ct_parser2.erl
@@ -23,6 +23,10 @@
-export([parse/1]).
-include("asn1_records.hrl").
+%% Only used internally within this module.
+-record(typereference, {pos,val}).
+-record(constraint,{c,e}).
+
%% parse all types in module
parse(Tokens) ->
case catch parse_ModuleDefinition(Tokens) of
@@ -458,7 +462,8 @@ parse_BuiltinType([{'INSTANCE',_},{'OF',_}|Rest]) ->
{DefinedObjectClass,Rest2} = parse_DefinedObjectClass(Rest),
case Rest2 of
[{'(',_}|_] ->
- {Constraint,Rest3} = parse_Constraint(Rest2),
+ {Constraint0,Rest3} = parse_Constraint(Rest2),
+ Constraint = merge_constraints([Constraint0]),
{#type{def={'INSTANCE OF',DefinedObjectClass,Constraint}},Rest3};
_ ->
{#type{def={'INSTANCE OF',DefinedObjectClass,[]}},Rest2}
diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl
index 764555c4d2..ecdfa3f645 100644
--- a/lib/asn1/src/asn1ct_value.erl
+++ b/lib/asn1/src/asn1ct_value.erl
@@ -51,8 +51,6 @@ from_type(M,Typename,Type) when is_record(Type,type) ->
from_type(Emod,Etype);
{_,user} ->
from_type(M,InnerType);
- {notype,_} ->
- true;
{primitive,bif} ->
from_type_prim(M, Type);
'ASN1_OPEN_TYPE' ->
@@ -216,8 +214,6 @@ from_type_prim(M, D) ->
_ ->
[lists:nth(random(length(NN)),NN)]
end;
- 'ANY' ->
- exit({asn1_error,nyi,'ANY'});
'NULL' ->
'NULL';
'OBJECT IDENTIFIER' ->
diff --git a/lib/asn1/src/asn1rtt_ber.erl b/lib/asn1/src/asn1rtt_ber.erl
index 5fbf116747..b5429fe324 100644
--- a/lib/asn1/src/asn1rtt_ber.erl
+++ b/lib/asn1/src/asn1rtt_ber.erl
@@ -27,7 +27,8 @@
skip_ExtensionAdditions/2]).
-export([encode_boolean/2,decode_boolean/2,
encode_integer/2,encode_integer/3,
- decode_integer/3,decode_integer/4,
+ decode_integer/2,decode_integer/3,
+ decode_named_integer/3,decode_named_integer/4,
encode_enumerated/2,decode_enumerated/3,
encode_bit_string/4,
decode_named_bit_string/3,
@@ -41,9 +42,7 @@
decode_restricted_string/2,decode_restricted_string/3,
encode_universal_string/2,decode_universal_string/3,
encode_UTF8_string/2,decode_UTF8_string/2,
- encode_BMP_string/2,decode_BMP_string/3,
- encode_generalized_time/2,decode_generalized_time/3,
- encode_utc_time/2,decode_utc_time/3]).
+ encode_BMP_string/2,decode_BMP_string/3]).
-export([encode_open_type/2,decode_open_type/2,
decode_open_type_as_binary/2]).
@@ -700,11 +699,20 @@ encode_integer_neg(N, Acc) ->
%% (Buffer, Range, NamedNumberList, HasTag, TotalLen) -> {Integer, Remain, RemovedBytes}
%%===============================================================================
-decode_integer(Tlv, Range, NamedNumberList, TagIn) ->
+decode_named_integer(Tlv, NamedNumberList, TagIn) ->
+ V = match_tags(Tlv, TagIn),
+ Int = decode_integer(V),
+ number2name(Int, NamedNumberList).
+
+decode_named_integer(Tlv, Range, NamedNumberList, TagIn) ->
V = match_tags(Tlv, TagIn),
Int = range_check_integer(decode_integer(V), Range),
number2name(Int, NamedNumberList).
+decode_integer(Tlv, TagIn) ->
+ V = match_tags(Tlv, TagIn),
+ decode_integer(V).
+
decode_integer(Tlv, Range, TagIn) ->
V = match_tags(Tlv, TagIn),
Int = decode_integer(V),
@@ -715,21 +723,10 @@ decode_integer(Bin) ->
<<Int:Len/signed-unit:8>> = Bin,
Int.
+range_check_integer(Int, {Lb,Ub}) when Lb =< Int, Int =< Ub ->
+ Int;
range_check_integer(Int, Range) ->
- case Range of
- [] -> % No length constraint
- Int;
- {Lb,Ub} when Int >= Lb, Ub >= Int -> % variable length constraint
- Int;
- {_,_} ->
- exit({error,{asn1,{integer_range,Range,Int}}});
- Int -> % fixed value constraint
- Int;
- SingleValue when is_integer(SingleValue) ->
- exit({error,{asn1,{integer_range,Range,Int}}});
- _ -> % some strange constraint that we don't support yet
- Int
- end.
+ exit({error,{asn1,{integer_range,Range,Int}}}).
number2name(Int, []) ->
Int;
@@ -838,8 +835,8 @@ int_to_bitlist(Int) when is_integer(Int), Int >= 0 ->
%% and BinBits is a binary representing the BIT STRING.
%%=================================================================
encode_bin_bit_string(C,{Unused,BinBits},_NamedBitList,TagIn)->
- case get_constraint(C,'SizeConstraint') of
- no ->
+ case C of
+ [] ->
remove_unused_then_dotag(TagIn, Unused, BinBits);
{_Min,Max} ->
BBLen = (byte_size(BinBits)*8)-Unused,
@@ -885,8 +882,8 @@ remove_unused_then_dotag(TagIn,Unused,BinBits) ->
encode_bit_string_named(C, [FirstVal | RestVal], NamedBitList, TagIn) ->
ToSetPos = get_all_bitposes([FirstVal | RestVal], NamedBitList, []),
Size =
- case get_constraint(C,'SizeConstraint') of
- no ->
+ case C of
+ [] ->
lists:max(ToSetPos)+1;
{_Min,Max} ->
Max;
@@ -943,8 +940,8 @@ make_and_set_list(Len, [], XPos) ->
%% Encode bit string for lists of ones and zeroes
%%=================================================================
encode_bit_string_bits(C, BitListVal, _NamedBitList, TagIn) when is_list(BitListVal) ->
- case get_constraint(C,'SizeConstraint') of
- no ->
+ case C of
+ [] ->
{Len, Unused, OctetList} = encode_bitstring(BitListVal),
%%add unused byte to the Len
encode_tags(TagIn, [Unused | OctetList], Len+1);
@@ -957,7 +954,7 @@ encode_bit_string_bits(C, BitListVal, _NamedBitList, TagIn) when is_list(BitList
Constr={{_,_},{_,_}} ->%{{Min1,Max1},{Min2,Max2}}
%% constraint with extension mark
encode_constr_bit_str_bits(Constr,BitListVal,TagIn);
- Size ->
+ Size when is_integer(Size) ->
case length(BitListVal) of
BitSize when BitSize == Size ->
{Len, Unused, OctetList} = encode_bitstring(BitListVal),
@@ -1266,27 +1263,14 @@ decode_restricted_string(Tlv, Range, TagsIn) ->
Bin = match_and_collect(Tlv, TagsIn),
check_restricted_string(binary_to_list(Bin), byte_size(Bin), Range).
-check_restricted_string(Val, StrLen, Range) ->
- case Range of
- {Lb,Ub} when StrLen >= Lb, Ub >= StrLen -> % variable length constraint
- Val;
- {{Lb,_Ub},[]} when StrLen >= Lb ->
- Val;
- {{Lb,_Ub},_Ext=[Min|_]} when StrLen >= Lb; StrLen >= Min ->
- Val;
- {{Lb1,Ub1},{Lb2,Ub2}} when StrLen >= Lb1, StrLen =< Ub1;
- StrLen =< Ub2, StrLen >= Lb2 ->
- Val;
- StrLen -> % fixed length constraint
- Val;
- {_,_} ->
- exit({error,{asn1,{length,Range,Val}}});
- _Len when is_integer(_Len) ->
- exit({error,{asn1,{length,Range,Val}}});
- _ -> % some strange constraint that we don't support yet
- Val
- end.
-
+check_restricted_string(Val, _Len, []) ->
+ Val;
+check_restricted_string(Val, Len, {Lb,Ub}) when Lb =< Len, Len =< Ub ->
+ Val;
+check_restricted_string(Val, Len, Len) ->
+ Val;
+check_restricted_string(Val, _Len, Range) ->
+ exit({error,{asn1,{length,Range,Val}}}).
%%============================================================================
%% encode Universal string
@@ -1390,56 +1374,6 @@ mk_BMP_string([0,B|T], US) ->
mk_BMP_string([C,D|T], US) ->
mk_BMP_string(T, [{0,0,C,D}|US]).
-
-%%============================================================================
-%% Generalized time, ITU_T X.680 Chapter 39
-%%
-%% encode Generalized time
-%%============================================================================
-
-encode_generalized_time(OctetList, TagIn) ->
- encode_tags(TagIn, OctetList, length(OctetList)).
-
-%%============================================================================
-%% decode Generalized time
-%% (Buffer, Range, HasTag, TotalLen) -> {String, Remain, RemovedBytes}
-%%============================================================================
-
-decode_generalized_time(Tlv, _Range, Tags) ->
- Val = match_tags(Tlv, Tags),
- NewVal = case Val of
- [_H|_T]=PartList -> % constructed
- collect_parts(PartList);
- Bin ->
- Bin
- end,
- binary_to_list(NewVal).
-
-%%============================================================================
-%% Universal time, ITU_T X.680 Chapter 40
-%%
-%% encode UTC time
-%%============================================================================
-
-encode_utc_time(OctetList, TagIn) ->
- encode_tags(TagIn, OctetList, length(OctetList)).
-
-%%============================================================================
-%% decode UTC time
-%% (Buffer, Range, HasTag, TotalLen) -> {String, Remain, RemovedBytes}
-%%============================================================================
-
-decode_utc_time(Tlv, _Range, Tags) ->
- Val = match_tags(Tlv, Tags),
- NewVal = case Val of
- [_|_]=PartList -> % constructed
- collect_parts(PartList);
- Bin ->
- Bin
- end,
- binary_to_list(NewVal).
-
-
%%============================================================================
%% Length handling
%%
@@ -1535,14 +1469,6 @@ match_and_collect(Tlv, TagsIn) ->
Bin
end.
-get_constraint(C, Key) ->
- case lists:keyfind(Key, 1, C) of
- false ->
- no;
- {_,V} ->
- V
- end.
-
collect_parts(TlvList) ->
collect_parts(TlvList, []).
diff --git a/lib/asn1/src/asn1rtt_per.erl b/lib/asn1/src/asn1rtt_per.erl
index aa6cf4da0a..9f4b7500d8 100644
--- a/lib/asn1/src/asn1rtt_per.erl
+++ b/lib/asn1/src/asn1rtt_per.erl
@@ -19,7 +19,7 @@
-module(asn1rtt_per).
-export([setext/1, fixextensions/2,
- skipextensions/3, getbit/1, getchoice/3,
+ skipextensions/3,
set_choice/3,encode_integer/2,
encode_small_number/1,
encode_constrained_number/2,
@@ -36,7 +36,7 @@
encode_VideotexString/2,
encode_ObjectDescriptor/2,
encode_UTF8String/1,
- encode_octet_string/3,
+ encode_octet_string/2,
encode_known_multiplier_string/4,
octets_to_complete/2]).
@@ -88,23 +88,6 @@ skipextensions(Bytes0, Nr, ExtensionBitstr) when is_bitstring(ExtensionBitstr) -
Bytes0
end.
-
-getchoice(Bytes, 1, 0) -> % only 1 alternative is not encoded
- {0,Bytes};
-getchoice(Bytes, _, 1) ->
- decode_small_number(Bytes);
-getchoice(Bytes, NumChoices, 0) ->
- decode_constrained_number(Bytes, {0,NumChoices-1}).
-
-
-getbit(Buffer) ->
- <<B:1,Rest/bitstring>> = Buffer,
- {B,Rest}.
-
-getbits(Buffer, Num) when is_bitstring(Buffer) ->
- <<Bs:Num,Rest/bitstring>> = Buffer,
- {Bs,Rest}.
-
align(Bin) when is_binary(Bin) ->
Bin;
align(BitStr) when is_bitstring(BitStr) ->
@@ -112,28 +95,6 @@ align(BitStr) when is_bitstring(BitStr) ->
<<_:AlignBits,Rest/binary>> = BitStr,
Rest.
-
-%% First align buffer, then pick the first Num octets.
-%% Returns octets as an integer with bit significance as in buffer.
-getoctets(Buffer, Num) when is_binary(Buffer) ->
- <<Val:Num/integer-unit:8,RestBin/binary>> = Buffer,
- {Val,RestBin};
-getoctets(Buffer, Num) when is_bitstring(Buffer) ->
- AlignBits = bit_size(Buffer) rem 8,
- <<_:AlignBits,Val:Num/integer-unit:8,RestBin/binary>> = Buffer,
- {Val,RestBin}.
-
-
-%% First align buffer, then pick the first Num octets.
-%% Returns octets as a binary
-getoctets_as_bin(Bin,Num) when is_binary(Bin) ->
- <<Octets:Num/binary,RestBin/binary>> = Bin,
- {Octets,RestBin};
-getoctets_as_bin(Bin,Num) when is_bitstring(Bin) ->
- AlignBits = bit_size(Bin) rem 8,
- <<_:AlignBits,Val:Num/binary,RestBin/binary>> = Bin,
- {Val,RestBin}.
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% set_choice(Alt,Choices,Altnum) -> ListofBitSettings
%% Alt = atom()
@@ -185,15 +146,7 @@ set_choice_tag(_Alt,[],_Tag) ->
%% | binary
%% Contraint = not used in this version
%%
-encode_open_type(Val) when is_list(Val) ->
- Bin = list_to_binary(Val),
- case byte_size(Bin) of
- Size when Size > 255 ->
- [encode_length(Size),21,<<Size:16>>,Bin];
- Size ->
- [encode_length(Size),20,Size,Bin]
- end;
-encode_open_type(Val) when is_binary(Val) ->
+encode_open_type(Val) ->
case byte_size(Val) of
Size when Size > 255 ->
[encode_length(Size),21,<<Size:16>>,Val]; % octets implies align
@@ -220,7 +173,7 @@ encode_integer([{'ValueRange',{Lb,Ub}=VR,Range,PreEnc}],Val)
when Val >= Lb, Ub >= Val ->
%% this case when NamedNumberList
encode_constrained_number(VR, Range, PreEnc, Val);
-encode_integer([{'ValueRange',{Lb,'MAX'}}], Val) ->
+encode_integer([{'ValueRange',{Lb,'MAX'}}], Val) when Lb =< Val ->
encode_semi_constrained_number(Lb, Val);
encode_integer([{'ValueRange',{'MIN',_}}], Val) ->
encode_unconstrained_number(Val);
@@ -238,15 +191,6 @@ encode_small_number(Val) when Val < 64 ->
encode_small_number(Val) ->
[1|encode_semi_constrained_number(0, Val)].
-decode_small_number(Bytes) ->
- {Bit,Bytes2} = getbit(Bytes),
- case Bit of
- 0 ->
- getbits(Bytes2, 6);
- 1 ->
- decode_semi_constrained_number(Bytes2)
- end.
-
%% X.691:10.7 Encoding of a semi-constrained whole number
encode_semi_constrained_number(Lb, Val) ->
Val2 = Val - Lb,
@@ -261,10 +205,6 @@ encode_semi_constrained_number(Lb, Val) ->
[encode_length(Len),21,<<Len:16>>|Oct]
end.
-decode_semi_constrained_number(Bytes) ->
- {Len,Bytes2} = decode_length(Bytes),
- getoctets(Bytes2, Len).
-
encode_constrained_number({Lb,_Ub},_Range,{bits,N},Val) ->
Val2 = Val-Lb,
[10,N,Val2];
@@ -333,47 +273,6 @@ encode_constrained_number({Lb,Ub}, Val) when Val >= Lb, Ub >= Val ->
encode_constrained_number({_,_},Val) ->
exit({error,{asn1,{illegal_value,Val}}}).
-decode_constrained_number(Buffer,VR={Lb,Ub}) ->
- Range = Ub - Lb + 1,
- decode_constrained_number(Buffer,VR,Range).
-
-decode_constrained_number(Buffer,{Lb,_Ub},Range) ->
- % Val2 = Val - Lb,
- {Val,Remain} =
- if
- Range == 1 ->
- {0,Buffer};
- Range == 2 ->
- getbits(Buffer,1);
- Range =< 4 ->
- getbits(Buffer,2);
- Range =< 8 ->
- getbits(Buffer,3);
- Range =< 16 ->
- getbits(Buffer,4);
- Range =< 32 ->
- getbits(Buffer,5);
- Range =< 64 ->
- getbits(Buffer,6);
- Range =< 128 ->
- getbits(Buffer,7);
- Range =< 255 ->
- getbits(Buffer,8);
- Range =< 256 ->
- getoctets(Buffer,1);
- Range =< 65536 ->
- getoctets(Buffer,2);
- Range =< (1 bsl (255*8)) ->
- OList = binary:bin_to_list(binary:encode_unsigned(Range - 1)),
- RangeOctLen = length(OList),
- {Len, Bytes} = decode_length(Buffer, {1, RangeOctLen}),
- {Octs, RestBytes} = getoctets_as_bin(Bytes, Len),
- {binary:decode_unsigned(Octs), RestBytes};
- true ->
- exit({not_supported,{integer_range,Range}})
- end,
- {Val+Lb,Remain}.
-
%% For some reason the minimum bits needed in the length field in
%% the encoding of constrained whole numbers must always be at least 2?
minimum_bits(N) when N < 4 -> 2;
@@ -440,22 +339,17 @@ encode_length(Len) -> % unconstrained
exit({error,{asn1,{encode_length,{nyi,above_16k}}}})
end.
-encode_length(undefined, Len) -> % un-constrained
- encode_length(Len);
-encode_length({0,'MAX'},Len) ->
- encode_length(undefined,Len);
-encode_length({Lb,Ub}=Vr, Len) when Ub =< 65535 ,Lb >= 0 -> % constrained
- encode_constrained_number(Vr,Len);
-encode_length({Lb,_Ub}, Len) when is_integer(Lb), Lb >= 0 -> % Ub > 65535
- encode_length(Len);
-encode_length({{Lb,Ub}=Vr,Ext}, Len)
- when Ub =< 65535 ,Lb >= 0,Len=<Ub, is_list(Ext) ->
- %% constrained extensible
- [0|encode_constrained_number(Vr,Len)];
-encode_length({{Lb,_},Ext},Len) when is_list(Ext) ->
- [1|encode_semi_constrained_number(Lb, Len)];
-encode_length(SingleValue, _Len) when is_integer(SingleValue) ->
- [].
+encode_length({C,[]}, Len) ->
+ case C of
+ {Lb,Ub}=Vr when Lb =< Len, Len =< Ub ->
+ [0|encode_constrained_number(Vr, Len)];
+ _ ->
+ [1|encode_length(Len)]
+ end;
+encode_length(Len, Len) ->
+ [];
+encode_length(Vr, Len) ->
+ encode_constrained_number(Vr, Len).
%% X.691 10.9.3.4 (only used for length of bitmap that prefixes extension
%% additions in a sequence or set
@@ -476,11 +370,6 @@ decode_length(Buffer) -> % un-constrained
exit({error,{asn1,{decode_length,{nyi,above_16k}}}})
end.
-decode_length(Buffer, {Lb,Ub}) when Ub =< 65535, Lb >= 0 -> % constrained
- decode_constrained_number(Buffer, {Lb,Ub});
-decode_length(Buffer, {Lb,_Ub}) when is_integer(Lb), Lb >= 0 -> % Ub > 65535
- decode_length(Buffer).
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% bitstring NamedBitList
%% Val can be of:
@@ -758,40 +647,40 @@ make_and_set_list([], _) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% X.691:16
-%% encode_octet_string(Constraint,ExtensionMarker,Val)
+%% encode_octet_string(Constraint, Val)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-encode_octet_string(_C, true, _Val) ->
- exit({error,{asn1,{'not_supported',extensionmarker}}});
-encode_octet_string({_,_}=SZ, false, Val) ->
+encode_octet_string({{Sv,Sv},Ext}=SZ, Val) when is_list(Ext), Sv =< 2 ->
Len = length(Val),
try
- [encode_length(SZ, Len),2|octets_to_complete(Len, Val)]
+ case encode_length(SZ, Len) of
+ [0|_]=EncLen ->
+ [EncLen,45,Sv*8,Sv,Val];
+ [_|_]=EncLen ->
+ [EncLen|octets_to_complete(Len, Val)]
+ end
catch
exit:{error,{asn1,{encode_length,_}}} ->
encode_fragmented_octet_string(Val)
end;
-encode_octet_string(SZ, false, Val) when is_list(SZ) ->
+encode_octet_string({_,_}=SZ, Val) ->
Len = length(Val),
try
- [encode_length({hd(SZ),lists:max(SZ)},Len),2|
- octets_to_complete(Len,Val)]
+ [encode_length(SZ, Len),2|octets_to_complete(Len, Val)]
catch
exit:{error,{asn1,{encode_length,_}}} ->
encode_fragmented_octet_string(Val)
end;
-encode_octet_string(Sv, false, Val) when is_integer(Sv) ->
+encode_octet_string(Sv, Val) when is_integer(Sv) ->
encode_fragmented_octet_string(Val);
-encode_octet_string(no, false, Val) ->
+encode_octet_string(no, Val) ->
Len = length(Val),
try
[encode_length(Len),2|octets_to_complete(Len, Val)]
catch
exit:{error,{asn1,{encode_length,_}}} ->
encode_fragmented_octet_string(Val)
- end;
-encode_octet_string(C, _, _) ->
- exit({error,{not_implemented,C}}).
+ end.
encode_fragmented_octet_string(Val) ->
Bin = iolist_to_binary(Val),
@@ -825,12 +714,24 @@ encode_restricted_string(Val) when is_list(Val)->
encode_known_multiplier_string(SizeC, NumBits, CharOutTab, Val) ->
Result = chars_encode2(Val, NumBits, CharOutTab),
case SizeC of
- Ub when is_integer(Ub), Ub*NumBits =< 16 ->
+ Ub when is_integer(Ub), Ub*NumBits < 16 ->
Result;
- Ub when is_integer(Ub), Ub =<65535 -> % fixed length
+ Ub when is_integer(Ub) ->
[2,Result];
- {Ub,Lb} ->
- [encode_length({Ub,Lb},length(Val)),2,Result];
+ {{_,Ub},Ext}=SZ when is_list(Ext) ->
+ Len = length(Val),
+ case encode_length(SZ, Len) of
+ [0|_]=EncLen when Ub*NumBits < 16 ->
+ [EncLen,45,Len*NumBits,Len,Val];
+ [_|_]=EncLen ->
+ [EncLen,2|Result]
+ end;
+ {_,Ub}=Range ->
+ [encode_length(Range, length(Val))|
+ if
+ Ub*NumBits < 16 -> Result;
+ true -> [2|Result]
+ end];
no ->
[encode_length(length(Val)),2,Result]
end.
diff --git a/lib/asn1/src/asn1rtt_uper.erl b/lib/asn1/src/asn1rtt_uper.erl
index 8efe9a7b0f..a5035c6660 100644
--- a/lib/asn1/src/asn1rtt_uper.erl
+++ b/lib/asn1/src/asn1rtt_uper.erl
@@ -21,7 +21,7 @@
-export([setext/1, fixoptionals/3,
fixextensions/2,
- skipextensions/3, getbit/1, getchoice/3 ]).
+ skipextensions/3]).
-export([set_choice/3, encode_integer/2, encode_integer/3]).
-export([encode_small_number/1, encode_constrained_number/2,
encode_boolean/1,
@@ -34,17 +34,17 @@
-export([encode_open_type/1]).
- -export([encode_UniversalString/2,
- encode_PrintableString/2,
+ -export([encode_UniversalString/3,
+ encode_PrintableString/3,
encode_GeneralString/2,
encode_GraphicString/2,
encode_TeletexString/2,
encode_VideotexString/2,
- encode_VisibleString/2,
+ encode_VisibleString/3,
encode_UTF8String/1,
- encode_BMPString/2,
- encode_IA5String/2,
- encode_NumericString/2,
+ encode_BMPString/3,
+ encode_IA5String/3,
+ encode_NumericString/3,
encode_ObjectDescriptor/2
]).
@@ -123,29 +123,6 @@ skipextensions(Bytes0, Nr, ExtensionBitstr) when is_bitstring(ExtensionBitstr) -
end.
-getchoice(Bytes,1,0) -> % only 1 alternative is not encoded
- {0,Bytes};
-getchoice(Bytes,_,1) ->
- decode_small_number(Bytes);
-getchoice(Bytes,NumChoices,0) ->
- decode_constrained_number(Bytes,{0,NumChoices-1}).
-
-
-getbit(Buffer) ->
- <<B:1,Rest/bitstring>> = Buffer,
- {B,Rest}.
-
-getbits(Buffer, Num) when is_bitstring(Buffer) ->
- <<Bs:Num,Rest/bitstring>> = Buffer,
- {Bs,Rest}.
-
-
-%% Pick the first Num octets.
-%% Returns octets as an integer with bit significance as in buffer.
-getoctets(Buffer, Num) when is_bitstring(Buffer) ->
- <<Val:Num/integer-unit:8,RestBitStr/bitstring>> = Buffer,
- {Val,RestBitStr}.
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% set_choice(Alt,Choices,Altnum) -> ListofBitSettings
%% Alt = atom()
@@ -198,9 +175,7 @@ set_choice_tag(_Alt,[],_Tag) ->
%% | binary
%% Contraint = not used in this version
%%
-encode_open_type(Val) when is_list(Val) ->
- encode_open_type(list_to_binary(Val));
-encode_open_type(Val) when is_binary(Val) ->
+encode_open_type(Val) ->
[encode_length(byte_size(Val)),Val].
@@ -248,7 +223,7 @@ encode_integer1(C, Val) ->
case VR = get_constraint(C, 'ValueRange') of
no ->
encode_unconstrained_number(Val);
- {Lb,'MAX'} ->
+ {Lb,'MAX'} when Lb =< Val ->
encode_semi_constrained_number(Lb, Val);
%% positive with range
{Lb,Ub} when Val >= Lb, Ub >= Val ->
@@ -265,15 +240,6 @@ encode_small_number(Val) when Val < 64 ->
encode_small_number(Val) ->
[<<1:1>>|encode_semi_constrained_number(0, Val)].
-decode_small_number(Bytes) ->
- {Bit,Bytes2} = getbit(Bytes),
- case Bit of
- 0 ->
- getbits(Bytes2,6);
- 1 ->
- decode_semi_constrained_number(Bytes2)
- end.
-
%% X.691:10.7 Encoding of a semi-constrained whole number
encode_semi_constrained_number(Lb, Val) ->
%% encoding in minimum number of octets preceeded by a length
@@ -289,11 +255,6 @@ encode_semi_constrained_number(Lb, Val) ->
[encode_length(Size),Bin]
end.
-decode_semi_constrained_number(Bytes) ->
- {Len,Bytes2} = decode_length(Bytes),
- {V,Bytes3} = getoctets(Bytes2,Len),
- {V,Bytes3}.
-
encode_constrained_number({Lb,Ub}, Val) when Val >= Lb, Ub >= Val ->
Range = Ub - Lb + 1,
Val2 = Val - Lb,
@@ -302,13 +263,6 @@ encode_constrained_number({Lb,Ub}, Val) when Val >= Lb, Ub >= Val ->
encode_constrained_number(Range,Val) ->
exit({error,{asn1,{integer_range,Range,value,Val}}}).
-
-decode_constrained_number(Buffer, {Lb,Ub}) ->
- Range = Ub - Lb + 1,
- NumBits = num_bits(Range),
- {Val,Remain} = getbits(Buffer,NumBits),
- {Val+Lb,Remain}.
-
%% X.691:10.8 Encoding of an unconstrained whole number
encode_unconstrained_number(Val) when Val >= 0 ->
@@ -390,22 +344,18 @@ encode_length(Len) -> % un-constrained
error({error,{asn1,{encode_length,{nyi,above_16k}}}})
end.
-encode_length(undefined, Len) -> % unconstrained
- encode_length(Len);
-encode_length({0,'MAX'},Len) ->
- encode_length(undefined, Len);
-encode_length({Lb,Ub}=Vr, Len) when Ub =< 65535, Lb >= 0 -> % constrained
- encode_constrained_number(Vr,Len);
-encode_length({Lb,_Ub}, Len) when is_integer(Lb), Lb >= 0 -> % Ub > 65535
- encode_length(Len);
-encode_length({{Lb,Ub}=Vr,Ext},Len)
- when Ub =< 65535, Lb >= 0, Len =< Ub, is_list(Ext) ->
- %% constrained extensible
- [<<0:1>>,encode_constrained_number(Vr,Len)];
-encode_length({{Lb,_Ub},Ext}, Len) when is_list(Ext) ->
- [<<1:1>>,encode_semi_constrained_number(Lb, Len)];
-encode_length(SingleValue, _Len) when is_integer(SingleValue) ->
- [].
+encode_length({C,[]}, Len) ->
+ case C of
+ {Lb,Ub}=Vr when Lb =< Len, Len =< Ub ->
+ [<<0:1>>|encode_constrained_number(Vr, Len)];
+ _ ->
+ [<<1:1>>|encode_length(Len)]
+ end;
+encode_length(Len, Len) ->
+ [];
+encode_length(Vr, Len) ->
+ encode_constrained_number(Vr, Len).
+
%% X.691 10.9.3.4 (only used for length of bitmap that prefixes extension
%% additions in a sequence or set
@@ -687,10 +637,6 @@ encode_octet_string(Val) ->
encode_octet_string(C, Val) ->
case C of
- 1 ->
- list_to_binary(Val);
- 2 ->
- list_to_binary(Val);
{_,_}=VR ->
try
[encode_length(VR, length(Val)),list_to_binary(Val)]
@@ -699,20 +645,7 @@ encode_octet_string(C, Val) ->
encode_fragmented_octet_string(Val)
end;
Sv when is_integer(Sv), Sv =:= length(Val) -> % fixed length
- if
- Sv =< 65535 ->
- list_to_binary(Val);
- true ->
- encode_fragmented_octet_string(Val)
- end;
- Sv when is_list(Sv) ->
- try
- [encode_length({hd(Sv),lists:max(Sv)},
- length(Val)),list_to_binary(Val)]
- catch
- error:{error,{asn1,{encode_length,_}}} ->
- encode_fragmented_octet_string(Val)
- end
+ list_to_binary(Val)
end.
@@ -742,41 +675,34 @@ efos_1(<<B/bitstring>>) ->
encode_restricted_string(Val) when is_list(Val)->
[encode_length(length(Val)),list_to_binary(Val)].
-encode_known_multiplier_string(StringType, C, Val) ->
- Result = chars_encode(C, StringType, Val),
- NumBits = get_NumBits(C, StringType),
- case get_constraint(C, 'SizeConstraint') of
- Ub when is_integer(Ub), Ub*NumBits =< 16 ->
- Result;
- 0 ->
- [];
- Ub when is_integer(Ub),Ub =<65535 -> % fixed length
+encode_known_multiplier_string(StringType, C, Pa, Val) ->
+ Result = chars_encode(Pa, StringType, Val),
+ case C of
+ Ub when is_integer(Ub) ->
Result;
- {Ub,Lb} ->
- [encode_length({Ub,Lb}, length(Val)),Result];
- Vl when is_list(Vl) ->
- [encode_length({lists:min(Vl),lists:max(Vl)}, length(Val)),Result];
+ {_,_}=Range ->
+ [encode_length(Range, length(Val)),Result];
no ->
[encode_length(length(Val)),Result]
end.
-encode_NumericString(C,Val) ->
- encode_known_multiplier_string('NumericString',C,Val).
+encode_NumericString(C, Pa, Val) ->
+ encode_known_multiplier_string('NumericString', C, Pa, Val).
-encode_PrintableString(C,Val) ->
- encode_known_multiplier_string('PrintableString',C,Val).
+encode_PrintableString(C, Pa, Val) ->
+ encode_known_multiplier_string('PrintableString', C, Pa, Val).
-encode_VisibleString(C,Val) -> % equivalent with ISO646String
- encode_known_multiplier_string('VisibleString',C,Val).
+encode_VisibleString(C, Pa, Val) -> % equivalent with ISO646String
+ encode_known_multiplier_string('VisibleString', C, Pa, Val).
-encode_IA5String(C,Val) ->
- encode_known_multiplier_string('IA5String',C,Val).
+encode_IA5String(C, Pa, Val) ->
+ encode_known_multiplier_string('IA5String', C, Pa, Val).
-encode_BMPString(C,Val) ->
- encode_known_multiplier_string('BMPString',C,Val).
+encode_BMPString(C, Pa, Val) ->
+ encode_known_multiplier_string('BMPString', C, Pa, Val).
-encode_UniversalString(C,Val) ->
- encode_known_multiplier_string('UniversalString',C,Val).
+encode_UniversalString(C, Pa, Val) ->
+ encode_known_multiplier_string('UniversalString', C, Pa, Val).
%% end of known-multiplier strings for which PER visible constraints are
@@ -805,14 +731,15 @@ encode_VideotexString(_C,Val) ->
%% into account.
%% This function does only encode the value part and NOT the length
-chars_encode(C,StringType,Value) ->
- case {StringType,get_constraint(C,'PermittedAlphabet')} of
+chars_encode(Pa, StringType, Value) ->
+ case {StringType,Pa} of
{'UniversalString',{_,_Sv}} ->
exit({error,{asn1,{'not implemented',"UniversalString with PermittedAlphabet constraint"}}});
{'BMPString',{_,_Sv}} ->
exit({error,{asn1,{'not implemented',"BMPString with PermittedAlphabet constraint"}}});
_ ->
- {NumBits,CharOutTab} = {get_NumBits(C,StringType),get_CharOutTab(C,StringType)},
+ {NumBits,CharOutTab} = {get_NumBits(Pa, StringType),
+ get_CharOutTab(Pa, StringType)},
chars_encode2(Value,NumBits,CharOutTab)
end.
@@ -839,8 +766,8 @@ exit_if_false(V,false)->
exit_if_false(_,V) ->V.
-get_NumBits(C,StringType) ->
- case get_constraint(C,'PermittedAlphabet') of
+get_NumBits(Pa, StringType) ->
+ case Pa of
{'SingleValue',Sv} ->
charbits(length(Sv));
no ->
@@ -860,22 +787,23 @@ get_NumBits(C,StringType) ->
end
end.
-get_CharOutTab(C,StringType) ->
- case get_constraint(C,'PermittedAlphabet') of
+get_CharOutTab(Pa, StringType) ->
+ case Pa of
{'SingleValue',Sv} ->
- get_CharTab2(C,StringType,hd(Sv),lists:max(Sv),Sv);
+ get_CharTab2(Pa, StringType, hd(Sv), lists:max(Sv), Sv);
no ->
case StringType of
'IA5String' ->
{0,16#7F,notab};
'VisibleString' ->
- get_CharTab2(C,StringType,16#20,16#7F,notab);
+ get_CharTab2(Pa, StringType, 16#20, 16#7F, notab);
'PrintableString' ->
Chars = lists:sort(
" '()+,-./0123456789:=?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"),
- get_CharTab2(C,StringType,hd(Chars),lists:max(Chars),Chars);
+ get_CharTab2(Pa, StringType, hd(Chars),
+ lists:max(Chars), Chars);
'NumericString' ->
- get_CharTab2(C,StringType,16#20,$9," 0123456789");
+ get_CharTab2(Pa, StringType, 16#20, $9, " 0123456789");
'UniversalString' ->
{0,16#FFFFFFFF,notab};
'BMPString' ->
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-15 06:05:47 +0000