From cf331721ede37300dff89362f14285949416b409 Mon Sep 17 00:00:00 2001 From: Kenneth Lundin Date: Wed, 11 Aug 2010 16:53:56 +0200 Subject: Add support for Extension addition group --- lib/asn1/src/asn1_records.hrl | 13 +- lib/asn1/src/asn1ct_check.erl | 272 +++++++++-------- lib/asn1/src/asn1ct_constructed_ber.erl | 41 ++- lib/asn1/src/asn1ct_constructed_per.erl | 308 ++++++++++++++----- lib/asn1/src/asn1ct_gen.erl | 37 ++- lib/asn1/src/asn1ct_parser2.erl | 527 +++++++++++++++++++------------- lib/asn1/src/asn1ct_tok.erl | 184 +++++------ 7 files changed, 842 insertions(+), 540 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1_records.hrl b/lib/asn1/src/asn1_records.hrl index 8a428b744c..59a9acb7e7 100644 --- a/lib/asn1/src/asn1_records.hrl +++ b/lib/asn1/src/asn1_records.hrl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% @@ -36,7 +36,8 @@ -record(module,{pos,name,defid,tagdefault='EXPLICIT',exports={exports,[]},imports={imports,[]}, extensiondefault=empty,typeorval}). --record('SEQUENCE',{pname=false,tablecinf=false,components=[]}). +-record('ExtensionAdditionGroup',{number}). +-record('SEQUENCE',{pname=false,tablecinf=false,extaddgroup,components=[]}). -record('SET',{pname=false,sorted=false,tablecinf=false,components=[]}). -record('ComponentType',{pos,name,typespec,prop,tags,textual_order}). -record('ObjectClassFieldType',{classname,class,fieldname,type}). diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 54a5c7e727..1c9f2c759a 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -3227,7 +3227,7 @@ check_ptype(_S,_PTDef,Ts) when is_record(Ts,objectclass) -> % check_type(S,Type,ObjSpec={{objectclassname,_},_}) -> -% check_class(S,ObjSpec); + % check_class(S,ObjSpec); check_type(_S,Type,Ts) when is_record(Type,typedef), (Type#typedef.checked==true) -> Ts; @@ -3357,6 +3357,7 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> merge_tags(Tag,?TAG_PRIMITIVE(?N_INTEGER))}; 'REAL' -> check_real(S,Constr), + TempNewDef#newt{tag=merge_tags(Tag,?TAG_PRIMITIVE(?N_REAL))}; {'BIT STRING',NamedNumberList} -> NewL = check_bitstring(S,NamedNumberList,Constr), @@ -5522,24 +5523,9 @@ check_sequence(S,Type,Comps) -> Components2 = maybe_automatic_tags(S,Components), %% check the table constraints from here. The outermost type %% is Type, the innermost is Comps (the list of components) - NewComps = - case check_each_component(S,Type,Components2) of - NewComponents when is_list(NewComponents) -> - check_unique_sequence_tags(S,NewComponents), - NewComponents; - Ret = {NewComponents,NewEcomps} -> - TagComps = NewComponents ++ - [Comp#'ComponentType'{prop='OPTIONAL'}|| Comp <- NewEcomps], - %% extension components are like optionals when it comes to tagging - check_unique_sequence_tags(S,TagComps), - Ret; - Ret = {Root1,NewE,Root2} -> - TagComps = Root1 ++ [Comp#'ComponentType'{prop='OPTIONAL'}|| Comp <- NewE]++Root2, - %% This is not correct handling if Extension - %% contains ExtensionAdditionGroups - check_unique_sequence_tags(S,TagComps), - Ret - end, + NewComps = check_each_component2(S,Type,Components2), + check_unique_sequence_tags(S,NewComps), + %% CRelInf is the "leading attribute" information %% necessary for code generating of the look up in the %% object set table, @@ -5553,12 +5539,45 @@ check_sequence(S,Type,Comps) -> %% the involved class removed, as the class of the object %% set. CompListWithTblInf = get_tableconstraint_info(S,Type,NewComps2), - - {CRelInf,CompListWithTblInf}; + %% 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), + {CRelInf,CompListTuple}; Dupl -> - throw({error,{asn1,{duplicate_components,Dupl}}}) + throw({error,{asn1,{duplicate_components,Dupl}}}) end. +complist_as_tuple(Per,CompList) -> + complist_as_tuple(Per,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) -> + 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) -> + lists:reverse(Acc); +complist_as_tuple(_Per,[],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) -> + {lists:reverse(Acc),lists:reverse(Ext),lists:reverse(Acc2)}. + +is_erule_per(Erule) -> + lists:member(Erule,[per,per_bin,uper_bin]). + 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); @@ -5601,13 +5620,26 @@ take_only_rootset([#'EXTENSIONMARK'{}|_T])-> take_only_rootset([H|T]) -> [H|take_only_rootset(T)]. -check_unique_sequence_tags(S,[#'ComponentType'{prop=mandatory}|Rest]) -> - check_unique_sequence_tags(S,Rest); -check_unique_sequence_tags(S,[C|Rest]) when is_record(C,'ComponentType') -> +check_unique_sequence_tags(S,CompList) -> + TagComps = case complist_as_tuple(false,CompList) of + {R1,Ext,R2} -> + R1 ++ [C#'ComponentType'{prop='OPTIONAL'}|| + C = #'ComponentType'{} <- Ext]++R2; + {R1,Ext} -> + R1 ++ [C#'ComponentType'{prop='OPTIONAL'}|| + C = #'ComponentType'{} <- Ext]; + _ -> + CompList + end, + check_unique_sequence_tags0(S,TagComps). + +check_unique_sequence_tags0(S,[#'ComponentType'{prop=mandatory}|Rest]) -> + check_unique_sequence_tags0(S,Rest); +check_unique_sequence_tags0(S,[C=#'ComponentType'{}|Rest]) -> check_unique_sequence_tags1(S,Rest,[C]);% optional or default -check_unique_sequence_tags(S,[_ExtensionMarker|Rest]) -> - check_unique_sequence_tags(S,Rest); -check_unique_sequence_tags(_S,[]) -> +check_unique_sequence_tags0(S,[_ExtensionMarker|Rest]) -> + check_unique_sequence_tags0(S,Rest); +check_unique_sequence_tags0(_S,[]) -> true. check_unique_sequence_tags1(S,[C|Rest],Acc) when is_record(C,'ComponentType') -> @@ -5807,8 +5839,10 @@ get_least_tag(TagList) -> %% adds the textual order to the components to keep right order of %% components in the asn1-value. textual_order(Cs) -> - Fun = fun(C,Index) -> - {C#'ComponentType'{textual_order=Index},Index+1} + Fun = fun(C=#'ComponentType'{},Index) -> + {C#'ComponentType'{textual_order=Index},Index+1}; + (Other,Index) -> + {Other,Index} end, {NewCs,_} = textual_order(Cs,Fun,1), NewCs. @@ -5879,7 +5913,6 @@ check_selectiontype2(S,Name,TypeDef) -> error({type,Msg,S}) end. - check_restrictedstring(_S,_Def,_Constr) -> ok. @@ -5899,16 +5932,16 @@ check_choice(S,Type,Components) when is_list(Components) -> [] -> %% sort_canonical(Components), Components2 = maybe_automatic_tags(S,Components), - %NewComps = - case check_each_alternative(S,Type,Components2) of - {NewComponents,NewEcomps} -> - check_unique_tags(S,NewComponents ++ NewEcomps), - {NewComponents,NewEcomps}; - NewComponents -> - check_unique_tags(S,NewComponents), - NewComponents - end; - + NewComps = check_each_alternative2(S,Type,Components2), + %% ExtensionAdditionGroup markers i.e '[[' ']]' are not + %% significant for encoding/decoding a choice + %% therefore we remove them here + NewComps2 = lists:filter(fun(#'ExtensionAdditionGroup'{}) -> false; + ('ExtensionAdditionGroupEnd') -> false; + (_) -> true + end,NewComps), + check_unique_tags(S,NewComps2), + complist_as_tuple(is_erule_per(S#state.erule),NewComps2); Dupl -> throw({error,{asn1,{duplicate_choice_alternatives,Dupl}}}) end; @@ -6036,12 +6069,17 @@ check_unique2([_|T],Pos,Acc) -> check_unique2([],_,Acc) -> lists:reverse(Acc). -check_each_component(S,Type,Components) -> - check_each_component(S,Type,Components,[],[],[],root1). -check_each_component(S = #state{abscomppath=Path,recordtopname=TopName},Type, - [C|Ct],Acc,Extacc,Acc2,Ext) when is_record(C,'ComponentType') -> - #'ComponentType'{name=Cname,typespec=Ts,prop=Prop} = C, +%% Replaces check_each_component and does the same work except that +%% it keeps the complist as a flat list and does not create a tuple with root and +%% extensions separated +check_each_component2(S,Type,Components) -> + check_each_component2(S,Type,Components,[]). + +check_each_component2(S = #state{abscomppath=Path,recordtopname=TopName}, + Type, + [C = #'ComponentType'{name=Cname,typespec=Ts,prop=Prop}|Ct], + Acc) -> NewAbsCPath = case Ts#type.def of #'Externaltypereference'{} -> []; @@ -6058,75 +6096,48 @@ check_each_component(S = #state{abscomppath=Path,recordtopname=TopName},Type, DefaultValue -> {'DEFAULT',DefaultValue} end, NewC = C#'ComponentType'{typespec=CheckedTs,prop=NewProp,tags=NewTags}, - case Ext of - root1 -> - check_each_component(S,Type,Ct,[NewC|Acc],Extacc,Acc2,Ext); - ext -> - check_each_component(S,Type,Ct,Acc,[NewC|Extacc],Acc2,Ext); - root2 -> - check_each_component(S,Type,Ct,Acc,Extacc,[NewC|Acc2],Ext) - end; -check_each_component(S,Type,[_|Ct],Acc,Extacc,Acc2,root1) -> % skip 'EXTENSIONMARK' - check_each_component(S,Type,Ct,Acc,Extacc,Acc2,ext); -check_each_component(S,Type,[_|Ct],Acc,Extacc,Acc2,ext) -> % skip 'EXTENSIONMARK' - check_each_component(S,Type,Ct,Acc,Extacc,Acc2,root2); -check_each_component(_S,_,[_C|_Ct],_,_,_,root2) -> % 'EXTENSIONMARK' - throw({error,{asn1,{too_many_extension_marks}}}); -check_each_component(_S,_,[],Acc,Extacc,_,ext) -> - {lists:reverse(Acc),lists:reverse(Extacc)}; -check_each_component(_S,_,[],Acc1,ExtAcc,Acc2,root2) -> - {lists:reverse(Acc1),lists:reverse(ExtAcc),lists:reverse(Acc2)}; -check_each_component(_S,_,[],Acc,_,_,root1) -> + check_each_component2(S,Type,Ct,[NewC|Acc]); + +check_each_component2(S,Type,[OtherMarker|Ct],Acc) -> + %% let 'EXTENSIONMARK' and 'ExtensionAdditionGroup' markers pass through as is + check_each_component2(S,Type,Ct,[OtherMarker|Acc]); +check_each_component2(_S,_,[],Acc) -> lists:reverse(Acc). -%% check_each_alternative(S,Type,{Rlist,ExtList}) -> + +%% check_each_alternative2(S,Type,{Rlist,ExtList}) -> %% {check_each_alternative(S,Type,Rlist), %% check_each_alternative(S,Type,ExtList)}; -check_each_alternative(S,Type,[C|Ct]) -> - check_each_alternative(S,Type,[C|Ct],[],[],noext). +check_each_alternative2(S,Type,[C|Ct]) -> + check_each_alternative2(S,Type,[C|Ct],[]). -check_each_alternative(S=#state{abscomppath=Path,recordtopname=TopName},Type,[C|Ct], - Acc,Extacc,Ext) when is_record(C,'ComponentType') -> - #'ComponentType'{name=Cname,typespec=Ts,prop=_Prop} = C, +check_each_alternative2(S=#state{abscomppath=Path,recordtopname=TopName}, + Type, + [C = #'ComponentType'{name=Cname,typespec=Ts}|Ct], + Acc) -> NewAbsCPath = case Ts#type.def of #'Externaltypereference'{} -> []; _ -> [Cname|Path] end, - NewState = - S#state{abscomppath=NewAbsCPath,recordtopname=[Cname|TopName]}, - CheckedTs = check_type(NewState,Type,Ts), + CheckedTs = check_type(S#state{abscomppath=NewAbsCPath, + recordtopname=[Cname|TopName]},Type,Ts), NewTags = get_taglist(S,CheckedTs), + NewC = C#'ComponentType'{typespec=CheckedTs,tags=NewTags}, - case Ext of - noext -> - check_each_alternative(S,Type,Ct,[NewC|Acc],Extacc,Ext); - ext -> - check_each_alternative(S,Type,Ct,Acc,[NewC|Extacc],Ext) - end; + check_each_alternative2(S,Type,Ct,[NewC|Acc]); -check_each_alternative(S,Type,[_|Ct],Acc,Extacc,noext) -> % skip 'EXTENSIONMARK' - check_each_alternative(S,Type,Ct,Acc,Extacc,ext); -check_each_alternative(_S,_,[_C|_Ct],_,_,ext) -> % skip 'EXTENSIONMARK' - throw({error,{asn1,{too_many_extension_marks}}}); -check_each_alternative(_S,_,[],Acc,Extacc,ext) -> - {lists:reverse(Acc),lists:reverse(Extacc)}; -check_each_alternative(_S,_,[],Acc,_,noext) -> +check_each_alternative2(S,Type,[OtherMarker|Ct],Acc) -> + %% let 'EXTENSIONMARK' and 'ExtensionAdditionGroup' markers pass through as is + check_each_alternative2(S,Type,Ct,[OtherMarker|Acc]); +check_each_alternative2(_S,_,[],Acc) -> lists:reverse(Acc). + %% componentrelation_leadingattr/2 searches the structure for table %% constraints, if any is found componentrelation_leadingattr/5 is %% called. componentrelation_leadingattr(S,CompList) -> - Cs = - case CompList of - {Comp1, EComps, Comp2} -> - Comp1++EComps++Comp2; - {Components,EComponents} when is_list(Components) -> - Components ++ EComponents; - CompList when is_list(CompList) -> - CompList - end, %% get_simple_table_if_used/2 should find out whether there are any %% component relation constraints in the entire tree of Cs1 that @@ -6135,12 +6146,22 @@ componentrelation_leadingattr(S,CompList) -> %% componentrelation_leadingattr/6. The step when the leading %% attribute and the syntax tree is modified to support the code %% generating. - case get_simple_table_if_used(S,Cs) of + case get_simple_table_if_used(S,CompList) of [] -> {false,CompList}; - STList -> - componentrelation_leadingattr(S,Cs,Cs,STList,[],[]) + _ -> + componentrelation_leadingattr(S,CompList,CompList,[],[]) end. + +%%FIXME expand_ExtAddGroups([C#'ExtensionAdditionGroup'{components=ExtAdds}|T], +%% CurrPos,PosAcc,CompAcc) -> +%% expand_ExtAddGroups(T,CurrPos+ L = lenght(ExtAdds),[{CurrPos,L}|PosAcc],ExtAdds++CompAcc); +%% expand_ExtAddGroups([C|T],CurrPos,PosAcc,CompAcc) -> +%% expand_ExtAddGroups(T,CurrPos+ 1,PosAcc,[C|CompAcc]); +%% expand_ExtAddGroups([],_CurrPos,PosAcc,CompAcc) -> +%% {lists:reverse(PosAcc),lists:reverse(CompAcc)}. + + %% componentrelation_leadingattr/6 when all components are searched %% the new modified components are returned together with the "leading %% attribute" information, which later is stored in the tablecinf @@ -6150,11 +6171,12 @@ componentrelation_leadingattr(S,CompList) -> %% is used in code generating phase too, to recognice the proper %% components for "open type" encoding and to propagate the result of %% the object set lookup when needed. -componentrelation_leadingattr(_,[],_CompList,_,[],NewCompList) -> +componentrelation_leadingattr(_,[],_CompList,[],NewCompList) -> {false,lists:reverse(NewCompList)}; -componentrelation_leadingattr(_,[],_CompList,_,LeadingAttr,NewCompList) -> +componentrelation_leadingattr(_,[],_CompList,LeadingAttr,NewCompList) -> {lists:last(LeadingAttr),lists:reverse(NewCompList)}; %send all info in Ts later -componentrelation_leadingattr(S,[C|Cs],CompList,STList,Acc,CompAcc) -> + +componentrelation_leadingattr(S,[C= #'ComponentType'{}|Cs],CompList,Acc,CompAcc) -> {LAAcc,NewC} = case catch componentrelation1(S,C#'ComponentType'.typespec, [C#'ComponentType'.name]) of @@ -6205,7 +6227,7 @@ componentrelation_leadingattr(S,[C|Cs],CompList,STList,Acc,CompAcc) -> %% no constraint was found {[],C} end, - componentrelation_leadingattr(S,Cs,CompList,STList,LAAcc++Acc, + componentrelation_leadingattr(S,Cs,CompList,LAAcc++Acc, [NewC|CompAcc]). object_set_mod_name(_S,ObjSet) when is_atom(ObjSet) -> @@ -6228,11 +6250,9 @@ object_set_mod_name(S,#'Externaltypereference'{module=M,type=T}) -> %% generation of the look up functionality in the object set table are %% returned. get_simple_table_if_used(S,Cs) -> - CNames = lists:map(fun(#'ComponentType'{name=Name}) -> Name; - (_) -> [] %% in case of extension marks - end, - Cs), - RefedSimpleTable=any_component_relation(S,Cs,CNames,[],[]), + CNames = [Name||#'ComponentType'{name=Name}<-Cs], + JustComponents = [C || C = #'ComponentType'{}<-Cs], + RefedSimpleTable=any_component_relation(S,JustComponents,CNames,[],[]), get_simple_table_info(S,Cs,remove_doubles(RefedSimpleTable)). remove_doubles(L) -> @@ -6336,9 +6356,7 @@ simple_table_info(S,Type,_) -> %% beginning of the search. CNames holds the names of all components %% of the start level, this info is used if an outermost at-notation %% is found to check the validity of the at-list. -any_component_relation(S,[C|Cs],CNames,NamePath,Acc) -> - CName = C#'ComponentType'.name, - Type = C#'ComponentType'.typespec, +any_component_relation(S,[#'ComponentType'{name=CName,typespec=Type}|Cs],CNames,NamePath,Acc) -> CRelPath = case constraint_member(componentrelation,Type#type.constraint) of %% [{componentrelation,_,AtNotation}] -> @@ -6358,9 +6376,9 @@ any_component_relation(S,[C|Cs],CNames,NamePath,Acc) -> case {Type#type.inlined, asn1ct_gen:type(asn1ct_gen:get_inner(Type#type.def))} of {no,{constructed,bif}} -> + {InnerCs,NewNamePath} = case get_components(Type#type.def) of - {IC1,_IC2} -> {IC1 ++ IC1,[CName|NamePath]}; T when is_record(T,type) -> {T,NamePath}; IC -> {IC,[CName|NamePath]} end, @@ -6384,11 +6402,7 @@ any_component_relation(S,Type,CNames,NamePath,Acc) when is_record(Type,type) -> case {Type#type.inlined, asn1ct_gen:type(asn1ct_gen:get_inner(Type#type.def))} of {no,{constructed,bif}} -> - InnerCs = - case get_components(Type#type.def) of - {IC1,_IC2} -> IC1 ++ IC1; - IC -> IC - end, + InnerCs = get_components(Type#type.def), any_component_relation(S,InnerCs,CNames,NamePath,[]); _ -> [] @@ -6456,11 +6470,11 @@ get_components(Def) -> get_components(any,Def). get_components(_,#'SEQUENCE'{components=Cs}) -> - Cs; + tuple2complist(Cs); get_components(_,#'SET'{components=Cs}) -> - Cs; + tuple2complist(Cs); get_components(_,{'CHOICE',Cs}) -> - Cs; + tuple2complist(Cs); %do not step in inlined structures get_components(any,{'SEQUENCE OF',T = #type{def=_Def,inlined=no}}) -> % get_components(any,Def); @@ -6471,6 +6485,13 @@ get_components(any,{'SET OF',T = #type{def=_Def,inlined=no}}) -> get_components(_,_) -> []. +tuple2complist({R,E}) -> + R ++ E; +tuple2complist({R1,E,R2}) -> + R1 ++ E ++ R2; +tuple2complist(List) when is_list(List) -> + List. + get_choice_components(_S,{'CHOICE',Components}) when is_list(Components)-> Components; get_choice_components(_S,{'CHOICE',{C1,C2}}) when is_list(C1),is_list(C2) -> @@ -6731,8 +6752,7 @@ get_tableconstraint_info(S,Type,CheckedTs) -> get_tableconstraint_info(_S,_Type,[],Acc) -> lists:reverse(Acc); -get_tableconstraint_info(S,Type,[C|Cs],Acc) -> - CheckedTs = C#'ComponentType'.typespec, +get_tableconstraint_info(S,Type,[C=#'ComponentType'{typespec=CheckedTs}|Cs],Acc) -> AccComp = case CheckedTs#type.def of %% ObjectClassFieldType @@ -6768,7 +6788,9 @@ get_tableconstraint_info(S,Type,[C|Cs],Acc) -> _ -> C end, - get_tableconstraint_info(S,Type,Cs,[AccComp|Acc]). + get_tableconstraint_info(S,Type,Cs,[AccComp|Acc]); +get_tableconstraint_info(S,Type,[C|Cs],Acc) -> + get_tableconstraint_info(S,Type,Cs,[C|Acc]). get_referenced_fieldname([{_,FirstFieldname}]) -> {FirstFieldname,[]}; @@ -6850,7 +6872,9 @@ get_taglist(S,Type) when is_record(Type,type) -> [asn1ct_gen:def_to_tag(Tag)] end; get_taglist(S,{'CHOICE',{Rc,Ec}}) -> - get_taglist(S,{'CHOICE',Rc ++ Ec}); + get_taglist1(S,Rc ++ Ec); +get_taglist(S,{'CHOICE',{R1,E,R2}}) -> + get_taglist1(S,R1 ++ E ++ R2); get_taglist(S,{'CHOICE',Components}) -> get_taglist1(S,Components); %% ObjectClassFieldType OTP-4390 diff --git a/lib/asn1/src/asn1ct_constructed_ber.erl b/lib/asn1/src/asn1ct_constructed_ber.erl index 51a241ffbd..77b78dcac7 100644 --- a/lib/asn1/src/asn1ct_constructed_ber.erl +++ b/lib/asn1/src/asn1ct_constructed_ber.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% @@ -71,13 +71,15 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) -> ok end, - {SeqOrSet,TableConsInfo,CompList} = + {SeqOrSet,TableConsInfo,CompList0} = case D#type.def of #'SEQUENCE'{tablecinf=TCI,components=CL} -> {'SEQUENCE',TCI,CL}; #'SET'{tablecinf=TCI,components=CL} -> {'SET',TCI,CL} end, + %% filter away extensionAdditiongroup markers + CompList = filter_complist(CompList0), Ext = extensible(CompList), CompList1 = case CompList of {Rl1,El,Rl2} -> Rl1 ++ El ++ Rl2; @@ -189,7 +191,11 @@ 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:new(tag), - #'SEQUENCE'{tablecinf=TableConsInfo,components=CList} = D#type.def, + #'SEQUENCE'{tablecinf=TableConsInfo,components=CList0} = D#type.def, + + %% filter away extensionAdditiongroup markers + CList = filter_complist(CList0), + Ext = extensible(CList), {CompList,CompList2} = case CList of {Rl1,El,Rl2} -> {Rl1 ++ El ++ Rl2,CList}; @@ -369,7 +375,10 @@ gen_decode_set(Erules,Typename,D) when is_record(D,type) -> asn1ct_name:clear(), asn1ct_name:new(term), asn1ct_name:new(tag), - #'SET'{components=TCompList} = D#type.def, + #'SET'{components=TCompList0} = D#type.def, + + %% filter away extensionAdditiongroup markers + TCompList = filter_complist(TCompList0), Ext = extensible(TCompList), ToOptional = fun(mandatory) -> 'OPTIONAL'; @@ -1473,6 +1482,22 @@ extensible({RootList,ExtList}) -> {ext,length(RootList)+1,length(ExtList)}; extensible({_Rl1,_ExtL,_Rl2}) -> extensible. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% filter away ExtensionAdditionGroup start and end marks since these +%% have no significance for the BER encoding +%% +filter_complist(CompList) when is_list(CompList) -> + lists:filter(fun(#'ExtensionAdditionGroup'{}) -> + false; + ('ExtensionAdditionGroupEnd') -> + false; + (_) -> + true + end, CompList); +filter_complist({Root,Ext}) -> + {Root,filter_complist(Ext)}; +filter_complist({Root1,Ext,Root2}) -> + {Root1,filter_complist(Ext),Root2}. print_attribute_comment(InnerType,Pos,Prop) -> CommentLine = "%%-------------------------------------------------", diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl index 2a1c0ebc6b..df430c4f88 100644 --- a/lib/asn1/src/asn1ct_constructed_per.erl +++ b/lib/asn1/src/asn1ct_constructed_per.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% @@ -46,13 +46,24 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) -> asn1ct_name:start(), asn1ct_name:new(term), asn1ct_name:new(bytes), - {CompList,TableConsInfo} = + {ExtAddGroup,TmpCompList,TableConsInfo} = case D#type.def of - #'SEQUENCE'{tablecinf=TCI,components=CL} -> - {CL,TCI}; + #'SEQUENCE'{tablecinf=TCI,components=CL,extaddgroup=ExtAddGroup0} -> + {ExtAddGroup0,CL,TCI}; #'SET'{tablecinf=TCI,components=CL} -> - {CL,TCI} + {undefined,CL,TCI} end, + + CompList = case ExtAddGroup of + undefined -> + TmpCompList; + _ when is_integer(ExtAddGroup) -> + %% This is a fake SEQUENCE representing an ExtensionAdditionGroup + %% Reset the textual order so we get the right + %% index of the components + [Comp#'ComponentType'{textual_order=undefined}|| + Comp<-TmpCompList] + end, case Typename of ['EXTERNAL'] -> emit({{var,asn1ct_name:next(val)}, @@ -78,7 +89,7 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) -> ",",{var,asn1ct_name:curr(val)},"),",nl}) end, asn1ct_name:new(val), - Ext = extensible(CompList), + Ext = extensible_enc(CompList), case Ext of {ext,_,NumExt} when NumExt > 0 -> emit(["Extensions = ?RT_PER:fixextensions(",{asis,Ext}, @@ -188,9 +199,10 @@ gen_decode_constructed(Erules,Typename,D) when is_record(D,type) -> #'SEQUENCE'{tablecinf=TCI,components=CL} -> {add_textual_order(CL),TCI}; #'SET'{tablecinf=TCI,components=CL} -> - {add_textual_order(CL),TCI} +%% {add_textual_order(CL),TCI} + {CL,TCI} % the textual order is already taken care of end, - Ext = extensible(CompList), + Ext = extensible_dec(CompList), MaybeComma1 = case Ext of {ext,_Pos,_NumExt} -> gen_dec_extension_value("Bytes"), @@ -243,8 +255,9 @@ gen_decode_constructed(Erules,Typename,D) when is_record(D,type) -> {false,false,false} end end, + NewCompList = wrap_compList(CompList), {AccTerm,AccBytes} = - gen_dec_components_call(Erules,Typename,CompList,MaybeComma2,DecObjInf,Ext,length(Optionals)), + gen_dec_components_call(Erules,Typename,NewCompList,MaybeComma2,DecObjInf,Ext,length(Optionals)), case asn1ct_name:all(term) of [] -> emit(MaybeComma2); % no components at all _ -> emit({com,nl}) @@ -284,7 +297,10 @@ gen_decode_constructed(Erules,Typename,D) when is_record(D,type) -> emit(" {ASN11994Format,"); _ -> emit(["{{'",RecordName,"'"]), - mkvlist(textual_order(CompList,asn1ct_name:all(term))), + %% CompList is used here because we don't want + %% ExtensionAdditionGroups to be wrapped in SEQUENCES when + %% we are ordering the fields according to textual order + mkvlist(textual_order(to_encoding_order(CompList),asn1ct_name:all(term))), emit("},") end, emit({{var,asn1ct_name:curr(bytes)},"}"}), @@ -293,17 +309,12 @@ gen_decode_constructed(Erules,Typename,D) when is_record(D,type) -> textual_order([#'ComponentType'{textual_order=undefined}|_],TermList) -> TermList; textual_order(CompList,TermList) when is_list(CompList) -> - TermTuple = list_to_tuple(TermList), %% ['Term1','Term2',...'TermN'] - %% OrderList is ordered by canonical order of tags - TmpTuple = TermTuple, - OrderList = [Ix||#'ComponentType'{textual_order=Ix} <- CompList], - Fun = fun(X,{Tpl,Ix}) -> - - {setelement(X,Tpl,element(Ix,TermTuple)),Ix+1} - end, - {Ret,_} = lists:foldl(Fun,{TmpTuple,1},OrderList), -%% io:format("TermTuple: ~p~nOrderList: ~p~nRet: ~p~n",[TermTuple,OrderList,tuple_to_list(Ret)]), - tuple_to_list(Ret); + OrderList = [Ix||#'ComponentType'{textual_order=Ix} <- CompList], + [Term||{_,Term}<- + lists:sort(lists:zip(OrderList, + lists:sublist(TermList,length(OrderList))))]; + %% sublist is just because Termlist can sometimes be longer than + %% OrderList, which it really shouldn't textual_order({Root,Ext},TermList) -> textual_order(Root ++ Ext,TermList); textual_order({Root1,Ext,Root2},TermList) -> @@ -379,7 +390,7 @@ emit_opt_or_mand_check(Val,Term) -> gen_encode_choice(Erule,Typename,D) when is_record(D,type) -> {'CHOICE',CompList} = D#type.def, emit({"[",nl}), - Ext = extensible(CompList), + Ext = extensible_enc(CompList), gen_enc_choice(Erule,Typename,CompList,Ext), emit({nl,"].",nl}). @@ -388,7 +399,7 @@ gen_decode_choice(Erules,Typename,D) when is_record(D,type) -> asn1ct_name:clear(), asn1ct_name:new(bytes), {'CHOICE',CompList} = D#type.def, - Ext = extensible(CompList), + Ext = extensible_enc(CompList), gen_dec_choice(Erules,Typename,CompList,Ext), emit({".",nl}). @@ -558,12 +569,32 @@ mkvlist2([H|T]) -> mkvlist2([]) -> true. -extensible(CompList) when is_list(CompList) -> + +extensible_dec(CompList) when is_list(CompList) -> + noext; +extensible_dec({RootList,ExtList}) -> + {ext,length(RootList)+1,ext_length(ExtList)}; +extensible_dec({Rl1,Ext,Rl2}) -> + {ext,length(Rl1)+length(Rl2)+1,ext_length(Ext)}. + +extensible_enc(CompList) when is_list(CompList) -> noext; -extensible({RootList,ExtList}) -> - {ext,length(RootList)+1,length(ExtList)}; -extensible({Rl1,Ext,_Rl2}) -> - {ext,length(Rl1)+1,length(Ext)}. +extensible_enc({RootList,ExtList}) -> + {ext,length(RootList)+1,ext_length(ExtList)}; +extensible_enc({Rl1,Ext,_Rl2}) -> + {ext,length(Rl1)+1,ext_length(Ext)}. + +ext_length(ExtList) -> ext_length(ExtList,normal,0). +ext_length([{'ExtensionAdditionGroup',_Num}|T],_,Acc)-> + ext_length(T,group,Acc); +ext_length(['ExtensionAdditionGroupEnd'|T],group,Acc) -> + ext_length(T,normal,Acc+1); +ext_length([#'ComponentType'{}|T],State=group,Acc) -> + ext_length(T,State,Acc); +ext_length([#'ComponentType'{}|T],State=normal,Acc) -> + ext_length(T,State,Acc+1); +ext_length([],_,Acc) -> + Acc. gen_dec_extension_value(_) -> emit({"{Ext,",{next,bytes},"} = ?RT_PER:getext(",{curr,bytes},")"}), @@ -574,7 +605,11 @@ gen_dec_extension_value(_) -> %% there are optional components, start with 2 because first element %% is the record name -optionals({L1,_Ext,L2}) -> optionals(L1++L2,[],2); +optionals({L1,Ext,L2}) -> + Opt1 = optionals(L1,[],2), + ExtComps = length([C||C = #'ComponentType'{}<-Ext]), + Opt2 = optionals(L2,[],2+length(L1)+ExtComps), + Opt1 ++ Opt2; optionals({L,_Ext}) -> optionals(L,[],2); optionals(L) -> optionals(L,[],2). @@ -617,6 +652,13 @@ get_optionality_pos(TextPos,OptTable) -> no_num end. +to_encoding_order(Cs) when is_list(Cs) -> + Cs; +to_encoding_order(Cs = {_Root,_Ext}) -> + Cs; +to_encoding_order({R1,Ext,R2}) -> + {R1++R2,Ext}. + add_textual_order(Cs) when is_list(Cs) -> {NewCs,_} = add_textual_order1(Cs,1), NewCs; @@ -629,26 +671,20 @@ add_textual_order({R1,Ext,R2}) -> {NewExt,Num2} = add_textual_order1(Ext,Num1), {NewR2,_} = add_textual_order1(R2,Num2), {NewR1,NewExt,NewR2}. -add_textual_order1(Cs=[#'ComponentType'{textual_order=Int}|_],I) - when is_integer(Int) -> - {Cs,I}; +%%add_textual_order1(Cs=[#'ComponentType'{textual_order=Int}|_],I) +%% when is_integer(Int) -> +%% {Cs,I}; add_textual_order1(Cs,NumIn) -> - lists:mapfoldl(fun(C,Num) -> + lists:mapfoldl(fun(C=#'ComponentType'{},Num) -> {C#'ComponentType'{textual_order=Num}, - Num+1} + Num+1}; + (OtherMarker,Num) -> + {OtherMarker,Num} end, NumIn,Cs). gen_enc_components_call(Erule,TopType,{Root1,ExtList,Root2},MaybeComma,DynamicEnc,Ext) -> - Rpos = gen_enc_components_call1(Erule,TopType,Root1,1,MaybeComma,DynamicEnc,noext), - case Ext of - {ext,_,ExtNum} when ExtNum > 0 -> - emit([nl, - ",Extensions",nl]); - _ -> true - end, - Rpos2 = gen_enc_components_call1(Erule,TopType,ExtList,Rpos,MaybeComma,DynamicEnc,Ext), - gen_enc_components_call1(Erule,TopType,Root2,Rpos2,MaybeComma,DynamicEnc,noext); + gen_enc_components_call(Erule,TopType,{Root1++Root2,ExtList},MaybeComma,DynamicEnc,Ext); gen_enc_components_call(Erule,TopType,{CompList,ExtList},MaybeComma,DynamicEnc,Ext) -> %% The type has extensionmarker Rpos = gen_enc_components_call1(Erule,TopType,CompList,1,MaybeComma,DynamicEnc,noext), @@ -659,7 +695,8 @@ gen_enc_components_call(Erule,TopType,{CompList,ExtList},MaybeComma,DynamicEnc,E _ -> true end, %handle extensions - gen_enc_components_call1(Erule,TopType,ExtList,Rpos,MaybeComma,DynamicEnc,Ext); + NewExtList = wrap_extensionAdditionGroups(ExtList), + gen_enc_components_call1(Erule,TopType,NewExtList,Rpos,MaybeComma,DynamicEnc,Ext); gen_enc_components_call(Erule,TopType, CompList, MaybeComma, DynamicEnc, Ext) -> %% The type has no extensionmarker gen_enc_components_call1(Erule,TopType,CompList,1,MaybeComma,DynamicEnc,Ext). @@ -719,6 +756,26 @@ gen_enc_component_default(Erule,TopType,Cname,Type,Pos,DynamicEnc,Ext,DefaultVal NextElement = asn1ct_gen:mk_var(asn1ct_name:curr(tmpval)), gen_enc_line(Erule,TopType,Cname,Type,NextElement, Pos,DynamicEnc,Ext), emit({nl,"end"}). + +gen_enc_component_optional(Erule,TopType,Cname, + Type=#type{def=#'SEQUENCE'{ + extaddgroup=Number, + components=ExtGroupCompList}}, + Pos,DynamicEnc,Ext) when is_integer(Number) -> + emit({nl,"begin",nl}), + + asn1ct_name:new(tmpval), + ExtAddGroupTypeName = asn1ct_gen:list2name([Cname|TopType]), + emit({{curr,tmpval}," = {'",ExtAddGroupTypeName,"', "}), + ExtNames = [ExtName||#'ComponentType'{name=ExtName}<-ExtGroupCompList], + Elements = make_elements(Pos+1,"Val1",ExtNames), + emit({Elements,"},"}), + InnerType = asn1ct_gen:get_inner(Type#type.def), + emit({nl,"%% attribute number ",Pos," with type ", + InnerType,nl}), + NextElement = asn1ct_gen:mk_var(asn1ct_name:curr(tmpval)), + gen_enc_line(Erule,TopType,Cname,Type,NextElement, Pos,DynamicEnc,Ext), + emit({nl,"end"}); gen_enc_component_optional(Erule,TopType,Cname,Type,Pos,DynamicEnc,Ext) -> Element = make_element(Pos+1,"Val1",Cname), emit({"case ",Element," of",nl}), @@ -834,29 +891,7 @@ gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) -> _ -> true end. gen_dec_components_call(Erule,TopType,{Root1,ExtList,Root2},MaybeComma,DecInfObj,Ext,NumberOfOptionals) -> - %% The type has extensionmarker - OptTable = create_optionality_table(Root1 ++ Root2), - {Rpos,AccTerm,AccBytes} = - gen_dec_components_call1(Erule,TopType, Root1, 1, OptTable, - MaybeComma,DecInfObj, noext,[],[], - NumberOfOptionals), - emit([",",nl,"{Extensions,",{next,bytes},"} = "]), - emit(["?RT_PER:getextension(Ext,",{curr,bytes},"),",nl]), - asn1ct_name:new(bytes), - {Epos,AccTermE,AccBytesE} = - gen_dec_components_call1(Erule,TopType,ExtList,Rpos, OptTable, "", - DecInfObj,Ext,[],[],NumberOfOptionals), - case ExtList of - [] -> true; - _ -> emit([",",nl]) - end, - emit([{next,bytes},"= ?RT_PER:skipextensions(",{curr,bytes},",", - length(ExtList)+1,",Extensions),",nl]), - asn1ct_name:new(bytes), - {_RPos2,AccTerm2,AccBytes2} = - gen_dec_components_call1(Erule,TopType,Root2,Epos,OptTable, - "",DecInfObj,noext,[],[],NumberOfOptionals), - {AccTerm++AccTermE++AccTerm2,AccBytes++AccBytesE++AccBytes2}; + gen_dec_components_call(Erule,TopType,{Root1++Root2,ExtList},MaybeComma,DecInfObj,Ext,NumberOfOptionals); gen_dec_components_call(Erule,TopType,{CompList,ExtList},MaybeComma, DecInfObj,Ext,NumberOfOptionals) -> %% The type has extensionmarker @@ -868,8 +903,9 @@ gen_dec_components_call(Erule,TopType,{CompList,ExtList},MaybeComma, emit([",",nl,"{Extensions,",{next,bytes},"} = "]), emit(["?RT_PER:getextension(Ext,",{curr,bytes},"),",nl]), asn1ct_name:new(bytes), + NewExtList = wrap_extensionAdditionGroups(ExtList), {_Epos,AccTermE,AccBytesE} = - gen_dec_components_call1(Erule,TopType,ExtList,Rpos, OptTable, + gen_dec_components_call1(Erule,TopType,NewExtList,Rpos, OptTable, "",DecInfObj,Ext,[],[],NumberOfOptionals), case ExtList of [] -> true; @@ -942,8 +978,18 @@ gen_dec_components_call1(Erule,TopType, asn1ct_name:new(tmpterm), emit({"{",{curr,tmpterm},", ",{next,bytes},"} = "}); _ -> - asn1ct_name:new(term), - emit({"{",{curr,term},",",{next,bytes},"} = "}) + case Type of + #type{def=#'SEQUENCE'{ + extaddgroup=Number1, + components=ExtGroupCompList1}} when is_integer(Number1)-> + emit({"{{_,"}), + emit_extaddgroupTerms(term,ExtGroupCompList1), + emit({"}"}); + _ -> + asn1ct_name:new(term), + emit({"{",{curr,term}}) + end, + emit({",",{next,bytes},"} = "}) end, case {Ext,Prop,is_optimized(Erule)} of @@ -967,11 +1013,24 @@ gen_dec_components_call1(Erule,TopType, {noext,mandatory} -> true; % generate nothing {noext,_} -> emit([";",nl,"0 ->"]), - gen_dec_component_no_val(TopType,Cname,Type,Prop,Tpos,Ext), + emit(["{"]), + gen_dec_component_no_val(Ext,Prop), + emit({",",{curr,bytes},"}",nl}), emit([nl,"end"]); _ -> emit([";",nl,"_ ->",nl]), - gen_dec_component_no_val(TopType,Cname,Type,Prop,Tpos,Ext), + 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"]) end, asn1ct_name:new(bytes), @@ -988,13 +1047,22 @@ gen_dec_components_call1(Erule,TopType, gen_dec_components_call1(_,_TopType,[],Pos,_OptTable,_,_,_,AccTerm,AccBytes,_NumberOfOptionals) -> {Pos,AccTerm,AccBytes}. - -gen_dec_component_no_val(_,_,_,{'DEFAULT',DefVal},_,_) -> - emit(["{",{asis,DefVal},",",{curr,bytes},"}",nl]); -gen_dec_component_no_val(_,_,_,'OPTIONAL',_,_) -> - emit({"{asn1_NOVALUE,",{curr,bytes},"}",nl}); -gen_dec_component_no_val(_,_,_,mandatory,_,{ext,_,_}) -> - emit({"{asn1_NOVALUE,",{curr,bytes},"}",nl}). +gen_dec_extaddGroup_no_val(Ext,[#'ComponentType'{prop=Prop}])-> + gen_dec_component_no_val(Ext,Prop), + ok; +gen_dec_extaddGroup_no_val(Ext,[#'ComponentType'{prop=Prop}|Rest])-> + gen_dec_component_no_val(Ext,Prop), + emit({","}), + gen_dec_extaddGroup_no_val(Ext,Rest); +gen_dec_extaddGroup_no_val(_, []) -> + ok. + +gen_dec_component_no_val(_,{'DEFAULT',DefVal}) -> + emit([{asis,DefVal}]); +gen_dec_component_no_val(_,'OPTIONAL') -> + emit({"asn1_NOVALUE"}); +gen_dec_component_no_val({ext,_,_},mandatory) -> + emit({"asn1_NOVALUE"}). gen_dec_line(Erule,TopType,Cname,Type,Pos,DecInfObj,Ext,Prop) -> @@ -1192,6 +1260,14 @@ gen_enc_choice_tag({C1,C2},_,_) -> N2 = get_name_list(C2), emit(["?RT_PER:set_choice(element(1,Val),", {asis,{N1,N2}},", ",{asis,{length(N1),length(N2)}},")"]); + +gen_enc_choice_tag({C1,C2,C3},_,_) -> + N1 = get_name_list(C1), + N2 = get_name_list(C2), + N3 = get_name_list(C3), + Root = N1 ++ N3, + emit(["?RT_PER:set_choice(element(1,Val),", + {asis,{Root,N2}},", ",{asis,{length(Root),length(N2)}},")"]); gen_enc_choice_tag(C,_,_) -> N = get_name_list(C), emit(["?RT_PER:set_choice(element(1,Val),", @@ -1208,6 +1284,8 @@ 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, L, Ext) -> gen_enc_choice2(Erule,TopType, L, 0, Ext). @@ -1279,6 +1357,9 @@ gen_dec_choice1(Erule,TopType,CompList,noext) -> 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}, "} = ?RT_PER:getchoice(",{prev,bytes},",", @@ -1347,6 +1428,18 @@ gen_encode_prim_wrapper(CtgenMod,Erule,Cont,DoTag,Value) -> CtgenMod:gen_encode_prim(Erule,Cont,DoTag,Value). % erase(component_type). +make_elements(I,Val,ExtCnames) -> + make_elements(I,Val,ExtCnames,[]). + +make_elements(I,Val,[ExtCname],Acc)-> % the last one, no comma needed + Element = make_element(I,Val,ExtCname), + make_elements(I+1,Val,[],[Element|Acc]); +make_elements(I,Val,[ExtCname|Rest],Acc)-> + Element = make_element(I,Val,ExtCname), + make_elements(I+1,Val,Rest,[", ",Element|Acc]); +make_elements(_I,_,[],Acc) -> + lists:reverse(Acc). + make_element(I,Val,Cname) -> case tuple_notation_allowed() of true -> @@ -1355,6 +1448,55 @@ make_element(I,Val,Cname) -> io_lib:format("element(~w,~s)",[I,Val]) end. +emit_extaddgroupTerms(VarSeries,[_]) -> + asn1ct_name:new(VarSeries), + emit({curr,VarSeries}), + ok; +emit_extaddgroupTerms(VarSeries,[_|Rest]) -> + asn1ct_name:new(VarSeries), + emit({{curr,VarSeries},","}), + emit_extaddgroupTerms(VarSeries,Rest); +emit_extaddgroupTerms(_,[]) -> + ok. +wrap_compList({Root1,Ext,Root2}) -> + {Root1,wrap_extensionAdditionGroups(Ext),Root2}; +wrap_compList({Root1,Ext}) -> + {Root1,wrap_extensionAdditionGroups(Ext)}; +wrap_compList(CompList) -> + CompList. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Will convert all componentTypes following 'ExtensionAdditionGroup' +%% up to the matching 'ExtensionAdditionGroupEnd' into one componentType +%% of type SEQUENCE with the componentTypes as components +%% +wrap_extensionAdditionGroups(ExtCompList) -> + wrap_extensionAdditionGroups(ExtCompList,[],0). + +wrap_extensionAdditionGroups([{'ExtensionAdditionGroup',_Number}|Rest],Acc,0) -> + {ExtGroupCompList= + [#'ComponentType'{textual_order=TextPos}|_], + ['ExtensionAdditionGroupEnd'|Rest2]} = + lists:splitwith(fun(#'ComponentType'{}) -> true; + (_) -> false + end, + Rest), + wrap_extensionAdditionGroups(Rest2, + [#'ComponentType'{ + name='ExtAddGroup', % FIXME: handles ony one ExtAddGroup + typespec=#type{def=#'SEQUENCE'{ + extaddgroup=1,% FIXME: handles only one + components=ExtGroupCompList}}, + textual_order = TextPos, + prop='OPTIONAL'}|Acc],length(ExtGroupCompList)-1); +wrap_extensionAdditionGroups([H=#'ComponentType'{textual_order=Tord}|T],Acc,ExtAddGroupDiff) when is_integer(Tord) -> + wrap_extensionAdditionGroups(T,[H#'ComponentType'{ + textual_order=Tord - ExtAddGroupDiff}|Acc],ExtAddGroupDiff); +wrap_extensionAdditionGroups([H|T],Acc,ExtAddGroupDiff) -> + wrap_extensionAdditionGroups(T,[H|Acc],ExtAddGroupDiff); +wrap_extensionAdditionGroups([],Acc,_) -> + lists:reverse(Acc). + + tuple_notation_allowed() -> Options = get(encoding_options), not (lists:member(optimize,Options) orelse lists:member(uper_bin,Options)). diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index b9f6c46b53..e4cd29bfbd 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -535,14 +535,34 @@ gen_part_decode_funcs({primitive,bif},_TypeName, gen_part_decode_funcs(WhatKind,_TypeName,{_,Directive,_,_}) -> throw({error,{asn1,{"Not implemented yet",WhatKind," partial incomplete directive:",Directive}}}). + +extaddgroup2sequence(ExtList) -> + extaddgroup2sequence(ExtList,[]). + +extaddgroup2sequence([{'ExtensionAdditionGroup',Number0}|T],Acc) -> + Number = case Number0 of undefined -> 1; _ -> Number0 end, + {ExtGroupComps,['ExtensionAdditionGroupEnd'|T2]} = + lists:splitwith(fun(Elem) -> is_record(Elem,'ComponentType') end,T), + extaddgroup2sequence(T2,[#'ComponentType'{ + name='ExtAddGroup', + typespec=#type{def=#'SEQUENCE'{ + extaddgroup=Number, + components=ExtGroupComps}}, + prop='OPTIONAL'}|Acc]); +extaddgroup2sequence([C|T],Acc) -> + extaddgroup2sequence(T,[C|Acc]); +extaddgroup2sequence([],Acc) -> + lists:reverse(Acc). + + gen_types(Erules,Tname,{RootL1,ExtList,RootL2}) when is_list(RootL1), is_list(RootL2) -> gen_types(Erules,Tname,RootL1), - gen_types(Erules,Tname,ExtList), + gen_types(Erules,Tname,extaddgroup2sequence(ExtList)), gen_types(Erules,Tname,RootL2); gen_types(Erules,Tname,{RootList,ExtList}) when is_list(RootList) -> gen_types(Erules,Tname,RootList), - gen_types(Erules,Tname,ExtList); + gen_types(Erules,Tname,extaddgroup2sequence(ExtList)); gen_types(Erules,Tname,[{'EXTENSIONMARK',_,_}|Rest]) -> gen_types(Erules,Tname,Rest); gen_types(Erules,Tname,[ComponentType|Rest]) -> @@ -1541,19 +1561,18 @@ gen_record2(Name,SeqOrSet,Comps) -> gen_record2(_Name,_SeqOrSet,[],_Com,_Extension) -> true; -gen_record2(Name,SeqOrSet,[{'EXTENSIONMARK',_,_}|T],Com,Extension) -> - gen_record2(Name,SeqOrSet,T,Com,Extension); -gen_record2(_Name,_SeqOrSet,[H],Com,Extension) -> - #'ComponentType'{name=Cname} = H, +gen_record2(_Name,_SeqOrSet,[H = #'ComponentType'{name=Cname}],Com,Extension) -> emit(Com), emit({asis,Cname}), gen_record_default(H, Extension); -gen_record2(Name,SeqOrSet,[H|T],Com, Extension) -> - #'ComponentType'{name=Cname} = H, +gen_record2(Name,SeqOrSet,[H = #'ComponentType'{name=Cname}|T],Com, Extension) -> emit(Com), emit({asis,Cname}), gen_record_default(H, Extension), - gen_record2(Name,SeqOrSet,T,", ", Extension). + gen_record2(Name,SeqOrSet,T,", ", Extension); +gen_record2(Name,SeqOrSet,[_|T],Com,Extension) -> + %% skip EXTENSIONMARK, ExtensionAdditionGroup and other markers + gen_record2(Name,SeqOrSet,T,Com,Extension). gen_record_default(#'ComponentType'{prop='OPTIONAL'}, _)-> emit(" = asn1_NOVALUE"); diff --git a/lib/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl index 46d7ad6fdb..224a535e87 100644 --- a/lib/asn1/src/asn1ct_parser2.erl +++ b/lib/asn1/src/asn1ct_parser2.erl @@ -417,10 +417,22 @@ parse_BuiltinType([{'CHARACTER',_},{'STRING',_}|Rest]) -> {#type{def='CHARACTER STRING'},Rest}; parse_BuiltinType([{'CHOICE',_},{'{',_}|Rest]) -> - {AlternativeTypeLists,Rest2} = parse_AlternativeTypeLists(Rest,get(extensiondefault)), + {AlternativeTypeLists,Rest2} = parse_AlternativeTypeLists(Rest), + AlternativeTypeLists1 = + lists:filter(fun(#'ExtensionAdditionGroup'{}) -> false; + ('ExtensionAdditionGroupEnd') -> false; + (_) -> true + end,AlternativeTypeLists), case Rest2 of [{'}',_}|Rest3] -> - {#type{def={'CHOICE',AlternativeTypeLists}},Rest3}; + AlternativeTypeLists2 = + case {[Ext||Ext = #'EXTENSIONMARK'{} <- AlternativeTypeLists1], + get(extensiondefault)} of + {[],'IMPLIED'} -> AlternativeTypeLists1 ++ [#'EXTENSIONMARK'{}]; + _ -> AlternativeTypeLists1 + end, + + {#type{def={'CHOICE',AlternativeTypeLists2}},Rest3}; _ -> throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), [got,get_token(hd(Rest2)),expected,'}']}}) @@ -479,16 +491,19 @@ parse_BuiltinType([{'REAL',_}|Rest]) -> {#type{def='REAL'},Rest}; parse_BuiltinType([{'RELATIVE-OID',_}|Rest]) -> {#type{def='RELATIVE-OID'},Rest}; -parse_BuiltinType([{'SEQUENCE',_},{'{',_},{'...',Line},{'}',_}|Rest]) -> - {#type{def=#'SEQUENCE'{components=[{'EXTENSIONMARK',Line,undefined}]}}, +parse_BuiltinType([{'SEQUENCE',_},{'{',_},{'}',_}|Rest]) -> + {#type{def=#'SEQUENCE'{components=[]}}, Rest}; +parse_BuiltinType([{'SEQUENCE',_},{'{',_},{'...',Line},{'}',_}|Rest]) -> + {#type{def=#'SEQUENCE'{components=[#'EXTENSIONMARK'{pos = Line}]}},Rest}; parse_BuiltinType([{'SEQUENCE',_},{'{',_},{'...',Line},{'!',_}|Rest]) -> {ExceptionIdentification,Rest2} = parse_ExceptionIdentification(Rest), case Rest2 of [{'}',_}|Rest3] -> - {#type{def=#'SEQUENCE'{components=[{'EXTENSIONMARK', - Line, - ExceptionIdentification}]}}, + {#type{def=#'SEQUENCE'{ + components=[#'EXTENSIONMARK'{ + pos = Line, + val = ExceptionIdentification}]}}, Rest3}; _ -> {ComponentTypeLists,Rest3}= @@ -537,13 +552,14 @@ parse_BuiltinType([{'SEQUENCE',_},{'OF',_}|Rest]) -> parse_BuiltinType([{'SET',_},{'{',_},{'...',Line},{'}',_}|Rest]) -> - {#type{def=#'SET'{components=[{'EXTENSIONMARK',Line,undefined}]}},Rest}; + {#type{def=#'SET'{components=[#'EXTENSIONMARK'{pos = Line}]}},Rest}; parse_BuiltinType([{'SET',_},{'{',_},{'...',Line},{'!',_}|Rest]) -> {ExceptionIdentification,Rest2} = parse_ExceptionIdentification(Rest), case Rest2 of [{'}',_}|Rest3] -> {#type{def=#'SET'{components= - [{'EXTENSIONMARK',Line,ExceptionIdentification}]}}, + [#'EXTENSIONMARK'{pos = Line, + val = ExceptionIdentification}]}}, Rest3}; _ -> throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), @@ -2323,101 +2339,197 @@ to_set(V) when is_list(V) -> to_set(V) -> ordsets:from_list([V]). +parse_AlternativeTypeLists(Tokens) -> + parse_AlternativeTypeLists(Tokens,[]). -parse_AlternativeTypeLists(Tokens,ExtensionDefault) -> - {AltTypeList,Rest1} = parse_AlternativeTypeList(Tokens), - {ExtensionAndException,Rest2} = - case Rest1 of - [{',',_},{'...',L1},{'!',_}|Rest12] -> - {_,Rest13} = parse_ExceptionIdentification(Rest12), - %% Exception info is currently thrown away - {[#'EXTENSIONMARK'{pos=L1}],Rest13}; - [{',',_},{'...',L1}|Rest12] -> - {[#'EXTENSIONMARK'{pos=L1}],Rest12}; - _ -> - {[],Rest1} - end, - {AltTypeList2,Rest5} = - case ExtensionAndException of - [] -> - {AltTypeList,Rest2}; - _ -> - {ExtensionAddition,Rest3} = - case Rest2 of - [{',',_}|Rest23] -> - parse_ExtensionAdditionAlternativeList(Rest23); - _ -> - {[],Rest2} - end, - {OptionalExtensionMarker,Rest4} = - case Rest3 of - [{',',_},{'...',L3}|Rest31] -> - {[#'EXTENSIONMARK'{pos=L3}],Rest31}; - _ -> - {[],Rest3} - end, - {AltTypeList ++ ExtensionAndException ++ - ExtensionAddition ++ OptionalExtensionMarker, Rest4} - end, - AltTypeList3 = - case [X || X=#'EXTENSIONMARK'{} <- AltTypeList2] of - [] when ExtensionDefault == 'IMPLIED' -> - AltTypeList2 ++ [#'EXTENSIONMARK'{}]; - _ -> - AltTypeList2 - end, - {AltTypeList3,Rest5}. - +parse_AlternativeTypeLists(Tokens = [{identifier,_,_}|_Rest0],Clist) -> + {CompList,Rest1} = parse_AlternativeTypeList(Tokens,[]), + parse_AlternativeTypeLists(Rest1,Clist++CompList); +parse_AlternativeTypeLists([{'...',L1},{'!',_}|Rest02],Clist0) -> + {_,Rest03} = parse_ExceptionIdentification(Rest02), + %% Exception info is currently thrown away + parse_AlternativeTypeLists2(Rest03,Clist0++[#'EXTENSIONMARK'{pos=L1}]); +parse_AlternativeTypeLists([{',',L1},{'...',_},{'!',_}|Rest02],Clist0) when Clist0 =/= []-> + {_,Rest03} = parse_ExceptionIdentification(Rest02), + %% Exception info is currently thrown away + parse_AlternativeTypeLists2(Rest03,Clist0++[#'EXTENSIONMARK'{pos=L1}]); + +parse_AlternativeTypeLists([{',',_},{'...',L1}|Rest02],Clist0) when Clist0 =/= []-> + parse_AlternativeTypeLists2(Rest02,Clist0++[#'EXTENSIONMARK'{pos=L1}]); +parse_AlternativeTypeLists([{'...',L1}|Rest02],Clist0) -> + parse_AlternativeTypeLists2(Rest02,Clist0++[#'EXTENSIONMARK'{pos=L1}]); +parse_AlternativeTypeLists(Tokens = [{'}',_L1}|_Rest02],Clist0) -> + {Clist0,Tokens}. + +parse_AlternativeTypeLists2(Tokens,Clist) -> + {ExtAdd,Rest} = parse_ExtensionAdditionAlternatives(Tokens,Clist), + {Clist2,Rest2} = parse_OptionalExtensionMarker(Rest,lists:flatten(ExtAdd)), + case Rest2 of + [{',',_}|Rest3] -> + {CompList,Rest4} = parse_AlternativeTypeList(Rest3,[]), + {Clist2 ++ CompList,Rest4}; + _ -> + {Clist2,Rest2} + end. -parse_AlternativeTypeList(Tokens) -> - parse_AlternativeTypeList(Tokens,[]). -parse_AlternativeTypeList(Tokens,Acc) -> - {NamedType,Rest} = parse_NamedType(Tokens), + +parse_AlternativeTypeList([{',',_},Id = {identifier,_,_}|Rest],Acc) when Acc =/= [] -> + {AlternativeType,Rest2} = parse_NamedType([Id|Rest]), + parse_AlternativeTypeList(Rest2,[AlternativeType|Acc]); +parse_AlternativeTypeList(Tokens = [{'}',_}|_],Acc) -> + {lists:reverse(Acc),Tokens}; +parse_AlternativeTypeList(Tokens = [{']',_},{']',_}|_],Acc) -> + {lists:reverse(Acc),Tokens}; +parse_AlternativeTypeList(Tokens = [{',',_},{'...',_}|_],Acc) -> + {lists:reverse(Acc),Tokens}; +parse_AlternativeTypeList(Tokens,[]) -> + {AlternativeType,Rest} = parse_NamedType(Tokens), + parse_AlternativeTypeList(Rest,[AlternativeType]); +parse_AlternativeTypeList(Tokens,_) -> + throw({asn1_error, + {get_line(hd(Tokens)),get(asn1_module), + [got,[get_token(hd(Tokens)),get_token(hd(tl(Tokens)))], + expected,['}',', identifier']]}}). + +parse_ExtensionAdditionAlternatives(Tokens =[{',',_}|_],Clist) -> + {ExtAddList,Rest2} = parse_ExtensionAdditionAlternativesList(Tokens,[]), + {Clist++lists:flatten(ExtAddList),Rest2}; +parse_ExtensionAdditionAlternatives(Tokens,Clist) -> + %% Empty + {Clist,Tokens}. + +parse_ExtensionAdditionAlternativesList([{',',_},Id = {identifier,_,_}|Rest],Acc) -> + {AlternativeType,Rest2} = parse_NamedType([Id|Rest]), + parse_ExtensionAdditionAlternativesList(Rest2,[AlternativeType|Acc]); +parse_ExtensionAdditionAlternativesList([{',',_},C1 = {'[',_},C2 = {'[',_}|Rest],Acc) -> + {ExtAddGroup,Rest2} = parse_ExtensionAdditionAlternativesGroup([C1,C2|Rest],[]), + parse_ExtensionAdditionAlternativesList(Rest2,[ExtAddGroup|Acc]); +parse_ExtensionAdditionAlternativesList(Tokens = [{'}',_}|_],Acc) -> + {lists:reverse(Acc),Tokens}; +parse_ExtensionAdditionAlternativesList(Tokens = [{',',_},{'...',_}|_],Acc) -> + {lists:reverse(Acc),Tokens}; +parse_ExtensionAdditionAlternativesList(Tokens,_) -> + throw({asn1_error, + {get_line(hd(Tokens)),get(asn1_module), + [got,[get_token(hd(Tokens)),get_token(hd(tl(Tokens)))], + expected,['}',', identifier']]}}). + + +parse_ExtensionAdditionAlternativesGroup([ {'[',_},{'[',_},_VsnNr = {number,_,Num},{':',_}|Rest],[]) -> + parse_ExtensionAdditionAlternativesGroup2(Rest,Num); +parse_ExtensionAdditionAlternativesGroup([ {'[',_},{'[',_}|Rest],[]) -> + parse_ExtensionAdditionAlternativesGroup2(Rest,undefined); +parse_ExtensionAdditionAlternativesGroup(Tokens,_) -> + throw({asn1_error, + {get_line(hd(Tokens)),get(asn1_module), + [got,[get_token(hd(Tokens)),get_token(hd(tl(Tokens)))], + expected,['[[']]}}). + + +parse_ExtensionAdditionAlternativesGroup2(Tokens,Num) -> + {CompTypeList,Rest} = parse_AlternativeTypeList(Tokens,[]), case Rest of - [{',',_},Id = {identifier,_,_}|Rest2] -> - parse_AlternativeTypeList([Id|Rest2],[NamedType|Acc]); + [{']',_},{']',_}|Rest2] -> + {[{'ExtensionAdditionGroup',Num}|CompTypeList] ++ + ['ExtensionAdditionGroupEnd'],Rest2}; _ -> - {lists:reverse([NamedType|Acc]),Rest} - end. - + throw({asn1_error,{get_line(hd(Rest)),get(asn1_module), + [got,get_token(hd(Rest)),expected,[']]']]}}) + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% parse_AlternativeTypeLists(Tokens,ExtensionDefault) -> +%% {AltTypeList,Rest1} = parse_AlternativeTypeList(Tokens), +%% {ExtensionAndException,Rest2} = +%% case Rest1 of +%% [{',',_},{'...',L1},{'!',_}|Rest12] -> +%% {_,Rest13} = parse_ExceptionIdentification(Rest12), +%% %% Exception info is currently thrown away +%% {[#'EXTENSIONMARK'{pos=L1}],Rest13}; +%% [{',',_},{'...',L1}|Rest12] -> +%% {[#'EXTENSIONMARK'{pos=L1}],Rest12}; +%% _ -> +%% {[],Rest1} +%% end, +%% {AltTypeList2,Rest5} = +%% case ExtensionAndException of +%% [] -> +%% {AltTypeList,Rest2}; +%% _ -> +%% {ExtensionAddition,Rest3} = +%% case Rest2 of +%% [{',',_}|Rest23] -> +%% parse_ExtensionAdditionAlternativeList(Rest23); +%% _ -> +%% {[],Rest2} +%% end, +%% {OptionalExtensionMarker,Rest4} = +%% case Rest3 of +%% [{',',_},{'...',L3}|Rest31] -> +%% {[#'EXTENSIONMARK'{pos=L3}],Rest31}; +%% _ -> +%% {[],Rest3} +%% end, +%% {AltTypeList ++ ExtensionAndException ++ +%% ExtensionAddition ++ OptionalExtensionMarker, Rest4} +%% end, +%% AltTypeList3 = +%% case [X || X=#'EXTENSIONMARK'{} <- AltTypeList2] of +%% [] when ExtensionDefault == 'IMPLIED' -> +%% AltTypeList2 ++ [#'EXTENSIONMARK'{}]; +%% _ -> +%% AltTypeList2 +%% end, +%% {AltTypeList3,Rest5}. -parse_ExtensionAdditionAlternativeList(Tokens) -> - parse_ExtensionAdditionAlternativeList(Tokens,[]). +%% parse_AlternativeTypeList(Tokens) -> +%% parse_AlternativeTypeList(Tokens,[]). + +%% parse_AlternativeTypeList(Tokens,Acc) -> +%% {NamedType,Rest} = parse_NamedType(Tokens), +%% case Rest of +%% [{',',_},Id = {identifier,_,_}|Rest2] -> +%% parse_AlternativeTypeList([Id|Rest2],[NamedType|Acc]); +%% _ -> +%% {lists:reverse([NamedType|Acc]),Rest} +%% end. + -parse_ExtensionAdditionAlternativeList(Tokens,Acc) -> - {Element,Rest0} = - case Tokens of - [{identifier,_,_}|_Rest] -> - parse_NamedType(Tokens); - [{'[',_},{'[',_}|_] -> - parse_ExtensionAdditionAlternatives(Tokens) - end, - case Rest0 of - [{',',_}|Rest01] -> - parse_ExtensionAdditionAlternativeList(Rest01,[Element|Acc]); - _ -> - {lists:reverse([Element|Acc]),Rest0} - end. -parse_ExtensionAdditionAlternatives([{'[',_},{'[',_}|Rest]) -> - parse_ExtensionAdditionAlternatives(Rest,[]); -parse_ExtensionAdditionAlternatives(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'[[']}}). +%% parse_ExtensionAdditionAlternativeList(Tokens) -> +%% parse_ExtensionAdditionAlternativeList(Tokens,[]). + +%% parse_ExtensionAdditionAlternativeList([{'[[',_}|Rest],Acc) -> +%% parse_ExtensionAdditionAlternativeList(Rest,Acc); +%% parse_ExtensionAdditionAlternativeList(Tokens = [{identifier,_,_}|_Rest],Acc) -> +%% {Element,Rest0} = parse_NamedType(Tokens); +%% case Rest0 of +%% [{',',_}|Rest01] -> +%% parse_ExtensionAdditionAlternativeList(Rest01,[Element|Acc]); +%% _ -> +%% {lists:reverse([Element|Acc]),Rest0} +%% end. -parse_ExtensionAdditionAlternatives([Id = {identifier,_,_}|Rest],Acc) -> - {NamedType, Rest2} = parse_NamedType([Id|Rest]), - case Rest2 of - [{',',_}|Rest21] -> - parse_ExtensionAdditionAlternatives(Rest21,[NamedType|Acc]); - [{']',_},{']',_}|Rest21] -> - {lists:reverse(Acc),Rest21}; - _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,[',',']]']]}}) - end. +%% parse_ExtensionAdditionAlternatives([{'[[',_}|Rest]) -> +%% parse_ExtensionAdditionAlternatives(Rest,[]); +%% parse_ExtensionAdditionAlternatives(Tokens) -> +%% throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), +%% [got,get_token(hd(Tokens)),expected,'[[']}}). + +%% parse_ExtensionAdditionAlternatives([Id = {identifier,_,_}|Rest],Acc) -> +%% {NamedType, Rest2} = parse_NamedType([Id|Rest]), +%% case Rest2 of +%% [{',',_}|Rest21] -> +%% parse_ExtensionAdditionAlternatives(Rest21,[NamedType|Acc]); +%% [{']]',_}|Rest21] -> +%% {lists:reverse(Acc),Rest21}; +%% _ -> +%% throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), +%% [got,get_token(hd(Rest2)),expected,[',',']]']]}}) +%% end. parse_NamedType([{identifier,L1,Idname}|Rest]) -> {Type,Rest2} = parse_Type(Rest), @@ -2428,144 +2540,123 @@ parse_NamedType(Tokens) -> parse_ComponentTypeLists(Tokens) -> -% Resulting tuple {ComponentTypeList,Rest1} is returned - case Tokens of - [{identifier,_,_}|_Rest0] -> - {Clist,Rest01} = parse_ComponentTypeList(Tokens), - case Rest01 of - [{',',_}|Rest02] -> - parse_ComponentTypeLists(Rest02,Clist); % 5 - 13 - _ -> - {Clist,Rest01} - end; - [{'COMPONENTS',_},{'OF',_}|_Rest] -> - {Clist,Rest01} = parse_ComponentTypeList(Tokens), - case Rest01 of - [{',',_}|Rest02] -> - parse_ComponentTypeLists(Rest02,Clist); - _ -> - {Clist,Rest01} - end; + parse_ComponentTypeLists(Tokens,[]). + +parse_ComponentTypeLists(Tokens = [{identifier,_,_}|_Rest0],Clist) -> + {CompList,Rest1} = parse_ComponentTypeList(Tokens,[]), + parse_ComponentTypeLists(Rest1,Clist++CompList); +parse_ComponentTypeLists(Tokens = [{'COMPONENTS',_},{'OF',_}|_Rest],Clist) -> + {CompList,Rest1} = parse_ComponentTypeList(Tokens,[]), + parse_ComponentTypeLists(Rest1,Clist++CompList); +parse_ComponentTypeLists([{'...',L1},{'!',_}|Rest02],Clist0) -> + {_,Rest03} = parse_ExceptionIdentification(Rest02), + %% Exception info is currently thrown away + parse_ComponentTypeLists2(Rest03,Clist0++[#'EXTENSIONMARK'{pos=L1}]); +parse_ComponentTypeLists([{',',L1},{'...',_},{'!',_}|Rest02],Clist0) when Clist0 =/= []-> + {_,Rest03} = parse_ExceptionIdentification(Rest02), + %% Exception info is currently thrown away + parse_ComponentTypeLists2(Rest03,Clist0++[#'EXTENSIONMARK'{pos=L1}]); + + parse_ComponentTypeLists([{',',_},{'...',L1}|Rest02],Clist0) when Clist0 =/= []-> + parse_ComponentTypeLists2(Rest02,Clist0++[#'EXTENSIONMARK'{pos=L1}]); +parse_ComponentTypeLists([{'...',L1}|Rest02],Clist0) -> + parse_ComponentTypeLists2(Rest02,Clist0++[#'EXTENSIONMARK'{pos=L1}]); +parse_ComponentTypeLists(Tokens = [{'}',_L1}|_Rest02],Clist0) -> + {Clist0,Tokens}. + +parse_ComponentTypeLists2(Tokens,Clist) -> + {ExtAdd,Rest} = parse_ExtensionAdditions(Tokens,Clist), + {Clist2,Rest2} = parse_OptionalExtensionMarker(Rest,lists:flatten(ExtAdd)), + case Rest2 of + [{',',_}|Rest3] -> + {CompList,Rest4} = parse_ComponentTypeList(Rest3,[]), + {Clist2 ++ CompList,Rest4}; _ -> - parse_ComponentTypeLists(Tokens,[]) + {Clist2,Rest2} end. -parse_ComponentTypeLists([{'...',L1},{'!',_}|Rest],Clist1) -> - {_,Rest2} = parse_ExceptionIdentification(Rest), - %% Exception info is currently thrown away - parse_ComponentTypeLists2(Rest2,Clist1++[#'EXTENSIONMARK'{pos=L1}]); -parse_ComponentTypeLists([{'...',L1}|Rest],Clist1) -> %% first Extensionmark - parse_ComponentTypeLists2(Rest,Clist1++[#'EXTENSIONMARK'{pos=L1}]); -parse_ComponentTypeLists(Tokens,Clist1) -> - {Clist1,Tokens}. - - -parse_ComponentTypeLists2(Tokens,Clist1) -> - {ExtensionAddition,Rest2} = - case Tokens of - [{',',_}|Rest1] -> - parse_ExtensionAdditionList(Rest1); - _ -> - {[],Tokens} - end, - {OptionalExtensionMarker,Rest3} = - case Rest2 of - [{',',_},{'...',L2}|Rest21] -> - {[#'EXTENSIONMARK'{pos=L2}],Rest21}; - _ -> - {[],Rest2} - end, - {RootComponentTypeList,Rest4} = - case Rest3 of - [{',',_}|Rest31] -> - parse_ComponentTypeList(Rest31); - _ -> - {[],Rest3} - end, - {Clist1 ++ ExtensionAddition ++ OptionalExtensionMarker ++ RootComponentTypeList, Rest4}. - +parse_OptionalExtensionMarker([{',',_},{'...',L1}|Rest],Clist)-> + {Clist++[#'EXTENSIONMARK'{pos=L1}],Rest}; +parse_OptionalExtensionMarker(Tokens,Clist) -> + {Clist,Tokens}. -parse_ComponentTypeList(Tokens) -> - parse_ComponentTypeList(Tokens,[]). -parse_ComponentTypeList(Tokens,Acc) -> +parse_ComponentTypeList([{',',_},Id = {identifier,_,_}|Rest],Acc) when Acc =/= [] -> + {ComponentType,Rest2} = parse_ComponentType([Id|Rest]), + parse_ComponentTypeList(Rest2,[ComponentType|Acc]); +parse_ComponentTypeList([{',',_},C1={'COMPONENTS',_},C2={'OF',_}|Rest],Acc) when Acc =/= [] -> + {ComponentType,Rest2} = parse_ComponentType([C1,C2|Rest]), + parse_ComponentTypeList(Rest2,[ComponentType|Acc]); +parse_ComponentTypeList(Tokens = [{'}',_}|_],Acc) -> + {lists:reverse(Acc),Tokens}; +parse_ComponentTypeList(Tokens = [{']',_},{']',_}|_],Acc) -> + {lists:reverse(Acc),Tokens}; +parse_ComponentTypeList(Tokens = [{',',_},{'...',_}|_],Acc) -> + {lists:reverse(Acc),Tokens}; +parse_ComponentTypeList(Tokens,[]) -> {ComponentType,Rest} = parse_ComponentType(Tokens), + parse_ComponentTypeList(Rest,[ComponentType]); +parse_ComponentTypeList(Tokens,_) -> + throw({asn1_error, + {get_line(hd(Tokens)),get(asn1_module), + [got,[get_token(hd(Tokens)),get_token(hd(tl(Tokens)))], + expected,['}',', identifier']]}}). + +parse_ExtensionAdditions(Tokens=[{',',_}|_],Clist) -> + {ExtAddList,Rest2} = parse_ExtensionAdditionList(Tokens,[]), + {Clist++ExtAddList,Rest2}; +parse_ExtensionAdditions(Tokens,Clist) -> + %% Empty + {Clist,Tokens}. + +parse_ExtensionAdditionList([{',',_},Id = {identifier,_,_}|Rest],Acc) -> + {ComponentType,Rest2} = parse_ComponentType([Id|Rest]), + parse_ExtensionAdditionList(Rest2,[ComponentType|Acc]); +parse_ExtensionAdditionList([{',',_},C1={'COMPONENTS',_},C2={'OF',_}|Rest],Acc) -> + {ComponentType,Rest2} = parse_ComponentType([C1,C2|Rest]), + parse_ExtensionAdditionList(Rest2,[ComponentType|Acc]); +parse_ExtensionAdditionList([{',',_},C1 = {'[',_},C2 = {'[',_}|Rest],Acc) -> + {ExtAddGroup,Rest2} = parse_ExtensionAdditionGroup([C1,C2|Rest],[]), + parse_ExtensionAdditionList(Rest2,[ExtAddGroup|Acc]); +parse_ExtensionAdditionList(Tokens = [{'}',_}|_],Acc) -> + {lists:reverse(Acc),Tokens}; +parse_ExtensionAdditionList(Tokens = [{',',_},{'...',_}|_],Acc) -> + {lists:reverse(Acc),Tokens}; +parse_ExtensionAdditionList(Tokens,_) -> + throw({asn1_error, + {get_line(hd(Tokens)),get(asn1_module), + [got,[get_token(hd(Tokens)),get_token(hd(tl(Tokens)))], + expected,['}',', identifier']]}}). + + +parse_ExtensionAdditionGroup([ {'[',_},{'[',_},_VsnNr = {number,_,Num},{':',_}|Rest],[]) -> + parse_ExtensionAdditionGroup2(Rest,Num); +parse_ExtensionAdditionGroup([ {'[',_},{'[',_}|Rest],[]) -> + parse_ExtensionAdditionGroup2(Rest,undefined); +parse_ExtensionAdditionGroup(Tokens,_) -> + throw({asn1_error, + {get_line(hd(Tokens)),get(asn1_module), + [got,[get_token(hd(Tokens)),get_token(hd(tl(Tokens)))], + expected,['[[']]}}). + + +parse_ExtensionAdditionGroup2(Tokens,Num) -> + {CompTypeList,Rest} = parse_ComponentTypeList(Tokens,[]), case Rest of - [{',',_},Id = {identifier,_,_}|Rest2] -> - parse_ComponentTypeList([Id|Rest2],[ComponentType|Acc]); - [{',',_},C1={'COMPONENTS',_},C2={'OF',_}|Rest2] -> - parse_ComponentTypeList([C1,C2|Rest2],[ComponentType|Acc]); -% _ -> -% {lists:reverse([ComponentType|Acc]),Rest} - [{'}',_}|_] -> - {lists:reverse([ComponentType|Acc]),Rest}; -% [{',',_},{'...',_},{'}',_}|_] -> -% {lists:reverse([ComponentType|Acc]),Rest}; - [{',',_},{'...',_}|_] ->%% here comes the dubble ellipse - {lists:reverse([ComponentType|Acc]),Rest}; + [{']',_},{']',_}|Rest2] -> + {[{'ExtensionAdditionGroup',Num}|CompTypeList] ++ + ['ExtensionAdditionGroupEnd'],Rest2}; _ -> - throw({asn1_error, - {get_line(hd(Tokens)),get(asn1_module), - [got,[get_token(hd(Rest)),get_token(hd(tl(Rest)))], - expected,['}',', identifier']]}}) - end. - - -parse_ExtensionAdditionList(Tokens) -> - parse_ExtensionAdditionList(Tokens,[]). - -parse_ExtensionAdditionList(Tokens,Acc) -> - {Element,Rest0} = - case Tokens of - [{identifier,_,_}|_Rest] -> - parse_ComponentType(Tokens); - [{'[',_},{'[',_}|_] -> - parse_ExtensionAdditions(Tokens); - [{'...',L1}|_Rest] -> - {#'EXTENSIONMARK'{pos=L1},Tokens}; - _ -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - [identifier,'[[']]}}) - end, - case Rest0 of - [{',',_}|Rest01] -> - parse_ExtensionAdditionList(Rest01,[Element|Acc]); - [{'...',_}|Rest01] -> - {lists:reverse([Element|Acc]),Rest01}; - _ -> - {lists:reverse([Element|Acc]),Rest0} + throw({asn1_error,{get_line(hd(Rest)),get(asn1_module), + [got,get_token(hd(Rest)),expected,[']]']]}}) end. -parse_ExtensionAdditions([{'[',_},{'[',_}|Rest]) -> - parse_ExtensionAdditions(Rest,[]); -parse_ExtensionAdditions(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'[[']}}). - -parse_ExtensionAdditions([_VsnNr = {number,_,_},{':',_}|Rest],Acc) -> - %% ignor version number for now - parse_ExtensionAdditions(Rest,Acc); -parse_ExtensionAdditions([Id = {identifier,_,_}|Rest],Acc) -> - {ComponentType, Rest2} = parse_ComponentType([Id|Rest]), - case Rest2 of - [{',',_}|Rest21] -> - parse_ExtensionAdditions(Rest21,[ComponentType|Acc]); - [{']',_},{']',_}|Rest21] -> - {lists:reverse(Acc),Rest21}; - _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,[',',']]']]}}) - end; -parse_ExtensionAdditions(Tokens,_) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,identifier]}}). parse_ComponentType([{'COMPONENTS',_},{'OF',_}|Rest]) -> {Type,Rest2} = parse_Type(Rest), {{'COMPONENTS OF',Type},Rest2}; parse_ComponentType(Tokens) -> - {NamedType,Rest} = parse_NamedType(Tokens), + Result = {NamedType,Rest} = parse_NamedType(Tokens), case Rest of [{'OPTIONAL',_}|Rest2] -> {NamedType#'ComponentType'{prop='OPTIONAL'},Rest2}; @@ -2573,7 +2664,7 @@ parse_ComponentType(Tokens) -> {Value,Rest21} = parse_Value(Rest2), {NamedType#'ComponentType'{prop={'DEFAULT',Value}},Rest21}; _ -> - {NamedType,Rest} + Result end. diff --git a/lib/asn1/src/asn1ct_tok.erl b/lib/asn1/src/asn1ct_tok.erl index f0ce31bdb2..85199c65ec 100644 --- a/lib/asn1/src/asn1ct_tok.erl +++ b/lib/asn1/src/asn1ct_tok.erl @@ -21,7 +21,7 @@ %% Tokenize ASN.1 code (input to parser generated with yecc) --export([get_name/2,tokenise/2, file/1]). +-export([get_name/2,tokenise/4, file/1]). file(File) -> @@ -29,12 +29,9 @@ file(File) -> {error, Reason} -> {error,{File,file:format_error(Reason)}}; {ok,Stream} -> - process0(Stream) + process(Stream,0,[]) end. -process0(Stream) -> - process(Stream,0,[]). - process(Stream,Lno,R) -> process(io:get_line(Stream, ''), Stream,Lno+1,R). @@ -45,131 +42,128 @@ process(eof, Stream,Lno,R) -> process(L, Stream,Lno,R) when is_list(L) -> %%io:format('read:~s',[L]), - case catch tokenise(L,Lno) of + case catch tokenise(Stream,L,Lno,[]) of {'ERR',Reason} -> io:format("Tokeniser error on line: ~w ~w~n",[Lno,Reason]), exit(0); - {multiline_comment,NestingLevel} -> - {RestL,Lno2} = process_skip_multiline_comment(Stream,Lno,NestingLevel), - process(RestL,Stream,Lno2,R); - T -> + {NewLno,T} -> %%io:format('toks:~w~n',[T]), - process(Stream,Lno,[T|R]) + process(Stream,NewLno,[T|R]) end. -process_skip_multiline_comment(Stream,Lno,NestingLevel) -> - process_skip_multiline_comment(io:get_line(Stream, ''), - Stream, Lno + 1, NestingLevel). -process_skip_multiline_comment(eof,_Stream,Lno,_NestingLevel) -> - io:format("Tokeniser error on line: ~w, premature end of multiline comment~n",[Lno]), - exit(0); -process_skip_multiline_comment(Line,Stream,Lno,NestingLevel) -> - case catch skip_multiline_comment(Line,NestingLevel) of - {multiline_comment,NestingLevel2} -> - process_skip_multiline_comment(Stream,Lno,NestingLevel2); - T -> - {T,Lno} - end. - -tokenise([H|T],Lno) when $a =< H , H =< $z -> +tokenise(Stream,[H|T],Lno,R) when $a =< H , H =< $z -> {X, T1} = get_name(T, [H]), - [{identifier,Lno, list_to_atom(X)}|tokenise(T1,Lno)]; + tokenise(Stream,T1,Lno,[{identifier,Lno, list_to_atom(X)}|R]); -tokenise([$&,H|T],Lno) when $A =< H , H =< $Z -> +tokenise(Stream,[$&,H|T],Lno,R) when $A =< H , H =< $Z -> {Y, T1} = get_name(T, [H]), X = list_to_atom(Y), - [{typefieldreference, Lno, X} | tokenise(T1, Lno)]; + tokenise(Stream,T1,Lno,[{typefieldreference, Lno, X} | R]); -tokenise([$&,H|T],Lno) when $a =< H , H =< $z -> +tokenise(Stream,[$&,H|T],Lno,R) when $a =< H , H =< $z -> {Y, T1} = get_name(T, [H]), X = list_to_atom(Y), - [{valuefieldreference, Lno, X} | tokenise(T1, Lno)]; + tokenise(Stream,T1,Lno,[{valuefieldreference, Lno, X} | R]); -tokenise([H|T],Lno) when $A =< H , H =< $Z -> +tokenise(Stream,[H|T],Lno,R) when $A =< H , H =< $Z -> {Y, T1} = get_name(T, [H]), X = list_to_atom(Y), case reserved_word(X) of true -> - [{X,Lno}|tokenise(T1,Lno)]; + tokenise(Stream,T1,Lno,[{X,Lno}|R]); false -> - [{typereference,Lno,X}|tokenise(T1,Lno)]; + tokenise(Stream,T1,Lno,[{typereference,Lno,X}|R]); rstrtype -> - [{restrictedcharacterstringtype,Lno,X}|tokenise(T1,Lno)] + tokenise(Stream,T1,Lno,[{restrictedcharacterstringtype,Lno,X}|R]) end; -tokenise([$-,H|T],Lno) when $0 =< H , H =< $9 -> +tokenise(Stream,[$-,H|T],Lno,R) when $0 =< H , H =< $9 -> {X, T1} = get_number(T, [H]), - [{number,Lno,-1 * list_to_integer(X)}|tokenise(T1,Lno)]; + tokenise(Stream,T1,Lno,[{number,Lno,-1 * list_to_integer(X)}|R]); -tokenise([H|T],Lno) when $0 =< H , H =< $9 -> +tokenise(Stream,[H|T],Lno,R) when $0 =< H , H =< $9 -> {X, T1} = get_number(T, [H]), - [{number,Lno,list_to_integer(X)}|tokenise(T1,Lno)]; + tokenise(Stream,T1,Lno,[{number,Lno,list_to_integer(X)}|R]); -tokenise([$-,$-|T],Lno) -> - tokenise(skip_comment(T),Lno); +tokenise(Stream,[$-,$-|T],Lno,R) -> + tokenise(Stream,skip_comment(T),Lno,R); -tokenise([$/,$*|T],Lno) -> - tokenise(skip_multiline_comment(T,0),Lno); +tokenise(Stream,[$/,$*|T],Lno,R) -> + {NewLno,T1} = skip_multiline_comment(Stream,T,Lno,0), + tokenise(Stream,T1,NewLno,R); -tokenise([$:,$:,$=|T],Lno) -> - [{'::=',Lno}|tokenise(T,Lno)]; +tokenise(Stream,[$:,$:,$=|T],Lno,R) -> + tokenise(Stream,T,Lno,[{'::=',Lno}|R]); -tokenise([$'|T],Lno) -> +tokenise(Stream,[$'|T],Lno,R) -> case catch collect_quoted(T,Lno,[]) of {'ERR',_} -> throw({'ERR','bad_quote'}); {Thing, T1} -> - [Thing|tokenise(T1,Lno)] + tokenise(Stream,T1,Lno,[Thing|R]) end; -tokenise([$"|T],Lno) -> - collect_string(T,Lno); +tokenise(Stream,[$"|T],Lno,R) -> + {Str,T1} = collect_string(T,Lno), + tokenise(Stream,T1,Lno,[Str|R]); + +tokenise(Stream,[${|T],Lno,R) -> + tokenise(Stream,T,Lno,[{'{',Lno}|R]); + +tokenise(Stream,[$}|T],Lno,R) -> + tokenise(Stream,T,Lno,[{'}',Lno}|R]); -tokenise([${|T],Lno) -> - [{'{',Lno}|tokenise(T,Lno)]; +%% tokenise(Stream,[$],$]|T],Lno,R) -> +%% tokenise(Stream,T,Lno,[{']]',Lno}|R]); -tokenise([$}|T],Lno) -> - [{'}',Lno}|tokenise(T,Lno)]; +%% Even though x.680 specify '[[' and ']]' as lexical items +%% it does not work to have them as such since the single [ and ] can +%% be used beside each other in the SYNTAX OF in x.681 +%% the solution chosen here , i.e. to have them as separate lexical items +%% will not detect the cases where there is white space between them +%% which would be an error in the use in ExtensionAdditionGroups -tokenise([$]|T],Lno) -> - [{']',Lno}|tokenise(T,Lno)]; +%% tokenise(Stream,[$[,$[|T],Lno,R) -> +%% tokenise(Stream,T,Lno,[{'[[',Lno}|R]); -tokenise([$[|T],Lno) -> - [{'[',Lno}|tokenise(T,Lno)]; +tokenise(Stream,[$]|T],Lno,R) -> + tokenise(Stream,T,Lno,[{']',Lno}|R]); -tokenise([$,|T],Lno) -> - [{',',Lno}|tokenise(T,Lno)]; +tokenise(Stream,[$[|T],Lno,R) -> + tokenise(Stream,T,Lno,[{'[',Lno}|R]); -tokenise([$(|T],Lno) -> - [{'(',Lno}|tokenise(T,Lno)]; -tokenise([$)|T],Lno) -> - [{')',Lno}|tokenise(T,Lno)]; +tokenise(Stream,[$,|T],Lno,R) -> + tokenise(Stream,T,Lno,[{',',Lno}|R]); -tokenise([$.,$.,$.|T],Lno) -> - [{'...',Lno}|tokenise(T,Lno)]; +tokenise(Stream,[$(|T],Lno,R) -> + tokenise(Stream,T,Lno,[{'(',Lno}|R]); +tokenise(Stream,[$)|T],Lno,R) -> + tokenise(Stream,T,Lno,[{')',Lno}|R]); -tokenise([$.,$.|T],Lno) -> - [{'..',Lno}|tokenise(T,Lno)]; +tokenise(Stream,[$.,$.,$.|T],Lno,R) -> + tokenise(Stream,T,Lno,[{'...',Lno}|R]); -tokenise([$.|T],Lno) -> - [{'.',Lno}|tokenise(T,Lno)]; -tokenise([$^|T],Lno) -> - [{'^',Lno}|tokenise(T,Lno)]; -tokenise([$!|T],Lno) -> - [{'!',Lno}|tokenise(T,Lno)]; -tokenise([$||T],Lno) -> - [{'|',Lno}|tokenise(T,Lno)]; +tokenise(Stream,[$.,$.|T],Lno,R) -> + tokenise(Stream,T,Lno,[{'..',Lno}|R]); +tokenise(Stream,[$.|T],Lno,R) -> + tokenise(Stream,T,Lno,[{'.',Lno}|R]); +tokenise(Stream,[$^|T],Lno,R) -> + tokenise(Stream,T,Lno,[{'^',Lno}|R]); +tokenise(Stream,[$!|T],Lno,R) -> + tokenise(Stream,T,Lno,[{'!',Lno}|R]); +tokenise(Stream,[$||T],Lno,R) -> + tokenise(Stream,T,Lno,[{'|',Lno}|R]); -tokenise([H|T],Lno) -> +tokenise(Stream,[H|T],Lno,R) -> case white_space(H) of true -> - tokenise(T,Lno); + tokenise(Stream,T,Lno,R); false -> - [{list_to_atom([H]),Lno}|tokenise(T,Lno)] + tokenise(Stream,T,Lno,[{list_to_atom([H]),Lno}|R]) end; -tokenise([],_) -> - []. +tokenise(_Stream,[],Lno,R) -> + {Lno,lists:reverse(R)}. collect_string(L,Lno) -> @@ -181,7 +175,7 @@ collect_string([],_,_) -> collect_string([H|T],Lno,Str) -> case H of $" -> - [{cstring,1,lists:reverse(Str)}|tokenise(T,Lno)]; + {{cstring,1,lists:reverse(Str)},T}; Ch -> collect_string(T,Lno,[Ch|Str]) end. @@ -252,17 +246,23 @@ skip_comment([_|T]) -> skip_comment(T). -skip_multiline_comment([],L) -> - throw({multiline_comment,L}); -skip_multiline_comment([$*,$/|T],0) -> - T; -skip_multiline_comment([$*,$/|T],Level) -> - skip_multiline_comment(T,Level - 1); -skip_multiline_comment([$/,$*|T],Level) -> - skip_multiline_comment(T,Level + 1); -skip_multiline_comment([_|T],Level) -> - skip_multiline_comment(T,Level). - +skip_multiline_comment(Stream,[],Lno,Level) -> + case io:get_line(Stream,'') of + eof -> + io:format("Tokeniser error on line: ~w~n" + "premature end of multiline comment~n",[Lno]), + exit(0); + Line -> + skip_multiline_comment(Stream,Line,Lno+1,Level) + end; +skip_multiline_comment(_Stream,[$*,$/|T],Lno,0) -> + {Lno,T}; +skip_multiline_comment(Stream,[$*,$/|T],Lno,Level) -> + skip_multiline_comment(Stream,T,Lno,Level - 1); +skip_multiline_comment(Stream,[$/,$*|T],Lno,Level) -> + skip_multiline_comment(Stream,T,Lno,Level + 1); +skip_multiline_comment(Stream,[_|T],Lno,Level) -> + skip_multiline_comment(Stream,T,Lno,Level). collect_quoted([$',$B|T],Lno, L) -> case check_bin(L) of -- cgit v1.2.3