aboutsummaryrefslogtreecommitdiffstats
path: root/lib/asn1/src/asn1ct_gen.erl
diff options
context:
space:
mode:
authorBjörn Gustavsson <[email protected]>2014-06-16 12:09:47 +0200
committerBjörn Gustavsson <[email protected]>2014-06-16 12:09:47 +0200
commita2a82c3dcf35b9a8e977a35e01a18936be22ea00 (patch)
tree51e63234882f6e94924f2e56b7489208a2656260 /lib/asn1/src/asn1ct_gen.erl
parent3e3fc4a552e083d3d5f7aebbf05f47ad1a3bc528 (diff)
parent26e63b26e605a74ba0a0a58c1fb1cb0ba358efed (diff)
downloadotp-a2a82c3dcf35b9a8e977a35e01a18936be22ea00.tar.gz
otp-a2a82c3dcf35b9a8e977a35e01a18936be22ea00.tar.bz2
otp-a2a82c3dcf35b9a8e977a35e01a18936be22ea00.zip
Merge branch 'maint'
* maint: (23 commits) BER: Eliminate dialyzer warnings for specialized decode functions BER: Eliminate dialyzer warning for encoding of BIT STRINGs BER: Optimize encoding of ENUMERATED BER: Remove a redundant clause in encoding of open types (U)PER: Fix decoding of named INTEGER (U)PER: Fix encoding of a semi-constrained, named INTEGER (U)PER: Optimize handling of named BIT STRING with a lower zero bound PER: Optimize encoding of character strings with simple ranges PER: Remove unnecessary clause for handling DEFAULT (U)PER: Suppress dialyzer warnings for complete/1 Test suites: Add support for running Dialyzer on generated code Improve tests of DEFAULT values Correct OCTET STRING default when legacy_erlang_types is active Remove old DEFAULT-checking code made obsolete in the previous commit Rewrite the code for testing DEFAULT for DER Test DEFAULT more thoroughly Set.py: Correct illegal DEFAULT value BER: Optimize decoding of ENUMERATED BER: Suppress dialyzer warnings for encode_bit_string/4 BER: Inline testing of constraints when decoding ...
Diffstat (limited to 'lib/asn1/src/asn1ct_gen.erl')
-rw-r--r--lib/asn1/src/asn1ct_gen.erl354
1 files changed, 25 insertions, 329 deletions
diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl
index 44b050e59d..450d309688 100644
--- a/lib/asn1/src/asn1ct_gen.erl
+++ b/lib/asn1/src/asn1ct_gen.erl
@@ -29,7 +29,6 @@
list2rname/1,
constructed_suffix/2,
unify_if_string/1,
- gen_check_call/7,
get_constraint/2,
insert_once/2,
ct_gen_module/1,
@@ -43,6 +42,8 @@
-export([gen_encode_constructed/4,
gen_decode_constructed/4]).
+-define(SUPPRESSION_FUNC, 'dialyzer-suppressions').
+
%% pgen(Outfile, Erules, Module, TypeOrVal, Options)
%% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module
%% .hrl file is only generated if necessary
@@ -85,12 +86,18 @@ pgen_module(OutFile,Erules,Module,
"%%%",nl,
"%%% Run-time functions.",nl,
"%%%",nl]),
+ dialyzer_suppressions(Erules),
Fd = get(gen_file_out),
asn1ct_func:generate(Fd),
close_output_file(),
_ = erase(outfile),
asn1ct:verbose("--~p--~n",[{generated,ErlFile}],Options).
+dialyzer_suppressions(Erules) ->
+ emit([nl,
+ {asis,?SUPPRESSION_FUNC},"(Arg) ->",nl]),
+ Rtmod = ct_gen_module(Erules),
+ Rtmod:dialyzer_suppressions(Erules).
pgen_typeorval(Erules,Module,N2nConvEnums,{Types,Values,_Ptypes,_Classes,Objects,ObjectSets}) ->
Rtmod = ct_gen_module(Erules),
@@ -98,11 +105,6 @@ pgen_typeorval(Erules,Module,N2nConvEnums,{Types,Values,_Ptypes,_Classes,Objects
pgen_values(Erules,Module,Values),
pgen_objects(Rtmod,Erules,Module,Objects),
pgen_objectsets(Rtmod,Erules,Module,ObjectSets),
- case catch lists:member(der,get(encoding_options)) of
- true ->
- pgen_check_defaultval(Erules,Module);
- _ -> ok
- end,
pgen_partial_decode(Rtmod,Erules,Module).
pgen_values(_,_,[]) ->
@@ -178,23 +180,6 @@ pgen_objectsets(Rtmod,Erules,Module,[H|T]) ->
Rtmod:gen_objectset_code(Erules,TypeDef),
pgen_objectsets(Rtmod,Erules,Module,T).
-pgen_check_defaultval(Erules,Module) ->
- CheckObjects = asn1ct_table:to_list(check_functions),
- case get(asndebug) of
- true ->
- FileName = lists:concat([Module,".table"]),
- {ok,IoDevice} = file:open(FileName,[write]),
- Fun =
- fun(X)->
- io:format(IoDevice,"~n~n************~n~n~p~n~n*****"
- "********~n~n",[X])
- end,
- lists:foreach(Fun,CheckObjects),
- ok = file:close(IoDevice);
- _ -> ok
- end,
- gen_check_defaultval(Erules,Module,CheckObjects).
-
pgen_partial_decode(Rtmod,Erule,Module) when Erule == ber ->
pgen_partial_inc_dec(Rtmod,Erule,Module),
pgen_partial_dec(Rtmod,Erule,Module);
@@ -542,8 +527,7 @@ gen_part_decode_funcs({constructed,bif},TypeName,
emit([" 'dec_",TypeName,"'(Data,",{asis,Tag},")"]);
gen_part_decode_funcs({primitive,bif},_TypeName,
{_Name,undecoded,Tag,Type}) ->
- % Argument no 6 is 0, i.e. bit 6 for primitive encoding.
- asn1ct_gen_ber_bin_v2:gen_dec_prim(ber_bin_v2,Type,"Data",Tag,[],0,", mandatory, ");
+ asn1ct_gen_ber_bin_v2:gen_dec_prim(Type, "Data", Tag);
gen_part_decode_funcs(WhatKind,_TypeName,{_,Directive,_,_}) ->
throw({error,{asn1,{"Not implemented yet",WhatKind," partial incomplete directive:",Directive}}}).
@@ -576,131 +560,6 @@ gen_types(Erules,Tname,Type) when is_record(Type,type) ->
asn1ct_name:clear(),
Rtmod:gen_decode(Erules,Tname,Type).
-gen_check_defaultval(Erules,Module,[{Name,Type}|Rest]) ->
- gen_check_func(Name,Type),
- gen_check_defaultval(Erules,Module,Rest);
-gen_check_defaultval(_,_,[]) ->
- ok.
-
-gen_check_func(Name,FType = #type{def=Def}) ->
- EncName = ensure_atom(Name),
- emit({{asis,EncName},"(_V,asn1_DEFAULT) ->",nl," true;",nl}),
- emit({{asis,EncName},"(V,V) ->",nl," true;",nl}),
- emit({{asis,EncName},"(V,{_,V}) ->",nl," true;",nl}),
- case Def of
- {'SEQUENCE OF',Type} ->
- gen_check_sof(Name,'SEQOF',Type);
- {'SET OF',Type} ->
- gen_check_sof(Name,'SETOF',Type);
- #'SEQUENCE'{components=Components} ->
- gen_check_sequence(Name,Components);
- #'SET'{components=Components} ->
- gen_check_sequence(Name,Components);
- {'CHOICE',Components} ->
- gen_check_choice(Name,Components);
- #'Externaltypereference'{type=T} ->
- emit({{asis,EncName},"(DefaultValue,Value) ->",nl}),
- emit({" '",list2name([T,check]),"'(DefaultValue,Value).",nl});
- MaybePrim ->
- InnerType = get_inner(MaybePrim),
- case type(InnerType) of
- {primitive,bif} ->
- emit({{asis,EncName},"(DefaultValue,Value) ->",nl," "}),
- gen_prim_check_call(get_inner(InnerType),"DefaultValue","Value",
- FType),
- emit({".",nl,nl});
- _ ->
- throw({asn1_error,{unknown,type,MaybePrim}})
- end
- end.
-
-gen_check_sof(Name,SOF,Type) ->
- EncName = ensure_atom(Name),
- NewName = ensure_atom(list2name([sorted,Name])),
- emit({{asis,EncName},"(V1,V2) ->",nl}),
- emit({" ",{asis,NewName},"(lists:sort(V1),lists:sort(V2)).",nl,nl}),
- emit({{asis,NewName},"([],[]) ->",nl," true;",nl}),
- emit({{asis,NewName},"([DV|DVs],[V|Vs]) ->",nl," "}),
- InnerType = get_inner(Type#type.def),
- case type(InnerType) of
- {primitive,bif} ->
- gen_prim_check_call(get_inner(InnerType),"DV","V",Type),
- emit({",",nl});
- {constructed,bif} ->
- emit([{asis,ensure_atom(list2name([SOF,Name]))},"(DV, V),",nl]);
- #'Externaltypereference'{type=T} ->
- emit([{asis,ensure_atom(list2name([T,check]))},"(DV,V),",nl]);
- 'ASN1_OPEN_TYPE' ->
- emit(["DV = V,",nl]);
- _ ->
- emit(["DV = V,",nl])
- end,
- emit({" ",{asis,NewName},"(DVs,Vs).",nl,nl}).
-
-gen_check_sequence(Name, []) ->
- emit([{asis,ensure_atom(Name)},"(_,_) ->",nl,
- " throw(badval).",nl,nl]);
-gen_check_sequence(Name,Components) ->
- emit([{asis,ensure_atom(Name)},"(DefaultValue,Value) ->",nl]),
- gen_check_sequence(Name,Components,1).
-
-gen_check_sequence(Name,[#'ComponentType'{name=N,typespec=Type}|Cs],Num) ->
- InnerType = get_inner(Type#type.def),
- NthDefV = ["element(",Num+1,",DefaultValue)"],
- NthV = ["element(",Num+1,",Value)"],
- gen_check_func_call(Name,Type,InnerType,NthDefV,NthV,N),
- case Cs of
- [] ->
- emit({".",nl,nl});
- _ ->
- emit({",",nl}),
- gen_check_sequence(Name,Cs,Num+1)
- end.
-
-gen_check_choice(Name,CList=[#'ComponentType'{}|_Cs]) ->
- emit([{asis,ensure_atom(Name)},"({Id,DefaultValue},{Id,Value}) ->",nl]),
- emit([" case Id of",nl]),
- gen_check_choice_components(Name,CList,1).
-
-gen_check_choice_components(_,[],_)->
- ok;
-gen_check_choice_components(Name,[#'ComponentType'{name=N,typespec=Type}|
- Cs],Num) ->
- Ind6 = " ",
- InnerType = get_inner(Type#type.def),
- emit({Ind6,"'",N,"' ->",nl,Ind6}),
- gen_check_func_call(Name,Type,InnerType,{var,"defaultValue"},
- {var,"value"},N),
- case Cs of
- [] ->
- emit({nl," end.",nl,nl});
- _ ->
- emit({";",nl}),
- gen_check_choice_components(Name,Cs,Num+1)
- end.
-
-gen_check_func_call(Name,Type,InnerType,DefVal,Val,N) ->
- case type(InnerType) of
- {primitive,bif} ->
- emit(" "),
- gen_prim_check_call(get_inner(InnerType),DefVal,Val,Type);
- #'Externaltypereference'{type=T} ->
- emit({" ",{asis,ensure_atom(list2name([T,check]))},"(",DefVal,",",Val,")"});
- 'ASN1_OPEN_TYPE' ->
- emit([" if",nl,
- " ",DefVal," == ",Val," -> true;",nl,
- " true -> throw({error,{asn1_open_type}})",nl,
- " end",nl]);
- {constructed,bif} ->
- emit([" ",{asis,ensure_atom(list2name([N,Name]))},"(",DefVal,",",Val,")"]);
- _ ->
- emit([" if",nl,
- " ",DefVal," == ",Val," -> true;",nl,
- " true -> throw({error,{asn1_open_type}})",nl,
- " end",nl])
- end.
-
-
%% VARIOUS GENERATOR STUFF
%% *************************************************
%%**************************************************
@@ -790,8 +649,9 @@ gen_decode_constructed(Erules,Typename,InnerType,D) when is_record(D,typedef) ->
pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) ->
- emit(["-export([encoding_rule/0,bit_string_format/0,"
+ emit(["-export([encoding_rule/0,bit_string_format/0,",nl,
" legacy_erlang_types/0]).",nl]),
+ emit(["-export([",{asis,?SUPPRESSION_FUNC},"/1]).",nl]),
case Types of
[] -> ok;
_ ->
@@ -1077,9 +937,10 @@ gen_partial_inc_dispatcher() ->
ok;
{Data1,Data2} ->
% io:format("partial_incomplete_decode: ~p~ninc_type_pattern: ~p~n",[Data,Data2]),
- gen_partial_inc_dispatcher(Data1,Data2)
+ gen_partial_inc_dispatcher(Data1, Data2, "")
end.
-gen_partial_inc_dispatcher([{FuncName,TopType,_Pattern}|Rest],TypePattern) ->
+
+gen_partial_inc_dispatcher([{FuncName,TopType,_Pattern}|Rest], TypePattern, Sep) ->
TPattern =
case lists:keysearch(FuncName,1,TypePattern) of
{value,{_,TP}} -> TP;
@@ -1093,13 +954,13 @@ gen_partial_inc_dispatcher([{FuncName,TopType,_Pattern}|Rest],TypePattern) ->
_ ->
atom_to_list(TopType)
end,
- emit(["decode_partial_inc_disp('",TopTypeName,"',Data) ->",nl,
+ emit([Sep,
+ "decode_partial_inc_disp('",TopTypeName,"',Data) ->",nl,
" ",{asis,list_to_atom(lists:concat(["dec-inc-",FuncName2]))},
- "(Data);",nl]),
- gen_partial_inc_dispatcher(Rest,TypePattern);
-gen_partial_inc_dispatcher([],_) ->
- emit(["decode_partial_inc_disp(Type,_Data) ->",nl,
- " exit({error,{asn1,{undefined_type,Type}}}).",nl]).
+ "(Data)"]),
+ gen_partial_inc_dispatcher(Rest, TypePattern, ";\n");
+gen_partial_inc_dispatcher([], _, _) ->
+ emit([".",nl]).
gen_dispatcher([F1,F2|T],FuncName,Prefix,ExtraArg) ->
emit([FuncName,"('",F1,"',Data) -> '",Prefix,F1,"'(Data",ExtraArg,")",";",nl]),
@@ -1465,171 +1326,6 @@ to_textual_order(Cs=[#'ComponentType'{textual_order=undefined}|_]) ->
to_textual_order(Cs) when is_list(Cs) ->
lists:keysort(#'ComponentType'.textual_order,Cs).
-
-gen_check_call(TopType,Cname,Type,InnerType,WhatKind,DefaultValue,Element) ->
- case WhatKind of
- {primitive,bif} ->
- gen_prim_check_call(InnerType,DefaultValue,Element,Type);
- #'Externaltypereference'{module=M,type=T} ->
- %% generate function call
- Name = list2name([T,check]),
- emit({"'",Name,"'(",DefaultValue,", ",Element,")"}),
- %% insert in ets table and do look ahead check
- Typedef = asn1_db:dbget(M,T),
- RefType = Typedef#typedef.typespec,
- InType = asn1ct_gen:get_inner(RefType#type.def),
- case insert_once(check_functions,{Name,RefType}) of
- true ->
- lookahead_innertype([T],InType,RefType);
- _ ->
- ok
- end;
- {constructed,bif} ->
- NameList = [Cname|TopType],
- Name = list2name(NameList ++ [check]),
- emit({"'",Name,"'(",DefaultValue,", ",Element,")"}),
- asn1ct_table:insert(check_functions, {Name, Type}),
- %% Must look for check functions in InnerType,
- %% that may be referenced or internal defined
- %% constructed types not used elsewhere.
- lookahead_innertype(NameList,InnerType,Type);
- _ ->
- %% Generate Dummy function call i.e. anything is accepted
- emit(["fun() -> true end ()"])
- end.
-
-gen_prim_check_call(PrimType, Default, Element, Type) ->
- case unify_if_string(PrimType) of
- 'BOOLEAN' ->
- check_call(check_bool, [Default,Element]);
- 'INTEGER' ->
- NNL = case Type#type.def of
- {_,NamedNumberList} -> NamedNumberList;
- _ -> []
- end,
- check_call(check_int, [Default,Element,{asis,NNL}]);
- 'BIT STRING' ->
- case Type#type.def of
- {_,[]} ->
- check_call(check_bitstring,
- [Default,Element]);
- {_,[_|_]=NBL} ->
- check_call(check_named_bitstring,
- [Default,Element,{asis,NBL}])
- end;
- 'OCTET STRING' ->
- check_call(check_octetstring, [Default,Element]);
- 'NULL' ->
- check_call(check_null, [Default,Element]);
- 'OBJECT IDENTIFIER' ->
- check_call(check_objectidentifier, [Default,Element]);
- 'RELATIVE-OID' ->
- check_call(check_objectidentifier, [Default,Element]);
- 'ObjectDescriptor' ->
- check_call(check_objectdescriptor, [Default,Element]);
- 'REAL' ->
- check_call(check_real, [Default,Element]);
- 'ENUMERATED' ->
- {_,Enumerations} = Type#type.def,
- check_call(check_enum, [Default,Element,{asis,Enumerations}]);
- restrictedstring ->
- check_call(check_restrictedstring, [Default,Element])
- end.
-
-check_call(F, Args) ->
- asn1ct_func:call(check, F, Args).
-
-%% lokahead_innertype/3 traverses Type and checks if check functions
-%% have to be generated, i.e. for all constructed or referenced types.
-lookahead_innertype(Name,'SEQUENCE',Type) ->
- Components = (Type#type.def)#'SEQUENCE'.components,
- lookahead_components(Name,Components);
-lookahead_innertype(Name,'SET',Type) ->
- Components = (Type#type.def)#'SET'.components,
- lookahead_components(Name,Components);
-lookahead_innertype(Name,'CHOICE',Type) ->
- {_,Components} = Type#type.def,
- lookahead_components(Name,Components);
-lookahead_innertype(Name,'SEQUENCE OF',SeqOf) ->
- lookahead_sof(Name,'SEQOF',SeqOf);
-lookahead_innertype(Name,'SET OF',SeqOf) ->
- lookahead_sof(Name,'SETOF',SeqOf);
-lookahead_innertype(_Name,#'Externaltypereference'{module=M,type=T},_) ->
- Typedef = asn1_db:dbget(M,T),
- RefType = Typedef#typedef.typespec,
- insert_once(check_functions,{list2name([T,check]),RefType}),
- InType = asn1ct_gen:get_inner(RefType#type.def),
- case type(InType) of
- {constructed,bif} ->
- lookahead_innertype([T],InType,RefType);
- Ref = #'Externaltypereference'{} ->
- lookahead_reference(Ref);
- _ ->
- ok
- end;
-lookahead_innertype(_,_,_) ->
- ok.
-
-lookahead_components(_,[]) -> ok;
-lookahead_components(Name,[C|Cs]) ->
- #'ComponentType'{name=Cname,typespec=Type} = C,
- InType = asn1ct_gen:get_inner(Type#type.def),
- case asn1ct_gen:type(InType) of
- {constructed,bif} ->
- case insert_once(check_functions,
- {list2name([Cname|Name] ++ [check]),Type}) of
- true ->
- lookahead_innertype([Cname|Name],InType,Type);
- _ ->
- ok
- end;
- #'Externaltypereference'{module=RefMod,type=RefName} ->
- Typedef = asn1_db:dbget(RefMod,RefName),
- RefType = Typedef#typedef.typespec,
- case insert_once(check_functions,{list2name([RefName,check]),
- RefType}) of
- true ->
- lookahead_innertype([RefName],InType,RefType);
- _ ->
- ok
- end;
- _ ->
- ok
- end,
- lookahead_components(Name,Cs).
-
-lookahead_sof(Name,SOF,SOFType) ->
- Type = case SOFType#type.def of
- {_,_Type} -> _Type;
- _Type -> _Type
- end,
- InnerType = asn1ct_gen:get_inner(Type#type.def),
- case asn1ct_gen:type(InnerType) of
- {constructed,bif} ->
- %% this is if a constructed type is defined in
- %% the SEQUENCE OF type
- NameList = [SOF|Name],
- insert_once(check_functions,
- {list2name(NameList ++ [check]),Type}),
- lookahead_innertype(NameList,InnerType,Type);
- Ref = #'Externaltypereference'{} ->
- lookahead_reference(Ref);
- _ ->
- ok
- end.
-
-lookahead_reference(#'Externaltypereference'{module=M,type=T}) ->
- Typedef = asn1_db:dbget(M,T),
- RefType = Typedef#typedef.typespec,
- InType = get_inner(RefType#type.def),
- case insert_once(check_functions,
- {list2name([T,check]),RefType}) of
- true ->
- lookahead_innertype([T],InType,RefType);
- _ ->
- ok
- end.
-
insert_once(Table,Object) ->
case asn1ct_table:lookup(Table, element(1, Object)) of
[] ->
@@ -1683,6 +1379,11 @@ conform_value(#type{def={'BIT STRING',[]}}, Bs) ->
bitstring when is_bitstring(Bs) ->
Bs
end;
+conform_value(#type{def='OCTET STRING'}, String) ->
+ case asn1ct:use_legacy_types() of
+ false -> String;
+ true -> binary_to_list(String)
+ end;
conform_value(_, Value) -> Value.
named_bitstring_value(List, Names) ->
@@ -1901,11 +1602,6 @@ get_constraint(C,Key) ->
{value,Cnstr} ->
Cnstr
end.
-
-ensure_atom(Atom) when is_atom(Atom) ->
- Atom;
-ensure_atom(List) when is_list(List) ->
- list_to_atom(List).
get_record_name_prefix() ->
case lists:keysearch(record_name_prefix,1,get(encoding_options)) of