diff options
author | Björn Gustavsson <[email protected]> | 2013-02-25 09:55:59 +0100 |
---|---|---|
committer | Björn Gustavsson <[email protected]> | 2013-05-31 14:52:15 +0200 |
commit | 509ccd85ef448f5843716d4b51a8b07f875cdfda (patch) | |
tree | afc6fc22fd665a3f34733b2ecf27b2c7100a9a4a /lib | |
parent | 82e02fa4ba16b0abd087437829e12049576f2a73 (diff) | |
download | otp-509ccd85ef448f5843716d4b51a8b07f875cdfda.tar.gz otp-509ccd85ef448f5843716d4b51a8b07f875cdfda.tar.bz2 otp-509ccd85ef448f5843716d4b51a8b07f875cdfda.zip |
PER/UPER: Share all code except encoding of primitives
The only code that is really different between the PER
and UPER backends is encoding of primitive types.
Diffstat (limited to 'lib')
-rw-r--r-- | lib/asn1/src/asn1ct_gen.erl | 2 | ||||
-rw-r--r-- | lib/asn1/src/asn1ct_gen_per.erl | 191 | ||||
-rw-r--r-- | lib/asn1/src/asn1ct_gen_per_rt2ct.erl | 878 | ||||
-rw-r--r-- | lib/asn1/test/asn1_SUITE_data/InfObj.asn | 9 | ||||
-rw-r--r-- | lib/asn1/test/testInfObj.erl | 3 |
5 files changed, 128 insertions, 955 deletions
diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 76c4182160..c598dafc47 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -1902,7 +1902,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_per.erl b/lib/asn1/src/asn1ct_gen_per.erl index 003ddfdb4e..f9681491df 100644 --- a/lib/asn1/src/asn1ct_gen_per.erl +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -30,8 +30,6 @@ -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([extaddgroup2sequence/1]). -import(asn1ct_gen, [emit/1,demit/1]). @@ -107,6 +105,19 @@ gen_encode_prim(Erules,D,DoTag) -> Value = asn1ct_gen:mk_var(asn1ct_name:curr(val)), gen_encode_prim(Erules,D,DoTag,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, DoTag, Value) -> + asn1ct_gen_per_rt2ct:gen_encode_prim(Erules, D, DoTag, Value); gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> Constraint = D#type.constraint, asn1ct_name:new(enumval), @@ -119,18 +130,6 @@ 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); @@ -285,8 +284,8 @@ 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); @@ -294,8 +293,9 @@ gen_obj_code(_,_,Obj) when is_record(Obj,pobjectdef) -> ok. -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}, @@ -313,18 +313,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 -> @@ -400,7 +406,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 @@ -411,12 +417,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, "false", "Val"), []; {constructed,bif} -> emit({" 'enc_",ObjName,'_',FieldName, @@ -432,7 +437,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 @@ -443,7 +448,7 @@ gen_encode_default_call(ClassName,FieldName,Type) -> [#typedef{name=[FieldName,ClassName], typespec=Type}]; {primitive,bif} -> - gen_encode_prim(uper, Type, "false", "Val"), + gen_encode_prim(Erules, Type, "false", "Val"), []; #'Externaltypereference'{module=CurrentMod,type=Etype} -> emit([" 'enc_",Etype,"'(Val)",nl]), @@ -454,8 +459,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, @@ -472,12 +478,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 -> @@ -485,9 +492,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) -> @@ -530,15 +539,16 @@ 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, +gen_decode_field_call(_Erules, _ObjName, _FieldName, Bytes, #'Externaltypereference'{module=M,type=T}) -> CurrentMod = get(currmod), if @@ -549,11 +559,11 @@ gen_decode_field_call(_ObjName,_FieldName,Bytes, emit([" '",M,"':'dec_",T,"'(",Bytes,", telltype)"]), [] end; -gen_decode_field_call(ObjName,FieldName,Bytes,Type) -> +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, @@ -569,7 +579,7 @@ gen_decode_field_call(ObjName,FieldName,Bytes,Type) -> [] end. -gen_decode_default_call(ClassName,FieldName,Bytes,Type) -> +gen_decode_default_call(Erules, ClassName, FieldName, Bytes, Type) -> CurrentMod = get(currmod), InnerType = asn1ct_gen:get_inner(Type#type.def), case asn1ct_gen:type(InnerType) of @@ -579,7 +589,7 @@ gen_decode_default_call(ClassName,FieldName,Bytes,Type) -> [#typedef{name=[FieldName,ClassName], typespec=Type}]; {primitive,bif} -> - gen_dec_prim(uper, Type, Bytes), + gen_dec_prim(Erules, Type, Bytes), []; #'Externaltypereference'{module=CurrentMod,type=Etype} -> emit([" 'dec_",Etype,"'(",Bytes,", telltype)",nl]), @@ -641,7 +651,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 @@ -672,14 +682,30 @@ gen_objset_enc(Erule, ObjSetName, UniqueName, [{ObjName,Val,Fields}|T], emit({";",nl}), gen_objset_enc(Erule, ObjSetName, UniqueName, T, ClName, ClFields, NewNthObj, InternalFunc ++ Acc); -gen_objset_enc(Erule,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, - _ClFields,_NthObj,Acc) -> +gen_objset_enc(uper, ObjSetName, _UniqueName, ['EXTENSIONMARK'], + _ClName, _ClFields, _NthObj, Acc) -> emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}), emit({indent(3),"fun(_, Val, _) ->",nl}), - uper = Erule, 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(_, ObjSetName, UniqueName, [], _, _, _, Acc) -> emit_default_getenc(ObjSetName, UniqueName), emit([".",nl,nl]), @@ -716,11 +742,11 @@ gen_inlined_enc_funs1(Erule, Fields, [{typefield,Name,_}|Rest], ObjSetName, {Acc,NAdd} = case lists:keyfind(Name, 1, Fields) of {_,#type{}=Type} -> - {Ret,N} = emit_inner_of_fun(Type, InternalDefFunName), + {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(Type, InternalDefFunName), + {Ret,N} = emit_inner_of_fun(Erule, Type, InternalDefFunName), {Ret++Acc0,N}; {_,#'Externaltypereference'{module=CurrentMod,type=T}} -> emit([indent(9),{asis,Name}," ->",nl, @@ -733,6 +759,17 @@ gen_inlined_enc_funs1(Erule, Fields, [{typefield,Name,_}|Rest], ObjSetName, false when Erule =:= uper -> 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, Sep, @@ -744,12 +781,12 @@ gen_inlined_enc_funs1(_, _, [], _, _, NthObj, Acc) -> 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, dotag, "Val"), {[],0}; {constructed,bif} -> emit([indent(12),"'enc_", @@ -759,15 +796,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"); + 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)"}); @@ -783,11 +820,11 @@ 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], ClName, +gen_objset_dec(Erule, ObjSName, UniqueName, [{ObjName,Val,Fields}|T], ClName, ClFields, NthObj)-> emit({"'getdec_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val}, ") ->",nl}), @@ -795,7 +832,8 @@ gen_objset_dec(ObjSName, UniqueName, [{ObjName,Val,Fields}|T], ClName, 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; @@ -807,15 +845,15 @@ gen_objset_dec(ObjSName, UniqueName, [{ObjName,Val,Fields}|T], ClName, NthObj end, emit({";",nl}), - gen_objset_dec(ObjSName, UniqueName, T, ClName, ClFields, NewNthObj); -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(ObjSetName, UniqueName, [], _, _, _) -> +gen_objset_dec(_Erule, ObjSetName, UniqueName, [], _, _, _) -> emit_default_getdec(ObjSetName, UniqueName), emit([".",nl,nl]), ok. @@ -829,15 +867,16 @@ 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], @@ -845,10 +884,10 @@ gen_inlined_dec_funs1(Fields, [{typefield,Name,_}|Rest], 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); + emit_inner_of_decfun(Erule, Type, InternalDefFunName); {_,#'Externaltypereference'{module=CurrentMod,type=T}} -> emit([indent(9),{asis,Name}," ->",nl, indent(12),"'dec_",T,"'(Val,telltype)"]), @@ -861,17 +900,17 @@ gen_inlined_dec_funs1(Fields, [{typefield,Name,_}|Rest], 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_", @@ -881,15 +920,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"); + gen_dec_prim(Erule, Type, "Val"); TRef when is_record(TRef,typereference) -> T = TRef#typereference.val, emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"}); diff --git a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl index d7c2a983bd..b0b0b37d47 100644 --- a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl +++ b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl @@ -19,88 +19,15 @@ %% -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([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/4]). -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]). - -%% 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 = asn1ct_gen:mk_var(asn1ct_name:curr(val)), - gen_encode_prim(Erules,D,DoTag,Value). - - - - - gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> Constraint = D#type.constraint, case D#type.def of @@ -115,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); @@ -547,802 +472,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, 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, - ObjSetName, NthObj); - {CurrMod,Name} -> - emit({" fun 'enc_",Name,"'/3"}), - {[],NthObj}; - {ModName,Name} -> - emit_ext_encfun(ModName,Name), - {[],NthObj}; - _ -> - emit({" fun 'enc_",ObjName,"'/3"}), - {[],NthObj} - end, - emit({";",nl}), - gen_objset_enc(Erule, ObjSetName, UniqueName, T, ClName, ClFields, - NewNthObj, 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, ObjSetName, UniqueName, [], _, _, _, Acc) -> - emit_default_getenc(ObjSetName, UniqueName), - emit([".",nl,nl]), - 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/test/asn1_SUITE_data/InfObj.asn b/lib/asn1/test/asn1_SUITE_data/InfObj.asn index abd49e64f3..ff11b36788 100644 --- a/lib/asn1/test/asn1_SUITE_data/InfObj.asn +++ b/lib/asn1/test/asn1_SUITE_data/InfObj.asn @@ -163,7 +163,14 @@ myotherobject MY-CLASS ::= { } MyObjectSet MY-CLASS ::= { - myobject | myotherobject + myobject | myotherobject | + { + -- Each character will be encoded in 3 bits in UPER, 4 bits in PER. + &Count NumericString (FROM("01234567") ^ SIZE(8)), + &integerValue 43, + &booleanValue TRUE, + &stringValue "tjosan" + } } MyPdu ::= SEQUENCE { diff --git a/lib/asn1/test/testInfObj.erl b/lib/asn1/test/testInfObj.erl index 97e6a9aaa9..c0f86eab60 100644 --- a/lib/asn1/test/testInfObj.erl +++ b/lib/asn1/test/testInfObj.erl @@ -50,7 +50,8 @@ main(_Erule) -> roundtrip('InfObj', 'MyPdu', {'MyPdu',42,12,false,"string"}), roundtrip('InfObj', 'MyPdu', {'MyPdu',{'Seq',1023,"hello"}, - 42,true,"longer string"}). + 42,true,"longer string"}), + roundtrip('InfObj', 'MyPdu', {'MyPdu',"75712346",43,true,"string"}). roundtrip(M, T, V) -> |